From: Pat Thoyts Date: Fri, 13 Jun 2008 17:27:44 +0000 (+0100) Subject: import: tclcontrol-2.0.3 imported into git X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=7a92bb857ae185395cd8bff47d7154a9a9b3dcbb;p=tclcontrol import: tclcontrol-2.0.3 imported into git --- 7a92bb857ae185395cd8bff47d7154a9a9b3dcbb diff --git a/examples/html/example1.html b/examples/html/example1.html new file mode 100644 index 0000000..b2e3fed --- /dev/null +++ b/examples/html/example1.html @@ -0,0 +1,59 @@ + + + + + + + + + + + +

+ +	+ Variable + setting and tracing with Tcl, JScript and + VBScript

+ + +
DHTML
+ + + diff --git a/examples/tc.ico b/examples/tc.ico new file mode 100644 index 0000000..8766d32 Binary files /dev/null and b/examples/tc.ico differ diff --git a/examples/vb/Main.frm b/examples/vb/Main.frm new file mode 100644 index 0000000..8743758 --- /dev/null +++ b/examples/vb/Main.frm @@ -0,0 +1,82 @@ +VERSION 5.00 +Object = "{E796A720-F130-11D2-8003-0040055861F2}#1.0#0"; "TCLCONTROL.DLL" +Begin VB.Form Form1 + Caption = "Form1" + ClientHeight = 7785 + ClientLeft = 60 + ClientTop = 345 + ClientWidth = 8745 + Icon = "Main.frx":0000 + LinkTopic = "Form1" + ScaleHeight = 7785 + ScaleWidth = 8745 + StartUpPosition = 3 'Windows Default + Begin VB.ComboBox cmdcombo + Height = 315 + Left = 840 + TabIndex = 0 + Top = 6960 + Width = 7815 + End + Begin TCLCONTROLPRJ2LibCtl.TclControl tcl + Height = 6615 + Left = 120 + OleObjectBlob = "Main.frx":030A + TabIndex = 1 + Top = 120 + Width = 8535 + End + Begin VB.Label Label1 + Caption = "Command:" + Height = 255 + Left = 0 + TabIndex = 3 + Top = 6960 + Width = 855 + End + Begin VB.Label Result + Caption = "Result:" + Height = 255 + Left = 0 + TabIndex = 2 + Top = 7440 + Width = 8655 + End +End +Attribute VB_Name = "Form1" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +Private Sub SelectAll() + cmdcombo.SelStart = 0 + cmdcombo.SelLength = Len(cmdcombo.Text) +End Sub + +Private Sub cmdcombo_KeyPress(KeyAscii As Integer) + If KeyAscii = 13 Then + If (tcl.Eval(cmdcombo.Text)) Then + Result = "Result: " + tcl.Result + cmdcombo.AddItem (cmdcombo.Text) + Else + Result = "Error: " + tcl.Result + End If + SelectAll + End If +End Sub + +Private Sub Form_Load() + Dim mbt As Integer + mbt = vbOKOnly + vbExclamation + If (tcl.Eval("source plot.tcl") = False) Then + res = MsgBox("Can't find the Tcl script 'plot.tcl'", mbt) + Else + res = tcl.TraceVar("plotupdate", TRACE_WRITES + GLOBAL_ONLY) + End If +End Sub + +Private Sub tcl_OnTraceVar(ByVal name1 As String, ByVal Flags As Long) + x = tcl.GetVar2("plot", "lastX", GLOBAL_ONLY) + y = tcl.GetVar2("plot", "lastY", GLOBAL_ONLY) + Result.Caption = "Pos: (" + x + ", " + y + ")" +End Sub diff --git a/examples/vb/Main.frx b/examples/vb/Main.frx new file mode 100644 index 0000000..eeb476a Binary files /dev/null and b/examples/vb/Main.frx differ diff --git a/examples/vb/TclVB.exe b/examples/vb/TclVB.exe new file mode 100644 index 0000000..bbd6b81 Binary files /dev/null and b/examples/vb/TclVB.exe differ diff --git a/examples/vb/TclVB.vbp b/examples/vb/TclVB.vbp new file mode 100644 index 0000000..1661ed7 --- /dev/null +++ b/examples/vb/TclVB.vbp @@ -0,0 +1,41 @@ +Type=Exe +Form=Main.frm +Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\SYSTEM\StdOle2.Tlb#OLE Automation +Object={E796A720-F130-11D2-8003-0040055861F2}#1.0#0; TCLCONTROL.DLL +Reference=*\G{3D5C6BF0-69A3-11D0-B393-00A0C9055D8E}#1.0#0#C:\PROGRAM FILES\COMMON FILES\DESIGNER\MSDERUN.DLL#Microsoft Data Environment Instance 1.0 +Reference=*\G{00000200-0000-0010-8000-00AA006D2EA4}#2.0#0#C:\PROGRAM FILES\COMMON FILES\SYSTEM\ADO\msado20.tlb#Microsoft ActiveX Data Objects 2.0 Library +IconForm="Form1" +Startup="Form1" +HelpFile="" +Title="TclVb" +ExeName32="TclVB.exe" +Command32="" +Name="TclVB" +HelpContextID="0" +Description="Demonstrates the use of Tcl in a VB project" +CompatibleMode="0" +MajorVer=1 +MinorVer=0 +RevisionVer=0 +AutoIncrementVer=0 +ServerSupportFiles=0 +VersionComments="A demo that sources a tcl script and sets up a variable trace." +VersionCompanyName="UEA, SYS" +VersionLegalCopyright="This source is distributed under the GNU Public Licence." +VersionProductName="TclVb" +CompilationType=-1 +OptimizationType=0 +FavorPentiumPro(tm)=0 +CodeViewDebugInfo=0 +NoAliasing=0 +BoundsCheck=0 +OverflowCheck=0 +FlPointCheck=0 +FDIVCheck=0 +UnroundedFP=0 +StartMode=0 +Unattended=0 +Retained=0 +ThreadPerObject=0 +MaxNumberOfThreads=1 +DebugStartupOption=0 diff --git a/examples/vb/TclVB.vbw b/examples/vb/TclVB.vbw new file mode 100644 index 0000000..ec2195b --- /dev/null +++ b/examples/vb/TclVB.vbw @@ -0,0 +1 @@ +Form1 = 11, 35, 445, 373, Z, 22, 21, 618, 609, C diff --git a/examples/vb/plot.tcl b/examples/vb/plot.tcl new file mode 100644 index 0000000..f833608 --- /dev/null +++ b/examples/vb/plot.tcl @@ -0,0 +1,95 @@ +set w .plot + +# plotupdate is used to raise an event on a plot change +set plotupdate 0 +set plot(lastX) 0 +set plot(lastY) 0 + + +catch {destroy $w} +frame $w +pack $w + + +set c $w.c +set font {Arial 10 normal} + +label $w.msg -font $font -wraplength 4i -justify left -text "Here is a familiar plot ... play with it!" +pack $w.msg -side top + +frame $w.buttons +pack $w.buttons -side bottom -fill x -pady 2m +button $w.buttons.dismiss -text Dismiss -command "destroy $w" + +canvas $c -relief raised -width 450 -height 300 +pack $w.c -side top -fill x + +set plotFont {Helvetica 18} + +$c create line 100 250 400 250 -width 2 +$c create line 100 250 100 50 -width 2 +$c create text 225 20 -text "A Familiar Plot" -font $plotFont -fill brown + +for {set i 0} {$i <= 10} {incr i} { + set x [expr {100 + ($i*30)}] + $c create line $x 250 $x 245 -width 2 + $c create text $x 254 -text [expr 10*$i] -anchor n -font $plotFont +} +for {set i 0} {$i <= 5} {incr i} { + set y [expr {250 - ($i*40)}] + $c create line 100 $y 105 $y -width 2 + $c create text 96 $y -text [expr $i*50].0 -anchor e -font $plotFont +} + +foreach point {{12 56} {20 94} {33 98} {32 120} {61 180} + {75 160} {98 223}} { + set x [expr {100 + (3*[lindex $point 0])}] + set y [expr {250 - (4*[lindex $point 1])/5}] + set item [$c create oval [expr $x-6] [expr $y-6] \ + [expr $x+6] [expr $y+6] -width 1 -outline black \ + -fill SkyBlue2] + $c addtag point withtag $item +} + +$c bind point "$c itemconfig current -fill red" +$c bind point "$c itemconfig current -fill SkyBlue2" +$c bind point <1> "plotDown $c %x %y" +$c bind point "$c dtag selected" +bind $c "plotMove $c %x %y" + +set plot(lastX) 0 +set plot(lastY) 0 + +# plotDown -- +# This procedure is invoked when the mouse is pressed over one of the +# data points. It sets up state to allow the point to be dragged. +# +# Arguments: +# w - The canvas window. +# x, y - The coordinates of the mouse press. + +proc plotDown {w x y} { + global plot + $w dtag selected + $w addtag selected withtag current + $w raise current + set plot(lastX) $x + set plot(lastY) $y +} + +# plotMove -- +# This procedure is invoked during mouse motion events. It drags the +# current item. +# +# Arguments: +# w - The canvas window. +# x, y - The coordinates of the mouse. + +proc plotMove {w x y} { + global plot plotupdate + $w move selected [expr $x-$plot(lastX)] [expr $y-$plot(lastY)] + set plot(lastX) $x + set plot(lastY) $y + set plotupdate 1 +} + diff --git a/examples/vb/plot.tcl.old b/examples/vb/plot.tcl.old new file mode 100644 index 0000000..f833608 --- /dev/null +++ b/examples/vb/plot.tcl.old @@ -0,0 +1,95 @@ +set w .plot + +# plotupdate is used to raise an event on a plot change +set plotupdate 0 +set plot(lastX) 0 +set plot(lastY) 0 + + +catch {destroy $w} +frame $w +pack $w + + +set c $w.c +set font {Arial 10 normal} + +label $w.msg -font $font -wraplength 4i -justify left -text "Here is a familiar plot ... play with it!" +pack $w.msg -side top + +frame $w.buttons +pack $w.buttons -side bottom -fill x -pady 2m +button $w.buttons.dismiss -text Dismiss -command "destroy $w" + +canvas $c -relief raised -width 450 -height 300 +pack $w.c -side top -fill x + +set plotFont {Helvetica 18} + +$c create line 100 250 400 250 -width 2 +$c create line 100 250 100 50 -width 2 +$c create text 225 20 -text "A Familiar Plot" -font $plotFont -fill brown + +for {set i 0} {$i <= 10} {incr i} { + set x [expr {100 + ($i*30)}] + $c create line $x 250 $x 245 -width 2 + $c create text $x 254 -text [expr 10*$i] -anchor n -font $plotFont +} +for {set i 0} {$i <= 5} {incr i} { + set y [expr {250 - ($i*40)}] + $c create line 100 $y 105 $y -width 2 + $c create text 96 $y -text [expr $i*50].0 -anchor e -font $plotFont +} + +foreach point {{12 56} {20 94} {33 98} {32 120} {61 180} + {75 160} {98 223}} { + set x [expr {100 + (3*[lindex $point 0])}] + set y [expr {250 - (4*[lindex $point 1])/5}] + set item [$c create oval [expr $x-6] [expr $y-6] \ + [expr $x+6] [expr $y+6] -width 1 -outline black \ + -fill SkyBlue2] + $c addtag point withtag $item +} + +$c bind point "$c itemconfig current -fill red" +$c bind point "$c itemconfig current -fill SkyBlue2" +$c bind point <1> "plotDown $c %x %y" +$c bind point "$c dtag selected" +bind $c "plotMove $c %x %y" + +set plot(lastX) 0 +set plot(lastY) 0 + +# plotDown -- +# This procedure is invoked when the mouse is pressed over one of the +# data points. It sets up state to allow the point to be dragged. +# +# Arguments: +# w - The canvas window. +# x, y - The coordinates of the mouse press. + +proc plotDown {w x y} { + global plot + $w dtag selected + $w addtag selected withtag current + $w raise current + set plot(lastX) $x + set plot(lastY) $y +} + +# plotMove -- +# This procedure is invoked during mouse motion events. It drags the +# current item. +# +# Arguments: +# w - The canvas window. +# x, y - The coordinates of the mouse. + +proc plotMove {w x y} { + global plot plotupdate + $w move selected [expr $x-$plot(lastX)] [expr $y-$plot(lastY)] + set plot(lastX) $x + set plot(lastY) $y + set plotupdate 1 +} + diff --git a/install/TclControl_Install.tcl b/install/TclControl_Install.tcl new file mode 100644 index 0000000..6e71fca --- /dev/null +++ b/install/TclControl_Install.tcl @@ -0,0 +1,168 @@ + +# TclControl Installer +# Author: Fuzz +# fuzz@sys.uea.ac.uk + + +package require registry + +set piccy { +R0lGODdhKwBAAPcAAAAAAIAAAACAAICA +AAAAgIAAgACAgMDAwMDcwKbK8AAAAAAA +KgAAVQAAfwAAqgAA1AAqAAAqKgAqVQAq +fwAqqgAq1ABVAABVKgBVVQBVfwBVqgBV +1AB/AAB/KgB/VQB/fwB/qgB/1ACqAACq +KgCqVQCqfwCqqgCq1ADUAADUKgDUVQDU +fwDUqgDU1CoAACoAKioAVSoAfyoAqioA +1CoqACoqKioqVSoqfyoqqioq1CpVACpV +KipVVSpVfypVqipV1Cp/ACp/Kip/VSp/ +fyp/qip/1CqqACqqKiqqVSqqfyqqqiqq +1CrUACrUKirUVSrUfyrUqirU1FUAAFUA +KlUAVVUAf1UAqlUA1FUqAFUqKlUqVVUq +f1UqqlUq1FVVAFVVKlVVVVVVf1VVqlVV +1FV/AFV/KlV/VVV/f1V/qlV/1FWqAFWq +KlWqVVWqf1WqqlWq1FXUAFXUKlXUVVXU +f1XUqlXU1H8AAH8AKn8AVX8Af38Aqn8A +1H8qAH8qKn8qVX8qf38qqn8q1H9VAH9V +Kn9VVX9Vf39Vqn9V1H9/AH9/Kn9/VX9/ +f39/qn9/1H+qAH+qKn+qVX+qf3+qqn+q +1H/UAH/UKn/UVX/Uf3/Uqn/U1KoAAKoA +KqoAVaoAf6oAqqoA1KoqAKoqKqoqVaoq +f6oqqqoq1KpVAKpVKqpVVapVf6pVqqpV +1Kp/AKp/Kqp/Vap/f6p/qqp/1KqqAKqq +KqqqVaqqf6qqqqqq1KrUAKrUKqrUVarU +f6rUqqrU1NQAANQAKtQAVdQAf9QAqtQA +1NQqANQqKtQqVdQqf9QqqtQq1NRVANRV +KtRVVdRVf9RVqtRV1NR/ANR/KtR/VdR/ +f9R/qtR/1NSqANSqKtSqVdSqf9SqqtSq +1NTUANTUKtTUVdTUf9TUqtTU1AAAAAwM +DBkZGSYmJjMzMz8/P0xMTFlZWWZmZnJy +cn9/f4yMjJmZmaWlpbKysr+/v8zMzNjY +2OXl5fLy8v/78KCgpICAgP8AAAD/AP// +AAAA//8A/wD//////ywAAAAAKwBAAAAI +/gD/CRxIsCDBevMSztM2z6DDgggTgtNG +URs2ZhiZLSvGsRixjx+LMWv40OA8jyBT +qlzJshhDiRUpZkzIsqbNmyzn1UOJs6dP +YsX+7fxJ9GbQfzxr+gLpa2lRlcsEJmWp +DKS1qk9TMpN6k5uyptb2WcuqlStLX8q4 +EUOrlmxKbAKXKbVmbalXp0zXEtUmkJlS +ZV+V1U25FNvCvX3/rr2K11cxnb16LcN7 +k+8/vzjHMi1W740GChTW/SSJ+e/gtY/f +gAatZXRim74Yg9SmerWNn5wFYsvMlNmt +1aBDpZStGeTRf9p4g4z3eXUWytzqxv5q +fGDym5p9MasN+jZQkHeJ/mEFGVXgdZtY +fWlrHjyUrXrM7Nrcah4ndWLugIPWoKGX +NrTFrUQfcriJoR9oEtiijSaysQRXfT4V +48OBFNgwT3wBrmTZP/PgNuGBYJwkHmUq +bdhhhB/q185/49VkIlEf+sCeNnL1RBKH +Pi1lQ4ViNOcDNiTWdOOJOHm0oxbtrLbO +VDXlJtBQOFG0IypudKdXT8cJxaRKvoDT +y4RUBrdRhAVtWeKEEjCjRHfyTNZTeQOZ +yZQ2E9pA537xyFnWQFDCdqedH2oAzk9w +aomTL9gYCChoPvxH5kBEwsaMgVrY0pwY +jmJJUKRKLZOkFsyBtg6QjwrEaZOfhkqB +KKRiWQ+k/hGiQgGozaESX4SvmvoTMxrQ +ClppPt143k2OaWBDPBNqsQywOAmbIzE+ +2GDLhO5laqN1ERJjw6IUaGAtTuBge+hI +PkigzZoU+HCrTxsOexNz5tbWTjFBuiju +uBM6o5q3RbVLFK+o/OaDmz9tuBtR66zz +myj12rQhsz2519pTD16WlTZ61jQgxIdi +nNXGT2m37r8DcQybL8s2bBOcNf60VDEH +F3Vcy0VhkxS9RcapDTgTpTTNoD//A840 +Hmk3lS+nfvTzccX8PDQx00xDzM7TIBd1 +clETDXXUU/+T9dZS78w0MRNVHW5Mg4Jk +ttd8hRs0PUOvPQ1FTno0dM8fTYR3bN7J +7bwz2XP7TXbfPCdHkkde9yz10H9DPfjg +Pf8zNV+LJ6e31A0NJXnVAlUd9kBRCzTo +05IPLTnUohPjNTGZZ6y0Wyo1lHRLrvfE +F5EdYYRNRQnVE5FC80wUU0XYXJSRRstk +Dk7vJTXv/EMBAQA7 +} + + +# edit this line for the path of regsvr32.exe +set regsvr {c:/windows/system/regsvr32.exe} +set bin [file dirname [info nameofexecutable]] +puts "Install dir: $bin" +regsub {\.} "tclcontrol[info tclversion].dll" {} dll +set dll [file join [pwd] $dll] +puts "dll selected: $dll" + + +set location {} +image create photo tclim -data $piccy +proc updategui {} { + global location + set location {} + catch { + set clsid [registry get {HKEY_CLASSES_ROOT\TclControlPrj2.TclControl\CLSID} {}] + set location [registry get "HKEY_CLASSES_ROOT\\CLSID\\$clsid\\InProcServer32" {}] + } + + + if {$location == {}} { + .uninstall config -state disabled + .install config -text "Install for Tcl[info tclversion]" + } else { + .uninstall config -state normal + .install config -text "ReInstall for Tcl[info tclversion]" + } +} + +proc install {} { + global regsvr bin dll + set cwd [pwd] + set answer [tk_messageBox -title {} -message "Okay to install $dll in $bin as the default TclControl?" -icon question -type yesno] + + switch $answer { + no {} + yes { + if [catch {file copy -force $dll $bin} e] { + puts "error in copying: $e" + } + set f [file tail $dll] + cd $bin + exec $regsvr $f + cd $cwd + } + } + updategui +} + +proc uninstall {} { + global location regsvr + set reply [tk_messageBox -type yesno -message "Unregister TclControl located at $location?"] + if {[string compare $reply yes] != 0} return + set dir [file dirname $location] + set f [file tail $location] + set cwd [pwd] + cd $dir + exec $regsvr /u $f + cd $cwd + + set reply [tk_messageBox -type yesno -message "Delete TclControl located at $location?"] + if {[string compare $reply yes] == 0} { + file delete -force $location + } + updategui +} + +wm title . "Installer - F2 for console" +bind . {console show} +bind . {exit} + +label .im -image tclim -relief flat -bd 0 +button .install -text Install... -command install -width 16 -height 1 -bd 2 -font {arial 10 bold} +button .uninstall -text Uninstall -command uninstall -width 16 -height 1 -bd 2 -font {arial 10 bold} +button .quit -text Quit -command exit -bd 2 -font {arial 10 bold} -width 5 -height 1 + +grid .im -column 0 -row 0 -rowspan 2 +grid .install -column 1 -row 0 -padx 2 -pady 2 -sticky nsew +grid .uninstall -column 2 -row 0 -padx 2 -pady 2 -sticky nsew +grid .quit -column 1 -row 1 -columnspan 2 -padx 2 -pady 2 -sticky nsew + + +wm resizable . 0 0 +updategui +raise . +focus -force . diff --git a/install/tclcontrol84.dll b/install/tclcontrol84.dll new file mode 100644 index 0000000..73eef1a Binary files /dev/null and b/install/tclcontrol84.dll differ diff --git a/readme.html b/readme.html new file mode 100644 index 0000000..ec217e0 --- /dev/null +++ b/readme.html @@ -0,0 +1,101 @@ + + + + + +TclControl verison 2.0b3 + + + + +

