Welcome, guest | Sign In | My Account | Store | Cart
# 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