Welcome, guest | Sign In | My Account | Store | Cart

This script demonstrates how to create a Windows-alike application. It may serve as a starting point for your own applications.

Tcl, 125 lines
  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

Created by Paul Obermeier on Thu, 20 Sep 2001 (MIT)
Tcl recipes (162)
Paul Obermeier's recipes (4)

Required Modules

  • (none specified)

Other Information and Tasks