TclControl
+v2.0b build 03

+ +

16/09/1999

+ +

Overview and Changes

+ +

This is an experimental alpha +release of TclControl, an ActiveX control containing a Tcl +interpreter and Tk! With TclControl you can re-use your Tcl/Tk +scripts within ActiveX containers, such as Visual Basic, Visual C++, +Delphi and Internet Explorer!

+ +

This version applies the +following changes to the first version:

+ +

Pre-Built binaries for Tcl8.0.5 + and Tcl8.2.
The control now works + correctly with loaded Tcl extensions.
Throwing of automation + errors are limited only to the most severest of errors. + The method 'Eval' now returns an automation boolean, set + to TRUE if, and only if, the evaluation of the script was + successful.
Tracing of Tcl variables + and array elements has now been implemented with four new + methods and two new events, which your favourite + automation client will document for you. These closely + match the entries in the Tcl help for Tcl_TraceVar etc. + It's a good idea to read this page before attempting to + use these new methods and events.
The type library for the + control is now called TclControlPrj2 1.0 Type Library + - apologies for any inconvenience caused from this.
The IID for the control's + interfaces have been changed.

+ +

Requirements

+ +

TclControl has been tested on +Tcl8.0.5 and Tcl8.2 with Windows9x. It may work with NT 4sp3, but +this hasn't been tested. I would be interested to know of any +interesting configurations that TclControl did/didn't work with.

+ +

Installation and Uninstallation.

+ +

Before installing this version, +please ensure that any previous version of the control has +correctly uninstalled. Then run the Tcl script TclControl_Install.tcl +in the bin directory, and press on the button marked 'Install...'. +The program will automatically detect the version of Tcl and +select the appropriate installation. All versions of the DLL +should be in the same directory as the running script. The rest +of the installation is fairly straighforward. Uninstallation is +via the same Tcl script.

+ +

Examples

+ +

I've made a couple of examples +using the control - one with HTML, and the other with VB. The +HTML example runs with IE4 and above. The VB examples also +provides an executable: TclVB.exe

+ +

Known Problems

+ +

None so far ... so let me know! :-)

+ +

For flames, suggestions or bug +reports please email me: fuzz@sys.uea.ac.uk.

+ +

Have fun!
+Farzad Pezeshkpour
+www.sys.uea.ac.uk/~fuzz

