This script demonstrates how to create a Windows-alike application. It may serve as a starting point for your own applications.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 | # poAppFrame.tcl
# Example application framework.
# Needs packages poToolhelp and poToolbar.
# Paul Obermeier, 2001.
catch {console show}
set auto_path [linsert $auto_path 0 [file dirname [info script]]]
package require poToolhelp
package require poToolbar
proc NewBmp {} {
return {
#define newfile_width 16
#define newfile_height 16
static unsigned char newfile_bits[] = {
0x00, 0x00, 0x00, 0x00, 0xfc, 0x03, 0x04, 0x06, 0x04, 0x0a, 0x04, 0x1e,
0x04, 0x10, 0x04, 0x10, 0x04, 0x10, 0x04, 0x10, 0x04, 0x10, 0x04, 0x10,
0x04, 0x10, 0x04, 0x10, 0xfc, 0x1f, 0x00, 0x00};
}
}
proc OpenBmp {} {
return {
#define open_width 16
#define open_height 16
static unsigned char open_bits[] = {
0x00, 0x00, 0x00, 0x0e, 0x00, 0x51, 0x00, 0x60, 0x0e, 0x70, 0xf1, 0x07,
0x01, 0x04, 0x01, 0x04, 0xe1, 0xff, 0x11, 0x40, 0x09, 0x20, 0x05, 0x10,
0x03, 0x08, 0xff, 0x07, 0x00, 0x00, 0x00, 0x00};
}
}
proc SaveBmp {} {
return {
#define save_width 16
#define save_height 16
static unsigned char save_bits[] = {
0x00, 0x00, 0xfe, 0x7f, 0x0a, 0x50, 0x0a, 0x70, 0x0e, 0x50, 0x0e, 0x50,
0x0e, 0x50, 0x0a, 0x50, 0xf2, 0x4f, 0x02, 0x40, 0xf2, 0x5f, 0xf2, 0x53,
0xf2, 0x53, 0xf2, 0x53, 0xfc, 0x7f, 0x00, 0x00};
}
}
proc NewProc {} {
WriteInfoStr "You selected NewProc"
}
proc OpenProc {} {
WriteInfoStr "You selected OpenProc"
}
proc SaveProc {} {
WriteInfoStr "You selected SaveProc"
}
proc HelpProc {} {
tk_messageBox -title "Help window" \
-message "Tcl/Tk application framework written by Paul Obermeier" \
-type ok -icon info
focus .
}
proc AddMenuCmd { menu label acc cmd } {
$menu add command -label $label -accelerator $acc -command $cmd
}
proc WriteInfoStr { str } {
.fr.infofr.l configure -text $str
}
set hMenu .menufr
menu $hMenu -borderwidth 2 -relief sunken
$hMenu add cascade -menu $hMenu.file -label File -underline 0
$hMenu add cascade -menu $hMenu.help -label Help -underline 0
set fileMenu $hMenu.file
menu $fileMenu -tearoff 0
AddMenuCmd $fileMenu "New ..." "Ctrl+N" NewProc
AddMenuCmd $fileMenu "Open ..." "Ctrl+O" OpenProc
AddMenuCmd $fileMenu "Save ..." "Ctrl+S" SaveProc
AddMenuCmd $fileMenu "Quit ..." "Ctrl+Q" exit
bind . <Control-n> NewProc
bind . <Control-o> OpenProc
bind . <Control-s> SaveProc
bind . <Control-q> exit
set helpMenu $hMenu.help
menu $helpMenu -tearoff 0
AddMenuCmd $helpMenu "About ..." "F1" HelpProc
bind . <F1> HelpProc
wm protocol . WM_DELETE_WINDOW "exit"
. configure -menu $hMenu
frame .fr
pack .fr -fill both -expand 1
frame .fr.toolfr -relief sunken -borderwidth 1
frame .fr.workfr -relief sunken -borderwidth 1 -bg green
frame .fr.infofr -relief sunken -borderwidth 1
grid .fr.toolfr -row 0 -column 0 -sticky ew
grid .fr.workfr -row 1 -column 0 -sticky news
grid .fr.infofr -row 2 -column 0 -sticky ew
grid rowconfigure .fr 1 -weight 1
grid columnconfigure .fr 0 -weight 1
label .fr.infofr.l -text "Info widget"
pack .fr.infofr.l -fill both -expand 1
label .fr.workfr.l \
-text "This is the working frame for your widgets" \
-bg green
pack .fr.workfr.l -fill x -expand 1
for {set grp 0} {$grp < 3} {incr grp} {
set newGrp [::poToolbar::AddGroup .fr.toolfr]
::poToolbar::AddButton $newGrp.new [NewBmp] NewProc \
"New something (Ctrl+N)" -activebackground green
::poToolbar::AddButton $newGrp.open [OpenBmp] OpenProc \
"Open something (Ctrl+O)" -activebackground yellow
::poToolbar::AddButton $newGrp.save [SaveBmp] SaveProc \
"Save something (Ctrl+S)" -activebackground red
}
|
You need the packages poToolhelp and poToolbar (available as a recipe, too).
You have to put the following 2 lines into a file pkgIndex.tcl, so that the application finds the needed packages:
package ifneeded poToolhelp 1.0 "source [file join $dir poToolhelp.tcl]" package ifneeded poToolbar 1.0 "source [file join $dir poToolbar.tcl]"
Create a new directory (ex. poLib) in the lib directory of your Tcl installation.
On Windows this is typically C:\Program Files\Tcl\lib. On Unix typically /usr/local/lib.
Put the files pkgIndex.tcl, poToolhelp.tcl and poToolbar.tcl into this new directory. Now you are ready to start poAppFrame.tcl
Have fun