+ + diff --git a/src/StdAfx.cpp b/src/StdAfx.cpp new file mode 100644 index 0000000..a5eea17 --- /dev/null +++ b/src/StdAfx.cpp @@ -0,0 +1,12 @@ +// stdafx.cpp : source file that includes just the standard includes +// stdafx.pch will be the pre-compiled header +// stdafx.obj will contain the pre-compiled type information + +#include "stdafx.h" + +#ifdef _ATL_STATIC_REGISTRY +#include +#include +#endif + +#include diff --git a/src/StdAfx.h b/src/StdAfx.h new file mode 100644 index 0000000..703f44c --- /dev/null +++ b/src/StdAfx.h @@ -0,0 +1,30 @@ +// stdafx.h : include file for standard system include files, +// or project specific include files that are used frequently, +// but are changed infrequently + +#if !defined(AFX_STDAFX_H__E796A723_F130_11D2_8003_0040055861F2__INCLUDED_) +#define AFX_STDAFX_H__E796A723_F130_11D2_8003_0040055861F2__INCLUDED_ + +#if _MSC_VER > 1000 +#pragma once +#endif // _MSC_VER > 1000 + +#define STRICT +#ifndef _WIN32_WINNT +#define _WIN32_WINNT 0x0400 +#endif +#define _ATL_APARTMENT_THREADED + +#include +//You may derive a class from CComModule and use it if you want to override +//something, but do not change the name of _Module +extern CComModule _Module; +#include +#include +#include +#include + +//{{AFX_INSERT_LOCATION}} +// Microsoft Visual C++ will insert additional declarations immediately before the previous line. + +#endif // !defined(AFX_STDAFX_H__E796A723_F130_11D2_8003_0040055861F2__INCLUDED) diff --git a/src/TclClassFactory.cpp b/src/TclClassFactory.cpp new file mode 100644 index 0000000..d325017 --- /dev/null +++ b/src/TclClassFactory.cpp @@ -0,0 +1,153 @@ +// TclClassFactory.cpp: implementation of the CTclClassFactory class. +// +////////////////////////////////////////////////////////////////////// + +#include "stdafx.h" +#include "TclControlPrj2.h" +#include "dlldatax.h" +#include "TclControl.h" + +////////////////////////////////////////////////////////////////////// +// Construction/Destruction +////////////////////////////////////////////////////////////////////// + +CTclClassFactory::CTclClassFactory() : +CComClassFactory(), m_hT1Ready(NULL), m_hT2Ready(NULL), + m_iid(IID_IUnknown), m_pMarshallStm(NULL), m_pu(NULL) +{ + m_hT1Ready = CreateEvent (NULL, FALSE, FALSE, NULL); + m_hT2Ready = CreateEvent (NULL, FALSE, FALSE, NULL); +} + +CTclClassFactory::~CTclClassFactory() +{ + if (m_hT1Ready != NULL) { + CloseHandle (m_hT1Ready); + m_hT1Ready = NULL; + } + if (m_hT2Ready != NULL) { + CloseHandle (m_hT2Ready); + m_hT2Ready = NULL; + } +} + + + + + +HRESULT CTclClassFactory::CreateInstance(LPUNKNOWN pUnkOuter, REFIID riid, void ** ppvObject) +{ + if ((pUnkOuter != NULL) && !InlineIsEqualUnknown(riid)) + { + ATLTRACE2(atlTraceCOM, 0, _T("CComClassFactory: asked for non IUnknown interface while creating an aggregated object")); + m_hres = CLASS_E_NOAGGREGATION; + } + else + { + m_pUnkOuter = pUnkOuter; + m_iid = riid; + + DWORD threadid; + HANDLE hThread; + hThread = CreateThread (NULL, NULL, CTclClassFactory::TclThreadProc, this, NULL, &threadid); + if (hThread != NULL) + { + if (WaitForSingleObject (m_hT2Ready, INFINITE) == WAIT_OBJECT_0) + { + + if (m_pMarshallStm != NULL) // marshall the interface pointer to this thread + { + m_hres = CoGetInterfaceAndReleaseStream (m_pMarshallStm, riid, ppvObject); + SetEvent (m_hT1Ready); + + if (FAILED (m_hres)) + { + if (WaitForSingleObject (hThread, 5000) == WAIT_OBJECT_0) + TerminateThread (hThread, 0); + } + + } + /* + if (m_pu != NULL) + *ppvObject = m_pu; + */ + + else + { + // unable to create object ... + // don't do anything as the error is in m_hres already. + } + } + else // thread didn't respond after being created + { + TerminateThread (hThread, 0); + m_hres = E_FAIL; + } + BOOL battach = AttachThreadInput (threadid, GetCurrentThreadId(), TRUE); + CloseHandle (hThread); + } + else // unable to create thread + m_hres = E_FAIL; + } + return m_hres; +} + + + +DWORD WINAPI CTclClassFactory::TclThreadProc (LPVOID lpstruct) +{ + CTclClassFactory *pcf = (CTclClassFactory*)lpstruct; + ATLASSERT (pcf != NULL); + MSG msg; + + OleInitialize(NULL); + IUnknown * pv = NULL; + pcf->m_hres = (pcf->m_pfnCreateInstance) (pcf->m_pUnkOuter, pcf->m_iid, (void**)&pv); + if (SUCCEEDED(pcf->m_hres)) + { + // we've created the object, so now create a stream to marshall the + // the interface + ATLASSERT (pv != NULL); + pcf->m_hres = CoMarshalInterThreadInterfaceInStream (pcf->m_iid, pv, &(pcf->m_pMarshallStm)); + + } + + SetEvent (pcf->m_hT2Ready); + WaitForSingleObject (pcf->m_hT1Ready, INFINITE); + + // interface has been marshalled safetly, so now release our stranglehold on + // the object if it exists + + if (pv != NULL) + { + pv->Release(); + pv = NULL; + } + + + if (SUCCEEDED(pcf->m_hres)) + { + bool bCreated = false; + int totalwin = 0; + + // the following line ensures that a message queue exists for this thread + PeekMessage (&msg, NULL, NULL, NULL, PM_NOREMOVE); + + // assume that the Tcl interpreter for the object has been intialised. + while (!bCreated) { + Tcl_DoOneEvent(0); + bCreated = Tk_GetNumMainWindows() > 0; + } + + while (Tk_GetNumMainWindows() > 0) + Tcl_DoOneEvent(0); + } + + else // something went wrong in the process of either creation or marshalling + { + } + + + OleUninitialize(); + return 0; +} \ No newline at end of file diff --git a/src/TclClassFactory.h b/src/TclClassFactory.h new file mode 100644 index 0000000..0fc6b20 --- /dev/null +++ b/src/TclClassFactory.h @@ -0,0 +1,13 @@ +// TclClassFactory.h: interface for the TclClassFactory class. +// +////////////////////////////////////////////////////////////////////// + +#if !defined(AFX_TCLCLASSFACTORY_H__D415E3AC_6678_11D4_8004_0040055861F2__INCLUDED_) +#define AFX_TCLCLASSFACTORY_H__D415E3AC_6678_11D4_8004_0040055861F2__INCLUDED_ + +#if _MSC_VER > 1000 +#pragma once +#endif // _MSC_VER > 1000 + + +#endif // !defined(AFX_TCLCLASSFACTORY_H__D415E3AC_6678_11D4_8004_0040055861F2__INCLUDED_) diff --git a/src/TclControl.cpp b/src/TclControl.cpp new file mode 100644 index 0000000..3fe3310 --- /dev/null +++ b/src/TclControl.cpp @@ -0,0 +1,578 @@ +// TclControl.cpp : Implementation of CTclControl +// Author: Farzad Pezeshkpour +// Date: 13 April 1999 + +#include "stdafx.h" +#include "TclControlPrj2.h" +#include "TclControl.h" + +inline void _cdecl MyTrace(LPCSTR lpszFormat, ...) +{ + va_list args; + va_start(args, lpszFormat); + + int nBuf; + char szBuffer[512]; + + nBuf = _vsnprintf(szBuffer, sizeof(szBuffer), lpszFormat, args); + ATLASSERT(nBuf < sizeof(szBuffer)); //Output truncated as it was > sizeof(szBuffer) + + OutputDebugStringA(szBuffer); + va_end(args); +} + +#define MYTRACE MyTrace + +WCHAR* tcldead= L"Tcl interpreter is dead"; +bool bInit = false; + +///////////////////////////////////////////////////////////////////////////// +// CTclControl + +/* + *------------------------------------------------------------------------- + * CTclControl -- + * Constructor - Creates the interpreter for this application and + * initialise it. Sets member variables to default. + * Result: + * + * Side effects: + * None + *------------------------------------------------------------------------- + */ +CTclControl::CTclControl() +{ + + m_hWndTk = NULL; + m_bWindowOnly = true; + m_tkWnd = NULL; + m_pInterp = NULL; + + m_pInterp = Tcl_CreateInterp(); + + if (m_pInterp != NULL && + Tcl_Init (m_pInterp) == TCL_ERROR) { + Tcl_DeleteInterp (m_pInterp); + m_pInterp = NULL; + } +} + + + +/* + *------------------------------------------------------------------------- + * ~CTclControl -- + * Destructor - Ensures that allocated resources are released + * Result: + * + * Side effects: + * Interpreter released + *------------------------------------------------------------------------- + */ +CTclControl::~CTclControl () +{ + if (m_pInterp != NULL) + { + try { + Tcl_DeleteInterp (m_pInterp); + m_pInterp = NULL; + } catch (...) { + // catch all exceptions!!! + } + } +} + +/* + *------------------------------------------------------------------------- + * CreateControlWindow -- + * Virtual function override. Creates control window, and initialises + * Tk environement + * Result: + * NULL iff failed to create base window + * Side effects: + * None + *------------------------------------------------------------------------- + */ +HWND CTclControl::CreateControlWindow( HWND hWndParent, RECT& rcPos ) +{ + HWND hWnd = CComControl::CreateControlWindow(hWndParent, rcPos); + + if (m_pInterp != NULL && hWnd != NULL) { + char buffer[255]; + sprintf(buffer, "-use 0x%8.8x", hWnd); + Tcl_SetVar (m_pInterp, "argv", buffer, TCL_GLOBAL_ONLY); + if (Tk_Init(m_pInterp) != TCL_ERROR) { + Tcl_StaticPackage(NULL, "Tk", Tk_Init, Tk_SafeInit); + m_tkWnd = Tk_MainWindow (m_pInterp); + // this is a bit naughty ... loop on the message queue until + // the tk window is initialised, other wise, Tk barfs <>! + MSG msg; + while (m_hWndTk == NULL && GetMessage (&msg, NULL, 0, 0)) + DispatchMessage(&msg); + } + } + return hWnd; +} + + + + +/* + *------------------------------------------------------------------------- + * OnTkClaimFocus -- + * Message Handler for TK_CLAIMFOCUS - this is probably not implemented + * correctly, because focus handling doesn't currently work + * Result: + * 0 - I think this means that it was handled + * Side effects: + * Focus changed to toplevel + *------------------------------------------------------------------------- + */ +LRESULT CTclControl::OnTkClaimFocus(UINT uMsg, WPARAM wParam, LPARAM lParam, BOOL& bHandled) +{ + bHandled = TRUE; + if (wParam!=NULL || (::GetFocus() != NULL)) { + ::SetFocus(m_hWndTk); + } + return 0; +} + +/* + *------------------------------------------------------------------------- + * OnParentNotify -- + * Manages focus according to mouse events + * Result: + * 0 to indicate processed + * Side effects: + * Focus changes to Tk window - this probably is not the right way to do + * this + *------------------------------------------------------------------------- + */ +LRESULT CTclControl::OnParentNotify(UINT uMsg, WPARAM wParam, LPARAM lParam, BOOL& bHandled) +{ + switch (LOWORD(wParam)) { + case WM_LBUTTONDOWN: + case WM_MBUTTONDOWN: + case WM_RBUTTONDOWN: + ::SetFocus(m_hWndTk); + break; + } + return 0; +} + + +/* + *------------------------------------------------------------------------- + * OnTkAttach -- + * Called by Tk to inform the base window of this control (its container) + * that it is attaching. This procedure store the window handle of the + * the toplevel and resizes the Tk window to fit in the base window + * Result: + * 0 to indicate processed (I think) + * Side effects: + * Tk toplevel resized to that of the base window + *------------------------------------------------------------------------- + */ +LRESULT CTclControl::OnTkAttach(UINT uMsg, WPARAM wParam, LPARAM lParam, BOOL& bHandled) +{ + MYTRACE(_T("OnTkAttach %u %d %d\n"), uMsg, wParam, lParam); + m_hWndTk = (HWND)wParam; + RECT rect; + GetClientRect(&rect); + return OnSize (WM_SIZE, NULL, MAKELPARAM(rect.right, rect.bottom), bHandled); +} + + +/* + *------------------------------------------------------------------------- + * OnTkGeomReq -- + * Called by Tk toplevel to request a geometry change - basically we'll + * give it only one size; that of the control base window + * Result: + * 1 - maybe? + * Side effects: + * Tk toplevel resized + *------------------------------------------------------------------------- + */ +LRESULT CTclControl::OnTkGeomReq(UINT uMsg, WPARAM wParam, LPARAM lParam, BOOL& bHandled) +{ + RECT rect; + if (m_hWndTk != NULL) { + GetClientRect(&rect); + ::SetWindowPos(m_hWndTk, NULL, + 0, 0, rect.right, rect.bottom, SWP_NOZORDER); + } + return 1; +} + + + +/* + *------------------------------------------------------------------------- + * OnSize -- + * Called to update the size of the Tk toplevel according to the (new) size + * of the controls base window + * Result: + * 0 + * Side effects: + * + *------------------------------------------------------------------------- + */ +LRESULT CTclControl::OnSize(UINT uMsg, WPARAM wParam, LPARAM lParam, BOOL& bHandled) +{ + if (m_tkWnd != NULL) + Tk_GeometryRequest(m_tkWnd, LOWORD(lParam), HIWORD(lParam)); + return 0; +} + +/* + *------------------------------------------------------------------------- + * Eval -- + * Evaluates a command in the interpreter. + * Result: + * pbOk set to -1 iff script evaluated okay; else 0. Returns S_OK iff + * interpreter exists. + * Side effects: + * None. + *------------------------------------------------------------------------- + */ +STDMETHODIMP CTclControl::Eval(BSTR command, VARIANT_BOOL *pbOk) +{ + USES_CONVERSION; + + char *szc = NULL; + int result; + + if (m_pInterp==NULL) { + Error(A2COLE("tcl interp is dead")); + } + else { + szc = OLE2A(command); + result = Tcl_Eval (m_pInterp, szc); + if (pbOk != NULL) + *pbOk = ((result == TCL_OK)?-1:0); + } + + return S_OK; +} + +/* + *------------------------------------------------------------------------- + * get_Result -- + * Returns the current result of the interpreter in pVal. + * Result: + * S_OK iff interpreter exists. + * Side effects: + * None. + *------------------------------------------------------------------------- + */ +STDMETHODIMP CTclControl::get_Result(BSTR *pVal) +{ + USES_CONVERSION; + HRESULT hr = E_FAIL; + + if (m_pInterp==NULL) + Error(tcldead); + else if (pVal != NULL) { + CComBSTR str(A2OLE(Tcl_GetStringResult (m_pInterp))); + *pVal = str.Detach(); + hr = S_OK; + } + + return hr; +} + +/* + *------------------------------------------------------------------------- + * TraceVar -- + * Implements a trace on a Tcl variable, parameterised with a set of flags. + * Please read Tcl_TraceVar page in the Tcl help. + * Result: + * *pbOk == -1 iff successful; else 0 + * Side effects: + * None. + *------------------------------------------------------------------------- + */ +STDMETHODIMP CTclControl::TraceVar(BSTR name, long flags, VARIANT_BOOL *pbOk) +{ + USES_CONVERSION; + HRESULT hr = E_FAIL; + + if (m_pInterp==NULL) + Error(tcldead); + else { + int result = Tcl_TraceVar (m_pInterp, OLE2A(name), flags, VarCallback, (ClientData)this); + if (pbOk != NULL) + *pbOk = ((result == TCL_OK)?-1:0); + hr = S_OK; + } + + return hr; +} + +/* + *------------------------------------------------------------------------- + * TraceVar2 -- + * Implements a trace on a Tcl array element, parameterised with a set of + * flags. Please read Tcl_TraceVar2 page in the Tcl help. + * Result: + * *pbOk == -1 iff trace was set okay; else 0. + * Side effects: + * None. + *------------------------------------------------------------------------- + */ +STDMETHODIMP CTclControl::TraceVar2(BSTR name1, BSTR name2, long flags, VARIANT_BOOL *pbOk) +{ + USES_CONVERSION; + HRESULT hr = E_FAIL; + + if (m_pInterp==NULL) + Error(tcldead); + else { + int result = Tcl_TraceVar2 (m_pInterp, OLE2A(name1), OLE2A(name2), flags, VarCallback, (ClientData)this); + if (pbOk != NULL) + *pbOk = ((result == TCL_OK)?-1:0); + hr = S_OK; + } + + return hr; +} + + +/* + *------------------------------------------------------------------------- + * VarCallback -- + * Callback from Tcl when a trace has been invoked due to a change + * in a variable's state. + * Result: + * NULL + * Side effects: + * Invokes an appropriate COM event from this object. + *------------------------------------------------------------------------- + */ +char *CTclControl::VarCallback (ClientData cd, Tcl_Interp *pInterp, char *name1, char *name2, int flags) +{ + USES_CONVERSION; + CTclControl *ptc = reinterpret_cast(cd); + ATLASSERT (ptc != NULL); + if (ptc == NULL) return NULL; + + if (name2 == NULL) { + ptc->Fire_OnTraceVar (A2BSTR(name1), flags); + } else { + ptc->Fire_OnTraceVar2 (A2BSTR(name1), A2BSTR(name2), flags); + } + return NULL; +} + +/* + *------------------------------------------------------------------------- + * UntraceVar -- + * Removes an existing trace on a Tcl variable. + * Result: + * S_OK iff interpreter exists. + * Side effects: + * None. + *------------------------------------------------------------------------- + */ +STDMETHODIMP CTclControl::UntraceVar(BSTR name, long flags) +{ + USES_CONVERSION; + HRESULT hr = E_FAIL; + if (m_pInterp==NULL) + Error(tcldead); + else { + Tcl_UntraceVar (m_pInterp, OLE2A(name), flags, VarCallback, (ClientData)this); + hr = S_OK; + } + return hr; +} + + +/* + *------------------------------------------------------------------------- + * UntraceVar2 -- + * Allows for the removal of an existing trace on a array element + * Result: + * S_OK iff interpreter exists. + * Side effects: + * None. + *------------------------------------------------------------------------- + */ +STDMETHODIMP CTclControl::UntraceVar2(BSTR name1, BSTR name2, long flags) +{ + USES_CONVERSION; + HRESULT hr = E_FAIL; + + if (m_pInterp==NULL) + Error(tcldead); + else { + Tcl_UntraceVar2 (m_pInterp, OLE2A(name1), OLE2A(name2), flags, VarCallback, (ClientData)this); + hr = S_OK; + } + + return hr; +} + + +/* + *------------------------------------------------------------------------- + * SetVar -- + * Sets a Tcl Variable + * Result: + * S_OK iff interpreter exists. *pbOk will be true iff set was successful + * Side effects: + * Could invoke a variable trace. + *------------------------------------------------------------------------- + */ +STDMETHODIMP CTclControl::SetVar(BSTR name, BSTR value, long flags, VARIANT_BOOL *pbOk) +{ + USES_CONVERSION; + HRESULT hr = E_FAIL; + + if (m_pInterp==NULL) + Error(tcldead); + else { + char *result = Tcl_SetVar (m_pInterp, OLE2A(name), OLE2A(value), flags); + if (pbOk != NULL) + *pbOk = ((result != NULL)?-1:0); + hr = S_OK; + } + + return hr; +} + +/* + *------------------------------------------------------------------------- + * GetVar -- + * Gets the value of an existing Tcl variable + * Result: + * S_OK iff interpreter and variable exist and variable is not an array. + * Side effects: + * Can invoke a variable trace. + *------------------------------------------------------------------------- + */ +STDMETHODIMP CTclControl::GetVar(BSTR name, long flags, BSTR *pValue) +{ + USES_CONVERSION; + HRESULT hr = E_FAIL; + + if (m_pInterp==NULL) + Error(tcldead); + else { + char *result = Tcl_GetVar (m_pInterp, OLE2A(name), flags); + if (result != NULL && pValue != NULL) { + CComBSTR val(A2OLE(result)); + *pValue = val.Detach(); + hr = S_OK; + } + } + return hr; +} + + + +/* + *------------------------------------------------------------------------- + * SetVar2 -- + * Sets the value of an array element. + * Result: + * S_OK iff interpreter exists. *pbOk is true iff set operation succeeded. + * Side effects: + * Could invoke a variable trace. + *------------------------------------------------------------------------- + */ +STDMETHODIMP CTclControl::SetVar2(BSTR name1, BSTR name2, BSTR value, long flags, VARIANT_BOOL *pbOk) +{ + USES_CONVERSION; + HRESULT hr = E_FAIL; + + if (m_pInterp==NULL) + Error(tcldead); + else { + char *result = Tcl_SetVar2 (m_pInterp, OLE2A(name1), OLE2A(name2), OLE2A(value), flags); + if (pbOk != NULL) + *pbOk = ((result != NULL)?-1:0); + hr = S_OK; + } + return hr; +} + + + +/* + *------------------------------------------------------------------------- + * GetVar2 -- + * Gets the value of an existing array element. + * Result: + * S_OK iff interpreter exists, and array element exists. + * Side effects: + * Can invoke a variable trace. + *------------------------------------------------------------------------- + */ +STDMETHODIMP CTclControl::GetVar2(BSTR name1, BSTR name2, long flags, BSTR *pVal) +{ + USES_CONVERSION; + HRESULT hr = E_FAIL; + + if (m_pInterp==NULL) + Error(tcldead); + else { + char *result = Tcl_GetVar2 (m_pInterp, OLE2A(name1), OLE2A(name2), flags); + if (result != NULL && pVal != NULL) { + CComBSTR val(A2OLE(result)); + *pVal = val.Detach(); + hr = S_OK; + } + } + return hr; +} + + +/* + *------------------------------------------------------------------------- + * UnsetVar -- + * Unsets a Tcl variable + * Result: + * S_OK iff interpreter exists. + * Side effects: + * Can invoke a variable trace. + *------------------------------------------------------------------------- + */ +STDMETHODIMP CTclControl::UnsetVar(BSTR name, long flags) +{ + USES_CONVERSION; + HRESULT hr = E_FAIL; + + if (m_pInterp==NULL) + Error(tcldead); + else { + Tcl_UnsetVar (m_pInterp, OLE2A(name), flags); + hr = S_OK; + } + return hr; +} + +/* + *------------------------------------------------------------------------- + * UnsetVar2 -- + * Unsets a Tcl array element. + * Result: + * S_OK iff interpreter exists. + * Side effects: + * Can invoke a variable trace. + *------------------------------------------------------------------------- + */ +STDMETHODIMP CTclControl::UnsetVar2(BSTR name1, BSTR name2, long flags) +{ + USES_CONVERSION; + HRESULT hr = E_FAIL; + + if (m_pInterp==NULL) + Error(tcldead); + else { + Tcl_UnsetVar2 (m_pInterp, OLE2A(name1), OLE2A(name2), flags); + hr = S_OK; + } + return hr; +} diff --git a/src/TclControl.h b/src/TclControl.h new file mode 100644 index 0000000..6b55ceb --- /dev/null +++ b/src/TclControl.h @@ -0,0 +1,196 @@ +// TclControl.h : Declaration of the CTclControl + +#ifndef __TCLCONTROL_H_ +#define __TCLCONTROL_H_ + +#include "resource.h" // main symbols +#include +#include "TclControlPrj2CP.h" + +#define TK_CLAIMFOCUS (WM_USER) +#define TK_GEOMETRYREQ (WM_USER+1) +#define TK_ATTACHWINDOW (WM_USER+2) +#define TK_DETACHWINDOW (WM_USER+3) + + + + +class CTclClassFactory : public CComClassFactory +{ +public: + CTclClassFactory(); + virtual ~CTclClassFactory(); + + // override + STDMETHOD(CreateInstance) (LPUNKNOWN pUnkOuter, REFIID riid, void ** ppvObject); +protected: + static DWORD WINAPI TclThreadProc (LPVOID lpstruct); + HANDLE m_hT1Ready; + HANDLE m_hT2Ready; + IStream * m_pMarshallStm; + LPUNKNOWN m_pUnkOuter; + IID m_iid; + HRESULT m_hres; + void * m_pu; +}; + + +///////////////////////////////////////////////////////////////////////////// +// CTclControl +class ATL_NO_VTABLE CTclControl : + public CComObjectRootEx, + public IDispatchImpl, + public CComControl, + public IPersistStreamInitImpl, + public IOleControlImpl, + public IOleObjectImpl, + public IOleInPlaceActiveObjectImpl, + public IViewObjectExImpl, + public IOleInPlaceObjectWindowlessImpl, + public ISupportErrorInfo, + public IConnectionPointContainerImpl, + public IPersistStorageImpl, + public ISpecifyPropertyPagesImpl, + public IQuickActivateImpl, + public IDataObjectImpl, + public IProvideClassInfo2Impl<&CLSID_TclControl, &DIID__ITclControlEvents, &LIBID_TCLCONTROLPRJ2Lib>, + public IPropertyNotifySinkCP, + public CComCoClass, + public CProxy_ITclControlEvents< CTclControl > +{ +public: + CTclControl(); + virtual ~CTclControl (); + virtual HWND CreateControlWindow( HWND hWndParent, RECT& rcPos ); + +DECLARE_REGISTRY_RESOURCEID(IDR_TCLCONTROL) + +DECLARE_PROTECT_FINAL_CONSTRUCT() + +// the following line implements the use of the multithreaded class factory +// DECLARE_CLASSFACTORY_EX(CTclClassFactory) + + + + +BEGIN_COM_MAP(CTclControl) + COM_INTERFACE_ENTRY(ITclControl) + COM_INTERFACE_ENTRY(IDispatch) + COM_INTERFACE_ENTRY(IViewObjectEx) + COM_INTERFACE_ENTRY(IViewObject2) + COM_INTERFACE_ENTRY(IViewObject) + COM_INTERFACE_ENTRY(IOleInPlaceObjectWindowless) + COM_INTERFACE_ENTRY(IOleInPlaceObject) + COM_INTERFACE_ENTRY2(IOleWindow, IOleInPlaceObjectWindowless) + COM_INTERFACE_ENTRY(IOleInPlaceActiveObject) + COM_INTERFACE_ENTRY(IOleControl) + COM_INTERFACE_ENTRY(IOleObject) + COM_INTERFACE_ENTRY(IPersistStreamInit) + COM_INTERFACE_ENTRY2(IPersist, IPersistStreamInit) + COM_INTERFACE_ENTRY(ISupportErrorInfo) + COM_INTERFACE_ENTRY(IConnectionPointContainer) + COM_INTERFACE_ENTRY(ISpecifyPropertyPages) + COM_INTERFACE_ENTRY(IQuickActivate) + COM_INTERFACE_ENTRY(IPersistStorage) + COM_INTERFACE_ENTRY(IDataObject) + COM_INTERFACE_ENTRY(IProvideClassInfo) + COM_INTERFACE_ENTRY(IProvideClassInfo2) + COM_INTERFACE_ENTRY_IMPL(IConnectionPointContainer) +END_COM_MAP() + +BEGIN_PROP_MAP(CTclControl) + PROP_DATA_ENTRY("_cx", m_sizeExtent.cx, VT_UI4) + PROP_DATA_ENTRY("_cy", m_sizeExtent.cy, VT_UI4) + // Example entries + // PROP_ENTRY("Property Description", dispid, clsid) + // PROP_PAGE(CLSID_StockColorPage) +END_PROP_MAP() + +BEGIN_CONNECTION_POINT_MAP(CTclControl) + CONNECTION_POINT_ENTRY(IID_IPropertyNotifySink) + CONNECTION_POINT_ENTRY(DIID__ITclControlEvents) +END_CONNECTION_POINT_MAP() + +BEGIN_MSG_MAP(CTclControl) + MESSAGE_HANDLER(TK_ATTACHWINDOW, OnTkAttach) + MESSAGE_HANDLER(TK_GEOMETRYREQ, OnTkGeomReq) + MESSAGE_HANDLER(TK_CLAIMFOCUS, OnTkClaimFocus) + MESSAGE_HANDLER(WM_PARENTNOTIFY, OnParentNotify) + MESSAGE_HANDLER(WM_SIZE, OnSize) + CHAIN_MSG_MAP(CComControl) + DEFAULT_REFLECTION_HANDLER() +END_MSG_MAP() +// Handler prototypes: +// LRESULT MessageHandler(UINT uMsg, WPARAM wParam, LPARAM lParam, BOOL& bHandled); +// LRESULT CommandHandler(WORD wNotifyCode, WORD wID, HWND hWndCtl, BOOL& bHandled); +// LRESULT NotifyHandler(int idCtrl, LPNMHDR pnmh, BOOL& bHandled); + + + +// ISupportsErrorInfo + STDMETHOD(InterfaceSupportsErrorInfo)(REFIID riid) + { + static const IID* arr[] = + { + &IID_ITclControl, + }; + for (int i=0; i + +ATL 3.0 test page for object TclControl + + +

+ + \ No newline at end of file diff --git a/src/TclControl.rgs b/src/TclControl.rgs new file mode 100644 index 0000000..345f24a --- /dev/null +++ b/src/TclControl.rgs @@ -0,0 +1,34 @@ +HKCR +{ + TclControlPrj2.TclControl.1 = s 'TclControl Class' + { + CLSID = s '{E796A72F-F130-11D2-8003-0040055861F2}' + } + TclControlPrj2.TclControl = s 'TclControl Class' + { + CLSID = s '{E796A72F-F130-11D2-8003-0040055861F2}' + CurVer = s 'TclControlPrj2.TclControl.1' + } + NoRemove CLSID + { + ForceRemove {E796A72F-F130-11D2-8003-0040055861F2} = s 'TclControl Class' + { + ProgID = s 'TclControlPrj2.TclControl.1' + VersionIndependentProgID = s 'TclControlPrj2.TclControl' + ForceRemove 'Programmable' + InprocServer32 = s '%MODULE%' + { + val ThreadingModel = s 'Apartment' + } + ForceRemove 'Control' + ForceRemove 'Insertable' + ForceRemove 'ToolboxBitmap32' = s '%MODULE%, 101' + 'MiscStatus' = s '0' + { + '1' = s '131473' + } + 'TypeLib' = s '{E796A720-F130-11D2-8003-0040055861F2}' + 'Version' = s '1.0' + } + } +} diff --git a/src/TclControlPrj2.cpp b/src/TclControlPrj2.cpp new file mode 100644 index 0000000..7f8061c --- /dev/null +++ b/src/TclControlPrj2.cpp @@ -0,0 +1,143 @@ +// TclControlPrj2.cpp : Implementation of DLL Exports. + + +// Note: Proxy/Stub Information +// To merge the proxy/stub code into the object DLL, add the file +// dlldatax.c to the project. Make sure precompiled headers +// are turned off for this file, and add _MERGE_PROXYSTUB to the +// defines for the project. +// +// If you are not running WinNT4.0 or Win95 with DCOM, then you +// need to remove the following define from dlldatax.c +// #define _WIN32_WINNT 0x0400 +// +// Further, if you are running MIDL without /Oicf switch, you also +// need to remove the following define from dlldatax.c. +// #define USE_STUBLESS_PROXY +// +// Modify the custom build rule for TclControlPrj2.idl by adding the following +// files to the Outputs. +// TclControlPrj2_p.c +// dlldata.c +// To build a separate proxy/stub DLL, +// run nmake -f TclControlPrj2ps.mk in the project directory. + +#include "stdafx.h" +#include "resource.h" +#include +#include "TclControlPrj2.h" +#include "dlldatax.h" + +#include "TclControlPrj2_i.c" +#include "TclControl.h" + +#ifdef _MERGE_PROXYSTUB +extern "C" HINSTANCE hProxyDll; +#endif + +CComModule _Module; +HHOOK hHook = NULL; + +BEGIN_OBJECT_MAP(ObjectMap) +OBJECT_ENTRY(CLSID_TclControl, CTclControl) +END_OBJECT_MAP() + + +// main -- +// used to make the minimum dependancy build work +void main (void) +{ + +} + +///////////////////////////////////////////////////////////////////////////// +// DLL Entry Point + +extern "C" +BOOL WINAPI DllMain(HINSTANCE hInstance, DWORD dwReason, LPVOID lpReserved) +{ + char modpath[1024]; + Tcl_Time timeout; + +#ifdef _MERGE_PROXYSTUB + if (!PrxDllMain(hInstance, dwReason, lpReserved)) + return FALSE; +#endif + switch (dwReason) { + case DLL_PROCESS_ATTACH: + _Module.Init(ObjectMap, hInstance, &LIBID_TCLCONTROLPRJ2Lib); + GetModuleFileName (_Module.m_hInst, modpath, 1024); + Tcl_FindExecutable (modpath); + //Tcl_InitNotifier(); + Tcl_SetServiceMode(TCL_SERVICE_ALL); + timeout.sec = 0; + timeout.usec = 25000; + Tcl_SetTimer (&timeout); + + break; + case DLL_PROCESS_DETACH: + Tcl_Finalize(); + _Module.Term(); + break; + default: + break; + } + return TRUE; // ok +} + +///////////////////////////////////////////////////////////////////////////// +// Used to determine whether the DLL can be unloaded by OLE + +STDAPI DllCanUnloadNow(void) +{ +#ifdef _MERGE_PROXYSTUB + if (PrxDllCanUnloadNow() != S_OK) + return S_FALSE; +#endif + return (_Module.GetLockCount()==0) ? S_OK : S_FALSE; +} + +///////////////////////////////////////////////////////////////////////////// +// Returns a class factory to create an object of the requested type + +STDAPI DllGetClassObject(REFCLSID rclsid, REFIID riid, LPVOID* ppv) +{ +#ifdef _MERGE_PROXYSTUB + if (PrxDllGetClassObject(rclsid, riid, ppv) == S_OK) + return S_OK; +#endif + return _Module.GetClassObject(rclsid, riid, ppv); +} + +///////////////////////////////////////////////////////////////////////////// +// DllRegisterServer - Adds entries to the system registry + +STDAPI DllRegisterServer(void) +{ +#ifdef _MERGE_PROXYSTUB + HRESULT hRes = PrxDllRegisterServer(); + if (FAILED(hRes)) + return hRes; +#endif + // registers object, typelib and all interfaces in typelib + return _Module.RegisterServer(TRUE); +} + +///////////////////////////////////////////////////////////////////////////// +// DllUnregisterServer - Removes entries from the system registry + +STDAPI DllUnregisterServer(void) +{ +#ifdef _MERGE_PROXYSTUB + PrxDllUnregisterServer(); +#endif + return _Module.UnregisterServer(TRUE); +} + + + + + + +// ------------------------------------------ + diff --git a/src/TclControlPrj2.def b/src/TclControlPrj2.def new file mode 100644 index 0000000..7cf155d --- /dev/null +++ b/src/TclControlPrj2.def @@ -0,0 +1,9 @@ +; TclControlPrj2.def : Declares the module parameters. + +LIBRARY "TclControl.dll" + +EXPORTS + DllCanUnloadNow @1 PRIVATE + DllGetClassObject @2 PRIVATE + DllRegisterServer @3 PRIVATE + DllUnregisterServer @4 PRIVATE diff --git a/src/TclControlPrj2.dsp b/src/TclControlPrj2.dsp new file mode 100644 index 0000000..46ca3aa --- /dev/null +++ b/src/TclControlPrj2.dsp @@ -0,0 +1,433 @@ +# Microsoft Developer Studio Project File - Name="TclControlPrj2" - Package Owner=<4> +# Microsoft Developer Studio Generated Build File, Format Version 6.00 +# ** DO NOT EDIT ** + +# TARGTYPE "Win32 (x86) Dynamic-Link Library" 0x0102 + +CFG=TclControlPrj2 - Win32 Debug Tcl84 +!MESSAGE This is not a valid makefile. To build this project using NMAKE, +!MESSAGE use the Export Makefile command and run +!MESSAGE +!MESSAGE NMAKE /f "TclControlPrj2.mak". +!MESSAGE +!MESSAGE You can specify a configuration when running NMAKE +!MESSAGE by defining the macro CFG on the command line. For example: +!MESSAGE +!MESSAGE NMAKE /f "TclControlPrj2.mak" CFG="TclControlPrj2 - Win32 Debug Tcl84" +!MESSAGE +!MESSAGE Possible choices for configuration are: +!MESSAGE +!MESSAGE "TclControlPrj2 - Win32 Release Tcl82" (based on "Win32 (x86) Dynamic-Link Library") +!MESSAGE "TclControlPrj2 - Win32 Debug Tcl82" (based on "Win32 (x86) Dynamic-Link Library") +!MESSAGE "TclControlPrj2 - Win32 Release Tcl80" (based on "Win32 (x86) Dynamic-Link Library") +!MESSAGE "TclControlPrj2 - Win32 Debug Tcl80" (based on "Win32 (x86) Dynamic-Link Library") +!MESSAGE "TclControlPrj2 - Win32 Release Tcl81" (based on "Win32 (x86) Dynamic-Link Library") +!MESSAGE "TclControlPrj2 - Win32 Debug Tcl81" (based on "Win32 (x86) Dynamic-Link Library") +!MESSAGE "TclControlPrj2 - Win32 Debug Tcl84" (based on "Win32 (x86) Dynamic-Link Library") +!MESSAGE "TclControlPrj2 - Win32 Release Tcl84" (based on "Win32 (x86) Dynamic-Link Library") +!MESSAGE + +# Begin Project +# PROP AllowPerConfigDependencies 0 +# PROP Scc_ProjName "" +# PROP Scc_LocalPath "" +CPP=cl.exe +MTL=midl.exe +RSC=rc.exe + +!IF "$(CFG)" == "TclControlPrj2 - Win32 Release Tcl82" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 0 +# PROP BASE Output_Dir "TclControlPrj2___Win32_Release_Tcl82" +# PROP BASE Intermediate_Dir "TclControlPrj2___Win32_Release_Tcl82" +# PROP BASE Ignore_Export_Lib 0 +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 0 +# PROP Output_Dir "Release_Tcl82" +# PROP Intermediate_Dir "Release_Tcl82" +# PROP Ignore_Export_Lib 0 +# PROP Target_Dir "" +# ADD BASE CPP /nologo /MT /W3 /O1 /I "c:\progra~1\tcl\include" /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "_ATL_STATIC_REGISTRY" /D "_ATL_MIN_CRT" /FR /Yu"stdafx.h" /FD /c +# ADD CPP /nologo /MT /W3 /O1 /I "c:\progra~1\tcl\include" /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "_ATL_STATIC_REGISTRY" /D "_ATL_MIN_CRT" /FR /Yu"stdafx.h" /FD /c +# ADD BASE RSC /l 0x809 /d "NDEBUG" +# ADD RSC /l 0x809 /d "NDEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +LINK32=link.exe +# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib tcl82.lib tk82.lib /nologo /subsystem:windows /dll /machine:I386 /out:"c:\progra~1\tcl\bin\TclControl.dll" /libpath:"c:\progra~1\tcl\lib\\" +# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib tcl82.lib tk82.lib /nologo /subsystem:windows /dll /machine:I386 /out:"..\bin\tclcontrol82.dll" /libpath:"c:\progra~1\tcl\lib\\" +# Begin Custom Build - Performing registration +OutDir=.\Release_Tcl82 +TargetPath=\twemp\tclcontrol\bin\tclcontrol82.dll +InputPath=\twemp\tclcontrol\bin\tclcontrol82.dll +SOURCE="$(InputPath)" + +"$(OutDir)\regsvr32.trg" : $(SOURCE) "$(INTDIR)" "$(OUTDIR)" + regsvr32 /s /c "$(TargetPath)" + echo regsvr32 exec. time > "$(OutDir)\regsvr32.trg" + +# End Custom Build + +!ELSEIF "$(CFG)" == "TclControlPrj2 - Win32 Debug Tcl82" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 1 +# PROP BASE Output_Dir "TclControlPrj2___Win32_Debug_Tcl82" +# PROP BASE Intermediate_Dir "TclControlPrj2___Win32_Debug_Tcl82" +# PROP BASE Ignore_Export_Lib 0 +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 1 +# PROP Output_Dir "Debug_Tcl82" +# PROP Intermediate_Dir "Debug_Tcl82" +# PROP Ignore_Export_Lib 0 +# PROP Target_Dir "" +# ADD BASE CPP /nologo /MTd /W3 /Gm /Gi /GX /ZI /Od /I "c:\progra~1\tcl\include" /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /FR /Yu"stdafx.h" /FD /GZ /c +# ADD CPP /nologo /MTd /W3 /Gm /Gi /GX /ZI /Od /I "c:\progra~1\tcl\include" /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /FR /Yu"stdafx.h" /FD /GZ /c +# ADD BASE RSC /l 0x809 /d "_DEBUG" +# ADD RSC /l 0x809 /d "_DEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +LINK32=link.exe +# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib tcl82.lib tk82.lib /nologo /subsystem:windows /dll /debug /machine:I386 /out:"c:\progra~1\tcl\bin\TclControl.dll" /pdbtype:sept /libpath:"c:\progra~1\tcl\lib\\" +# SUBTRACT BASE LINK32 /verbose +# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib tcl82.lib tk82.lib /nologo /subsystem:windows /dll /debug /machine:I386 /out:"..\bin\tclcontrol82.dll" /pdbtype:sept /libpath:"c:\progra~1\tcl\lib\\" +# SUBTRACT LINK32 /verbose +# Begin Custom Build - Performing registration +OutDir=.\Debug_Tcl82 +TargetPath=\twemp\tclcontrol\bin\tclcontrol82.dll +InputPath=\twemp\tclcontrol\bin\tclcontrol82.dll +SOURCE="$(InputPath)" + +"$(OutDir)\regsvr32.trg" : $(SOURCE) "$(INTDIR)" "$(OUTDIR)" + regsvr32 /s /c "$(TargetPath)" + echo regsvr32 exec. time > "$(OutDir)\regsvr32.trg" + +# End Custom Build + +!ELSEIF "$(CFG)" == "TclControlPrj2 - Win32 Release Tcl80" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 0 +# PROP BASE Output_Dir "TclControlPrj2___Win32_Release_Tcl80" +# PROP BASE Intermediate_Dir "TclControlPrj2___Win32_Release_Tcl80" +# PROP BASE Ignore_Export_Lib 0 +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 0 +# PROP Output_Dir "Release_Tcl80" +# PROP Intermediate_Dir "Release_Tcl80" +# PROP Ignore_Export_Lib 0 +# PROP Target_Dir "" +# ADD BASE CPP /nologo /MT /W3 /O1 /I "c:\progra~1\tcl\include" /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "_ATL_STATIC_REGISTRY" /D "_ATL_MIN_CRT" /FR /Yu"stdafx.h" /FD /c +# ADD CPP /nologo /MT /W3 /O1 /I "c:\progra~1\tcl\include" /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "_ATL_STATIC_REGISTRY" /D "_ATL_MIN_CRT" /FR /Yu"stdafx.h" /FD /c +# ADD BASE RSC /l 0x809 /d "NDEBUG" +# ADD RSC /l 0x809 /d "NDEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +LINK32=link.exe +# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib tcl82.lib tk82.lib /nologo /subsystem:windows /dll /machine:I386 /out:"c:\progra~1\tcl\bin\TclControl.dll" /libpath:"c:\progra~1\tcl\lib\\" +# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib tcl80.lib tk80.lib /nologo /subsystem:windows /dll /machine:I386 /out:"..\bin\tclcontrol80.dll" /libpath:"c:\progra~1\tcl\lib\\" +# Begin Custom Build - Performing registration +OutDir=.\Release_Tcl80 +TargetPath=\twemp\tclcontrol\bin\tclcontrol80.dll +InputPath=\twemp\tclcontrol\bin\tclcontrol80.dll +SOURCE="$(InputPath)" + +"$(OutDir)\regsvr32.trg" : $(SOURCE) "$(INTDIR)" "$(OUTDIR)" + regsvr32 /s /c "$(TargetPath)" + echo regsvr32 exec. time > "$(OutDir)\regsvr32.trg" + +# End Custom Build + +!ELSEIF "$(CFG)" == "TclControlPrj2 - Win32 Debug Tcl80" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 1 +# PROP BASE Output_Dir "TclControlPrj2___Win32_Debug_Tcl80" +# PROP BASE Intermediate_Dir "TclControlPrj2___Win32_Debug_Tcl80" +# PROP BASE Ignore_Export_Lib 0 +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 1 +# PROP Output_Dir "Debug_Tcl80" +# PROP Intermediate_Dir "Debug_Tcl80" +# PROP Ignore_Export_Lib 0 +# PROP Target_Dir "" +# ADD BASE CPP /nologo /MTd /W3 /Gm /Gi /GX /ZI /Od /I "c:\progra~1\tcl\include" /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /FR /Yu"stdafx.h" /FD /GZ /c +# ADD CPP /nologo /MTd /W3 /Gm /Gi /GX /ZI /Od /I "c:\progra~1\tcl\include" /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /FR /Yu"stdafx.h" /FD /GZ /c +# ADD BASE RSC /l 0x809 /d "_DEBUG" +# ADD RSC /l 0x809 /d "_DEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +LINK32=link.exe +# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib tcl82.lib tk82.lib /nologo /subsystem:windows /dll /debug /machine:I386 /out:"c:\progra~1\tcl\bin\TclControl.dll" /pdbtype:sept /libpath:"c:\progra~1\tcl\lib\\" +# SUBTRACT BASE LINK32 /verbose +# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib tcl80.lib tk80.lib /nologo /subsystem:windows /dll /debug /machine:I386 /out:"..\bin\tclcontrol80.dll" /pdbtype:sept /libpath:"c:\progra~1\tcl\lib\\" +# SUBTRACT LINK32 /verbose +# Begin Custom Build - Performing registration +OutDir=.\Debug_Tcl80 +TargetPath=\twemp\tclcontrol\bin\tclcontrol80.dll +InputPath=\twemp\tclcontrol\bin\tclcontrol80.dll +SOURCE="$(InputPath)" + +"$(OutDir)\regsvr32.trg" : $(SOURCE) "$(INTDIR)" "$(OUTDIR)" + regsvr32 /s /c "$(TargetPath)" + echo regsvr32 exec. time > "$(OutDir)\regsvr32.trg" + +# End Custom Build + +!ELSEIF "$(CFG)" == "TclControlPrj2 - Win32 Release Tcl81" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 0 +# PROP BASE Output_Dir "TclControlPrj2___Win32_Release_Tcl81" +# PROP BASE Intermediate_Dir "TclControlPrj2___Win32_Release_Tcl81" +# PROP BASE Ignore_Export_Lib 0 +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 0 +# PROP Output_Dir "Release_Tcl81" +# PROP Intermediate_Dir "Release_Tcl81" +# PROP Ignore_Export_Lib 0 +# PROP Target_Dir "" +# ADD BASE CPP /nologo /MT /W3 /O1 /I "c:\progra~1\tcl\include" /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "_ATL_STATIC_REGISTRY" /D "_ATL_MIN_CRT" /FR /Yu"stdafx.h" /FD /c +# ADD CPP /nologo /MT /W3 /O1 /I "c:\progra~1\tcl\include" /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "_ATL_STATIC_REGISTRY" /D "_ATL_MIN_CRT" /FR /Yu"stdafx.h" /FD /c +# ADD BASE RSC /l 0x809 /d "NDEBUG" +# ADD RSC /l 0x809 /d "NDEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +LINK32=link.exe +# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib tcl80.lib tk80.lib /nologo /subsystem:windows /dll /machine:I386 /out:"..\bin\tclcontrol80.dll" /libpath:"c:\progra~1\tcl\lib\\" +# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib tcl81.lib tk81.lib /nologo /subsystem:windows /dll /machine:I386 /out:"..\bin\tclcontrol81.dll" /libpath:"c:\progra~1\tcl\lib\\" +# Begin Custom Build - Performing registration +OutDir=.\Release_Tcl81 +TargetPath=\twemp\tclcontrol\bin\tclcontrol81.dll +InputPath=\twemp\tclcontrol\bin\tclcontrol81.dll +SOURCE="$(InputPath)" + +"$(OutDir)\regsvr32.trg" : $(SOURCE) "$(INTDIR)" "$(OUTDIR)" + regsvr32 /s /c "$(TargetPath)" + echo regsvr32 exec. time > "$(OutDir)\regsvr32.trg" + +# End Custom Build + +!ELSEIF "$(CFG)" == "TclControlPrj2 - Win32 Debug Tcl81" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 1 +# PROP BASE Output_Dir "TclControlPrj2___Win32_Debug_Tcl81" +# PROP BASE Intermediate_Dir "TclControlPrj2___Win32_Debug_Tcl81" +# PROP BASE Ignore_Export_Lib 0 +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 1 +# PROP Output_Dir "Debug_Tcl81" +# PROP Intermediate_Dir "Debug_Tcl81" +# PROP Ignore_Export_Lib 0 +# PROP Target_Dir "" +# ADD BASE CPP /nologo /MTd /W3 /Gm /Gi /GX /ZI /Od /I "c:\progra~1\tcl\include" /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /FR /Yu"stdafx.h" /FD /GZ /c +# ADD CPP /nologo /MTd /W3 /Gm /Gi /GX /ZI /Od /I "c:\progra~1\tcl\include" /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /FR /Yu"stdafx.h" /FD /GZ /c +# ADD BASE RSC /l 0x809 /d "_DEBUG" +# ADD RSC /l 0x809 /d "_DEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +LINK32=link.exe +# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib tcl80.lib tk80.lib /nologo /subsystem:windows /dll /debug /machine:I386 /out:"..\bin\tclcontrol80.dll" /pdbtype:sept /libpath:"c:\progra~1\tcl\lib\\" +# SUBTRACT BASE LINK32 /verbose +# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib tcl81.lib tk81.lib /nologo /subsystem:windows /dll /debug /machine:I386 /out:"..\bin\tclcontrol81.dll" /pdbtype:sept /libpath:"c:\progra~1\tcl\lib\\" +# SUBTRACT LINK32 /verbose +# Begin Custom Build - Performing registration +OutDir=.\Debug_Tcl81 +TargetPath=\twemp\tclcontrol\bin\tclcontrol81.dll +InputPath=\twemp\tclcontrol\bin\tclcontrol81.dll +SOURCE="$(InputPath)" + +"$(OutDir)\regsvr32.trg" : $(SOURCE) "$(INTDIR)" "$(OUTDIR)" + regsvr32 /s /c "$(TargetPath)" + echo regsvr32 exec. time > "$(OutDir)\regsvr32.trg" + +# End Custom Build + +!ELSEIF "$(CFG)" == "TclControlPrj2 - Win32 Debug Tcl84" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 1 +# PROP BASE Output_Dir "TclControlPrj2___Win32_Debug_Tcl84" +# PROP BASE Intermediate_Dir "TclControlPrj2___Win32_Debug_Tcl84" +# PROP BASE Ignore_Export_Lib 0 +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 1 +# PROP Output_Dir "TclControlPrj2___Win32_Debug_Tcl84" +# PROP Intermediate_Dir "TclControlPrj2___Win32_Debug_Tcl84" +# PROP Ignore_Export_Lib 0 +# PROP Target_Dir "" +# ADD BASE CPP /nologo /MTd /W3 /Gm /Gi /GX /ZI /Od /I "c:\progra~1\tcl\include" /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /FR /Yu"stdafx.h" /FD /GZ /c +# ADD CPP /nologo /MTd /W3 /Gm /Gi /GX /ZI /Od /I "c:\progra~1\tcl\include" /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /FR /Yu"stdafx.h" /FD /GZ /c +# ADD BASE RSC /l 0x809 /d "_DEBUG" +# ADD RSC /l 0x809 /d "_DEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +LINK32=link.exe +# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib tcl80.lib tk80.lib /nologo /subsystem:windows /dll /debug /machine:I386 /out:"..\bin\tclcontrol80.dll" /pdbtype:sept /libpath:"c:\progra~1\tcl\lib\\" +# SUBTRACT BASE LINK32 /verbose +# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib tcl84.lib tk84.lib /nologo /subsystem:windows /dll /debug /machine:I386 /out:"c:\progra~1\tcl\bin\tclcontrol84.dll" /pdbtype:sept /libpath:"c:\progra~1\tcl\lib\\" +# SUBTRACT LINK32 /verbose +# Begin Custom Build - Performing registration +OutDir=.\TclControlPrj2___Win32_Debug_Tcl84 +TargetPath=\progra~1\tcl\bin\tclcontrol84.dll +InputPath=\progra~1\tcl\bin\tclcontrol84.dll +SOURCE="$(InputPath)" + +"$(OutDir)\regsvr32.trg" : $(SOURCE) "$(INTDIR)" "$(OUTDIR)" + regsvr32 /s /c "$(TargetPath)" + echo regsvr32 exec. time > "$(OutDir)\regsvr32.trg" + +# End Custom Build + +!ELSEIF "$(CFG)" == "TclControlPrj2 - Win32 Release Tcl84" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 0 +# PROP BASE Output_Dir "TclControlPrj2___Win32_Release_Tcl84" +# PROP BASE Intermediate_Dir "TclControlPrj2___Win32_Release_Tcl84" +# PROP BASE Ignore_Export_Lib 0 +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 0 +# PROP Output_Dir "TclControlPrj2___Win32_Release_Tcl84" +# PROP Intermediate_Dir "TclControlPrj2___Win32_Release_Tcl84" +# PROP Ignore_Export_Lib 0 +# PROP Target_Dir "" +# ADD BASE CPP /nologo /MT /W3 /O1 /I "c:\progra~1\tcl\include" /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "_ATL_STATIC_REGISTRY" /D "_ATL_MIN_CRT" /FR /Yu"stdafx.h" /FD /c +# ADD CPP /nologo /MT /W3 /GX /O1 /I "c:\progra~1\tcl\include" /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "_ATL_STATIC_REGISTRY" /D "_ATL_MIN_CRT" /FR /Yu"stdafx.h" /FD /c +# ADD BASE RSC /l 0x809 /d "NDEBUG" +# ADD RSC /l 0x809 /d "NDEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +LINK32=link.exe +# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib tcl80.lib tk80.lib /nologo /subsystem:windows /dll /machine:I386 /out:"..\bin\tclcontrol80.dll" /libpath:"c:\progra~1\tcl\lib\\" +# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib tcl84.lib tk84.lib /nologo /subsystem:windows /dll /machine:I386 /out:"c:\progra~1\tcl\bin\tclcontrol.dll" /libpath:"c:\progra~1\tcl\lib\\" +# Begin Custom Build - Performing registration +OutDir=.\TclControlPrj2___Win32_Release_Tcl84 +TargetPath=\progra~1\tcl\bin\tclcontrol.dll +InputPath=\progra~1\tcl\bin\tclcontrol.dll +SOURCE="$(InputPath)" + +"$(OutDir)\regsvr32.trg" : $(SOURCE) "$(INTDIR)" "$(OUTDIR)" + regsvr32 /s /c "$(TargetPath)" + echo regsvr32 exec. time > "$(OutDir)\regsvr32.trg" + +# End Custom Build + +!ENDIF + +# Begin Target + +# Name "TclControlPrj2 - Win32 Release Tcl82" +# Name "TclControlPrj2 - Win32 Debug Tcl82" +# Name "TclControlPrj2 - Win32 Release Tcl80" +# Name "TclControlPrj2 - Win32 Debug Tcl80" +# Name "TclControlPrj2 - Win32 Release Tcl81" +# Name "TclControlPrj2 - Win32 Debug Tcl81" +# Name "TclControlPrj2 - Win32 Debug Tcl84" +# Name "TclControlPrj2 - Win32 Release Tcl84" +# Begin Group "Source Files" + +# PROP Default_Filter "cpp;c;cxx;rc;def;r;odl;idl;hpj;bat" +# Begin Source File + +SOURCE=.\dlldatax.c +# PROP Exclude_From_Scan -1 +# PROP BASE Exclude_From_Build 1 +# PROP Exclude_From_Build 1 +# End Source File +# Begin Source File + +SOURCE=.\StdAfx.cpp +# ADD BASE CPP /Yc"stdafx.h" +# ADD CPP /Yc"stdafx.h" +# End Source File +# Begin Source File + +SOURCE=.\TclClassFactory.cpp +# End Source File +# Begin Source File + +SOURCE=.\TclControl.cpp +# End Source File +# Begin Source File + +SOURCE=.\TclControlPrj2.cpp +# End Source File +# Begin Source File + +SOURCE=.\TclControlPrj2.def +# End Source File +# Begin Source File + +SOURCE=.\TclControlPrj2.idl +# ADD BASE MTL /tlb ".\TclControlPrj2.tlb" /h "TclControlPrj2.h" /iid "TclControlPrj2_i.c" /Oicf +# ADD MTL /tlb ".\TclControlPrj2.tlb" /h "TclControlPrj2.h" /iid "TclControlPrj2_i.c" /Oicf +# End Source File +# Begin Source File + +SOURCE=.\TclControlPrj2.rc +# End Source File +# End Group +# Begin Group "Header Files" + +# PROP Default_Filter "h;hpp;hxx;hm;inl" +# Begin Source File + +SOURCE=.\dlldatax.h +# PROP Exclude_From_Scan -1 +# PROP BASE Exclude_From_Build 1 +# PROP Exclude_From_Build 1 +# End Source File +# Begin Source File + +SOURCE=.\Resource.h +# End Source File +# Begin Source File + +SOURCE=.\StdAfx.h +# End Source File +# Begin Source File + +SOURCE=.\TclClassFactory.h +# End Source File +# Begin Source File + +SOURCE=.\TclControl.h +# End Source File +# Begin Source File + +SOURCE=.\TclControlPrj2CP.h +# End Source File +# End Group +# Begin Group "Resource Files" + +# PROP Default_Filter "ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe" +# Begin Source File + +SOURCE=.\tclcontr.bmp +# End Source File +# Begin Source File + +SOURCE=.\TclControl.rgs +# End Source File +# End Group +# End Target +# End Project diff --git a/src/TclControlPrj2.dsw b/src/TclControlPrj2.dsw new file mode 100644 index 0000000..9bf2ca1 --- /dev/null +++ b/src/TclControlPrj2.dsw @@ -0,0 +1,29 @@ +Microsoft Developer Studio Workspace File, Format Version 6.00 +# WARNING: DO NOT EDIT OR DELETE THIS WORKSPACE FILE! + +############################################################################### + +Project: "TclControlPrj2"=.\TclControlPrj2.dsp - Package Owner=<4> + +Package=<5> +{{{ +}}} + +Package=<4> +{{{ +}}} + +############################################################################### + +Global: + +Package=<5> +{{{ +}}} + +Package=<3> +{{{ +}}} + +############################################################################### + diff --git a/src/TclControlPrj2.idl b/src/TclControlPrj2.idl new file mode 100644 index 0000000..1dd5f7c --- /dev/null +++ b/src/TclControlPrj2.idl @@ -0,0 +1,80 @@ +// TclControlPrj2.idl : IDL source for TclControlPrj2.dll +// + +// This file will be processed by the MIDL tool to +// produce the type library (TclControlPrj2.tlb) and marshalling code. + +import "oaidl.idl"; +import "ocidl.idl"; +#include "olectl.h" + + + [ + object, + uuid(E796A72E-F130-11D2-8003-0040055861F2), + dual, + helpstring("ITclControl Interface"), + pointer_default(unique) + ] + interface ITclControl : IDispatch + { + [propget, id(1), helpstring("Current result of the interpreter")] HRESULT Result([out, retval] BSTR *pVal); + [id(2), helpstring("Evaluate a script in the Tcl interpreter")] HRESULT Eval([in] BSTR command, [out, retval] VARIANT_BOOL *pbOk); + [id(3), helpstring("Place a trace on a variable")] HRESULT TraceVar([in] BSTR name, [in] long flags, [out, retval] VARIANT_BOOL *pbOk); + [id(4), helpstring("Place trace on an array element")] HRESULT TraceVar2([in] BSTR name1, [in] BSTR name2, [in] long flags, [out, retval] VARIANT_BOOL *pbOk); + [id(5), helpstring("Remove a trace on a Tcl variable")] HRESULT UntraceVar([in] BSTR name, [in] long flags); + [id(6), helpstring("Remove a trace on a Tcl array element")] HRESULT UntraceVar2([in] BSTR name1, [in] BSTR name2, [in] long flags); + [id(7), helpstring("Set the value of a variable.")] HRESULT SetVar([in] BSTR name, [in] BSTR value, [in] long flags, [out, retval] VARIANT_BOOL *pbOk); + [id(8), helpstring("Get the value of a variable.")] HRESULT GetVar([in] BSTR name, [in] long flags, [out, retval] BSTR *pValue); + [id(9), helpstring("Sets the value of an array entry.")] HRESULT SetVar2([in] BSTR name1, [in] BSTR name2, [in] BSTR value, [in] long flags, [out, retval] VARIANT_BOOL *pbOk); + [id(10), helpstring("Returns the value of an array entry.")] HRESULT GetVar2([in] BSTR name1, [in] BSTR name2, [in] long flags, [out, retval] BSTR *pVal); + [id(11), helpstring("Unsets a Tcl variable.")] HRESULT UnsetVar([in] BSTR name, [in] long flags); + [id(12), helpstring("Unset a Tcl array entry.")] HRESULT UnsetVar2([in] BSTR name1, [in] BSTR name2, [in] long flags); + }; + +[ + uuid(E796A720-F130-11D2-8003-0040055861F2), + version(1.0), + helpstring("TclControlPrj2 1.0 Type Library") +] +library TCLCONTROLPRJ2Lib +{ + importlib("stdole32.tlb"); + importlib("stdole2.tlb"); + + typedef enum { + GLOBAL_ONLY = 1, + NAMESPACE_ONLY = 2, + APPEND_VALUE = 4, + LIST_ELEMENT = 8, + TRACE_READS = 0x10, + TRACE_WRITES = 0x20, + TRACE_UNSETS = 0x40, + TRACE_DESTROYED = 0x80, + INTERP_DESTROYED = 0x100, + LEAVE_ERR_MSG = 0x200, + PARSE_PART1 = 0x400 + } Flags; + + [ + uuid(E796A730-F130-11D2-8003-0040055861F2), + helpstring("_ITclControlEvents Interface") + ] + dispinterface _ITclControlEvents + { + properties: + methods: + [id(1), helpstring("Called when a client-traced variable is accessed")] void OnTraceVar([in] BSTR name1, [in] long flags); + [id(2), helpstring("Called when a client-traced array is accessed")] void OnTraceVar2([in] BSTR name1, [in] BSTR name2, [in] long flags); + }; + + [ + uuid(E796A72F-F130-11D2-8003-0040055861F2), + helpstring("TclControl Class") + ] + coclass TclControl + { + [default] interface ITclControl; + [default, source] dispinterface _ITclControlEvents; + }; +}; diff --git a/src/TclControlPrj2.rc b/src/TclControlPrj2.rc new file mode 100644 index 0000000..7ce8d42 --- /dev/null +++ b/src/TclControlPrj2.rc @@ -0,0 +1,147 @@ +//Microsoft Developer Studio generated resource script. +// +#include "resource.h" + +#define APSTUDIO_READONLY_SYMBOLS +///////////////////////////////////////////////////////////////////////////// +// +// Generated from the TEXTINCLUDE 2 resource. +// +#include "winres.h" + +///////////////////////////////////////////////////////////////////////////// +#undef APSTUDIO_READONLY_SYMBOLS + +///////////////////////////////////////////////////////////////////////////// +// English (U.S.) resources + +#if !defined(AFX_RESOURCE_DLL) || defined(AFX_TARG_ENU) +#ifdef _WIN32 +LANGUAGE LANG_ENGLISH, SUBLANG_ENGLISH_US +#pragma code_page(1252) +#endif //_WIN32 + +#ifdef APSTUDIO_INVOKED +///////////////////////////////////////////////////////////////////////////// +// +// TEXTINCLUDE +// + +1 TEXTINCLUDE DISCARDABLE +BEGIN + "resource.h\0" +END + +2 TEXTINCLUDE DISCARDABLE +BEGIN + "#include ""winres.h""\r\n" + "\0" +END + +3 TEXTINCLUDE DISCARDABLE +BEGIN + "1 TYPELIB ""TclControlPrj2.tlb""\r\n" + "\0" +END + +#endif // APSTUDIO_INVOKED + + +#ifndef _MAC +///////////////////////////////////////////////////////////////////////////// +// +// Version +// + +VS_VERSION_INFO VERSIONINFO + FILEVERSION 1,0,0,1 + PRODUCTVERSION 1,0,0,1 + FILEFLAGSMASK 0x3fL +#ifdef _DEBUG + FILEFLAGS 0x1L +#else + FILEFLAGS 0x0L +#endif + FILEOS 0x4L + FILETYPE 0x2L + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904b0" + BEGIN + VALUE "Comments", "Written by Farzad Pezeshkpour\0" + VALUE "CompanyName", "University of East Anglia\0" + VALUE "FileDescription", "TclControlPrj2 Module\0" + VALUE "FileVersion", "1, 0, 0, 1\0" + VALUE "InternalName", "TclControlPrj2\0" + VALUE "LegalCopyright", "Copyright 1999\0" + VALUE "LegalTrademarks", "Public Licence\0" + VALUE "OLESelfRegister", "\0" + VALUE "OriginalFilename", "TclControlPrj2.DLL\0" + VALUE "PrivateBuild", "\0" + VALUE "ProductName", "TclControlPrj2 Module\0" + VALUE "ProductVersion", "1, 0, 0, 1\0" + VALUE "SpecialBuild", "\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x409, 1200 + END +END + +#endif // !_MAC + + +///////////////////////////////////////////////////////////////////////////// +// +// String Table +// + +STRINGTABLE DISCARDABLE +BEGIN + IDS_PROJNAME "TclControlPrj2" +END + +#endif // English (U.S.) resources +///////////////////////////////////////////////////////////////////////////// + + +///////////////////////////////////////////////////////////////////////////// +// English (U.K.) resources + +#if !defined(AFX_RESOURCE_DLL) || defined(AFX_TARG_ENG) +#ifdef _WIN32 +LANGUAGE LANG_ENGLISH, SUBLANG_ENGLISH_UK +#pragma code_page(1252) +#endif //_WIN32 + +///////////////////////////////////////////////////////////////////////////// +// +// Bitmap +// + +IDB_TCLCONTROL BITMAP DISCARDABLE "tclcontr.bmp" + +///////////////////////////////////////////////////////////////////////////// +// +// REGISTRY +// + +IDR_TCLCONTROL REGISTRY DISCARDABLE "TclControl.rgs" +#endif // English (U.K.) resources +///////////////////////////////////////////////////////////////////////////// + + + +#ifndef APSTUDIO_INVOKED +///////////////////////////////////////////////////////////////////////////// +// +// Generated from the TEXTINCLUDE 3 resource. +// +1 TYPELIB "TclControlPrj2.tlb" + +///////////////////////////////////////////////////////////////////////////// +#endif // not APSTUDIO_INVOKED + diff --git a/src/TclControlPrj2CP.h b/src/TclControlPrj2CP.h new file mode 100644 index 0000000..1f61a7e --- /dev/null +++ b/src/TclControlPrj2CP.h @@ -0,0 +1,60 @@ +#ifndef _TCLCONTROLPRJ2CP_H_ +#define _TCLCONTROLPRJ2CP_H_ + + +template +class CProxy_ITclControlEvents : public IConnectionPointImpl +{ + //Warning this class may be recreated by the wizard. +public: + VOID Fire_OnTraceVar(BSTR name1, LONG Flags) + { + T* pT = static_cast(this); + int nConnectionIndex; + CComVariant* pvars = new CComVariant[2]; + int nConnections = m_vec.GetSize(); + + for (nConnectionIndex = 0; nConnectionIndex < nConnections; nConnectionIndex++) + { + pT->Lock(); + CComPtr sp = m_vec.GetAt(nConnectionIndex); + pT->Unlock(); + IDispatch* pDispatch = reinterpret_cast(sp.p); + if (pDispatch != NULL) + { + pvars[1] = name1; + pvars[0] = Flags; + DISPPARAMS disp = { pvars, NULL, 2, 0 }; + pDispatch->Invoke(0x1, IID_NULL, LOCALE_USER_DEFAULT, DISPATCH_METHOD, &disp, NULL, NULL, NULL); + } + } + delete[] pvars; + + } + VOID Fire_OnTraceVar2(BSTR name1, BSTR name2, LONG Flags) + { + T* pT = static_cast(this); + int nConnectionIndex; + CComVariant* pvars = new CComVariant[3]; + int nConnections = m_vec.GetSize(); + + for (nConnectionIndex = 0; nConnectionIndex < nConnections; nConnectionIndex++) + { + pT->Lock(); + CComPtr sp = m_vec.GetAt(nConnectionIndex); + pT->Unlock(); + IDispatch* pDispatch = reinterpret_cast(sp.p); + if (pDispatch != NULL) + { + pvars[2] = name1; + pvars[1] = name2; + pvars[0] = Flags; + DISPPARAMS disp = { pvars, NULL, 3, 0 }; + pDispatch->Invoke(0x2, IID_NULL, LOCALE_USER_DEFAULT, DISPATCH_METHOD, &disp, NULL, NULL, NULL); + } + } + delete[] pvars; + + } +}; +#endif \ No newline at end of file diff --git a/src/TclControlPrj2ps.def b/src/TclControlPrj2ps.def new file mode 100644 index 0000000..536361b --- /dev/null +++ b/src/TclControlPrj2ps.def @@ -0,0 +1,11 @@ + +LIBRARY "TclControlPrj2PS" + +DESCRIPTION 'Proxy/Stub DLL' + +EXPORTS + DllGetClassObject @1 PRIVATE + DllCanUnloadNow @2 PRIVATE + GetProxyDllInfo @3 PRIVATE + DllRegisterServer @4 PRIVATE + DllUnregisterServer @5 PRIVATE diff --git a/src/TclControlPrj2ps.mk b/src/TclControlPrj2ps.mk new file mode 100644 index 0000000..ca86084 --- /dev/null +++ b/src/TclControlPrj2ps.mk @@ -0,0 +1,16 @@ + +TclControlPrj2ps.dll: dlldata.obj TclControlPrj2_p.obj TclControlPrj2_i.obj + link /dll /out:TclControlPrj2ps.dll /def:TclControlPrj2ps.def /entry:DllMain dlldata.obj TclControlPrj2_p.obj TclControlPrj2_i.obj \ + kernel32.lib rpcndr.lib rpcns4.lib rpcrt4.lib oleaut32.lib uuid.lib \ + +.c.obj: + cl /c /Ox /DWIN32 /D_WIN32_WINNT=0x0400 /DREGISTER_PROXY_DLL \ + $< + +clean: + @del TclControlPrj2ps.dll + @del TclControlPrj2ps.lib + @del TclControlPrj2ps.exp + @del dlldata.obj + @del TclControlPrj2_p.obj + @del TclControlPrj2_i.obj diff --git a/src/dlldatax.c b/src/dlldatax.c new file mode 100644 index 0000000..3e618be --- /dev/null +++ b/src/dlldatax.c @@ -0,0 +1,42 @@ +// wrapper for dlldata.c + +#ifdef _MERGE_PROXYSTUB // merge proxy stub DLL + +#define REGISTER_PROXY_DLL //DllRegisterServer, etc. + +#define _WIN32_WINNT 0x0400 //for WinNT 4.0 or Win95 with DCOM +#define USE_STUBLESS_PROXY //defined only with MIDL switch /Oicf + +#pragma comment(lib, "rpcndr.lib") +#pragma comment(lib, "rpcns4.lib") +#pragma comment(lib, "rpcrt4.lib") + +#define DllMain PrxDllMain +#define DllRegisterServer PrxDllRegisterServer +#define DllUnregisterServer PrxDllUnregisterServer +#define DllGetClassObject PrxDllGetClassObject +#define DllCanUnloadNow PrxDllCanUnloadNow + +#include "dlldata.c" +#include "TclControlPrj2_p.c" + +#ifdef _NOPROXY //no midl generated dlldata.c + +#define STRICT 1 +#include + +BOOL WINAPI PrxDllMain(HINSTANCE hInstance, DWORD dwReason, LPVOID lpReserved) +{return TRUE;} + +STDAPI PrxDllCanUnloadNow(void){return S_OK;} + +STDAPI PrxDllGetClassObject(REFCLSID rclsid, REFIID riid, LPVOID* ppv) +{return CLASS_E_CLASSNOTAVAILABLE;} + +STDAPI PrxDllRegisterServer(void){return S_OK;} + +STDAPI PrxDllUnregisterServer(void){return S_OK;} + +#endif //!PROXY_DELEGATION + +#endif //_MERGE_PROXYSTUB diff --git a/src/dlldatax.h b/src/dlldatax.h new file mode 100644 index 0000000..7ce37a0 --- /dev/null +++ b/src/dlldatax.h @@ -0,0 +1,25 @@ +#if !defined(AFX_DLLDATAX_H__E796A72B_F130_11D2_8003_0040055861F2__INCLUDED_) +#define AFX_DLLDATAX_H__E796A72B_F130_11D2_8003_0040055861F2__INCLUDED_ + +#if _MSC_VER > 1000 +#pragma once +#endif // _MSC_VER > 1000 + +#ifdef _MERGE_PROXYSTUB + +extern "C" +{ +BOOL WINAPI PrxDllMain(HINSTANCE hInstance, DWORD dwReason, + LPVOID lpReserved); +STDAPI PrxDllCanUnloadNow(void); +STDAPI PrxDllGetClassObject(REFCLSID rclsid, REFIID riid, LPVOID* ppv); +STDAPI PrxDllRegisterServer(void); +STDAPI PrxDllUnregisterServer(void); +} + +#endif + +//{{AFX_INSERT_LOCATION}} +// Microsoft Visual C++ will insert additional declarations immediately before the previous line. + +#endif // !defined(AFX_DLLDATAX_H__E796A72B_F130_11D2_8003_0040055861F2__INCLUDED_) diff --git a/src/resource.h b/src/resource.h new file mode 100644 index 0000000..c6cb34e --- /dev/null +++ b/src/resource.h @@ -0,0 +1,18 @@ +//{{NO_DEPENDENCIES}} +// Microsoft Developer Studio generated include file. +// Used by TclControlPrj2.rc +// +#define IDS_PROJNAME 100 +#define IDB_TCLCONTROL 101 +#define IDR_TCLCONTROL 102 + +// Next default values for new objects +// +#ifdef APSTUDIO_INVOKED +#ifndef APSTUDIO_READONLY_SYMBOLS +#define _APS_NEXT_RESOURCE_VALUE 201 +#define _APS_NEXT_COMMAND_VALUE 32768 +#define _APS_NEXT_CONTROL_VALUE 201 +#define _APS_NEXT_SYMED_VALUE 103 +#endif +#endif diff --git a/src/tclcontr.bmp b/src/tclcontr.bmp new file mode 100644 index 0000000..8048e37 Binary files /dev/null and b/src/tclcontr.bmp differ

TclControl +v2.0b build 03

Overview and Changes

Requirements

Installation and Uninstallation.

Examples

Known Problems

TclControl
+v2.0b build 03