[EKB] I've been working towards making a package that will automatically take care of some tricks for using [Tk] under [Windows] that I learned once and don't want to have to learn again. For example: * Binding the "x" button to the exit procedure * Linking to an .ico file * Creating a resizer/gripper in the bottom-right corner (using code from the [sizer control] page on this Wiki) * Creating a toolbar and finding button images for it (I embedded some inline images, but you might want to use [ICONS] instead!) * Adding balloon help and a status bar to the toolbar buttons * Saving preferences in the user's directory * ... and so on ... I've put some of these things together into a simple application framework. It uses some of my own code, as well as code from other pages on the Tcler's Wiki and the web. (These are documented in the code.) Here's an example of an application created using the Application Framework code (This is actually the program I used to create the base64-encoded button strings that appear in the Framework, so it is hopefully useful by itself.) [http://www.kb-creative.net/screenshots/AppFrameExample.gif] To use the "Transparent Color" feature in the program, first fill any areas in the image that you want to make transparent with some color, for example, pure green (R = 0, G = 255, B = 0). Then type those numbers into the R, G, B entry widgets. When the image is loaded, any pixels that are set to (0,255,0) will be made transparent. The screenshot above shows this image loaded in the program: [http://www.kb-creative.net/images/find.gif]. And here's the code to make the example, using the Application Framework (which is farther down on the page) A couple of things to notice in the code: * Any values assigned to the "prefs" array are automatically saved on exit and retrieved when the program is restarted * Balloon help is available for all widgets, including toolbar buttons package require base64 ## -- Do this before making the GUI source "AppFrame.tcl" appframe::make -title "Translate Gif" -statusrelief groove ## -- Set any preferences set appframe::prefs(folder) $appframe::appdir ## -- Init will load preferences and set the focus appframe::init ## -- Create the GUI $appframe::menu add cascade -label "File" -menu $appframe::menu.file menu $appframe::menu.file -tearoff false $appframe::menu.file add command -label "Open" -command FindFile $appframe::menu.file add command -label "Exit" -command $appframe::exitproc \ -underline 1 -accelerator "Ctrl+Q" set openBtn [appframe::addButton -imagedata open -descr "Browse for a GIF file" \ -shortdescr "Find file" -command FindFile] set copyBtn [appframe::addButton -imagedata copy -descr "Copy base64-encoded string" \ -shortdescr "Copy encoded image" -command CopyAll] # Interface text $appframe::main.t -height 1 pack $appframe::main.t -side top -expand yes -fill both frame $appframe::main.f pack $appframe::main.f -fill x -side top label $appframe::main.f.l -text "File: " pack $appframe::main.f.l -side left entry $appframe::main.f.e -textvariable filename pack $appframe::main.f.e -side left -expand yes -fill x button $appframe::main.f.b -text "Browse..." -command FindFile pack $appframe::main.f.b # A button to put the image preview in image create photo sampleImg frame $appframe::main.fi pack $appframe::main.fi -fill x -padx 2 -pady 4 label $appframe::main.fi.trans -text "Transparent color: " pack $appframe::main.fi.trans -side left label $appframe::main.fi.rl -text " R" pack $appframe::main.fi.rl -side left entry $appframe::main.fi.r -width 4 -textvariable appframe::prefs(red) pack $appframe::main.fi.r -side left label $appframe::main.fi.gl -text " G" pack $appframe::main.fi.gl -side left entry $appframe::main.fi.g -width 4 -textvariable appframe::prefs(green) pack $appframe::main.fi.g -side left label $appframe::main.fi.bl -text " B" pack $appframe::main.fi.bl -side left entry $appframe::main.fi.b -width 4 -textvariable appframe::prefs(blue) pack $appframe::main.fi.b -side left button $appframe::main.fi.i -image sampleImg -activebackground red -width 22 -height 22 pack $appframe::main.fi.i -side right -anchor e appframe::balloonhelp::set_balloon $appframe::main.fi.i "Press to check transparency" label $appframe::main.fi.preview -text "Preview: " pack $appframe::main.fi.preview -side right -anchor e ## -- Commands proc CopyAll {} { $appframe::main.t tag remove sel 1.0 end $appframe::main.t tag add sel 1.0 end tk_textCopy $appframe::main.t } proc FindFile {} { global filename set filename [tk_getOpenFile -initialdir $appframe::prefs(folder) \ -filetypes {{{GIF files} {.gif} } {{All files} * }}] if {$filename == ""} {return} set appframe::prefs(folder) [file dirname $filename] # Open the file sampleImg config -file $filename # Add transparency, if need be set maxX [image width sampleImg] set maxY [image height sampleImg] for {set x 0} {$x < $maxX} {incr x} { for {set y 0} {$y < $maxY} {incr y} { set curcolor [sampleImg get $x $y] set istcolor true if {[lindex $curcolor 0] != [$appframe::main.fi.r get]} { set istcolor false } elseif {[lindex $curcolor 1] != [$appframe::main.fi.g get]} { set istcolor false } elseif {[lindex $curcolor 2] != [$appframe::main.fi.b get]} { set istcolor false } if $istcolor {sampleImg transparency set $x $y true} } } sampleImg write "_temp.gif" -format GIF set fileID [open "_temp.gif" RDONLY] fconfigure $fileID -translation binary set rawData [read $fileID] close $fileID set encodedData [base64::encode $rawData] sampleImg config -data $encodedData $appframe::main.t delete 1.0 end $appframe::main.t insert end $encodedData } If this application and/or the framework seem useful, please add to them, modify them and improve them! ---- Here's the framework as it currently stands (last modified 17 April 2005). It includes a lot of embedded image data with standard button images (open, save, etc.) -- use [[appframe::buttonlist]] to see the pre-defined images. namespace eval appframe { namespace export stub make clearStatus addButton addSep init buttonlist ## ## Variables ## ## -- Public variables # Save the directory from which the program is called variable appdir [file dirname $argv0] variable toolbar variable main variable title "AppFrame Application" variable statusbar variable exitproc appframe::exitwrapper variable status variable prefs variable USERDIR variable USERPREFS variable btn ## -- Initialize standard prefs set prefs(geometry) 300x200 set prefs(isMaximized) false ## -- Private variables variable tbSepNum 0 variable tbBtnNum 0 ## ## Create the menu ## . configure -menu .appframeMenu set menu [menu .appframeMenu] ## ## Procedures ## ## -- Utility proc to easily insert a stub proc stub {msg} { tk_messageBox -message $msg -title "STUB" } ## -- An exit procedure that saves preferences and exits proc exitwrapper {{handler ""}} { # handler is the user's exit handler if {$handler != ""} { eval $handler } appframe::SavePrefs exit } ## -- Main proc -- make an app frame # # Switches: # -icon name of an .ico file # -title title of the application # -exitproc user-defned exit handler (called before saving preferences) # -statusrelief relief for status area (e.g., flat, sunken, groove) # proc make {args} { variable toolbar variable main variable title variable statusbar variable exitproc set statusrelief flat foreach {opt val} $args { switch -exact -- $opt { -icon {wm iconbitmap . -default $val} -title {set title $val} -exitproc {set exitproc "appframe::exitwrapper $val"} -statusrelief {set statusrelief $val} } } wm title . $title # Put the exitproc action in 2 places -- "x" button and keyboard shortcut wm protocol . WM_DELETE_WINDOW $exitproc bind . $exitproc ## Toolbar set toolbar [frame .appFrameToolbar] grid .appFrameToolbar -row 0 -sticky ew -columnspan 2 ## Status bar & resizer set statusbar [frame .appFrameStatus -height 10] grid .appFrameStatus -row 2 -sticky ew label .appFrameStatus.announce -textvariable appframe::status -anchor w \ -relief $statusrelief pack .appFrameStatus.announce -side left -fill x -expand yes # Make this the same size as the resizer to give it room frame .appFrameStatus.resizer -width 16 -height 16 pack .appFrameStatus.resizer -side right sizer::sizer . ## Main app space set main [frame .appFrameMain] grid .appFrameMain -row 1 -sticky nsew ## Application grid grid rowconfig . 1 -weight 1 grid columnconfig . 0 -weight 1 } ## -- Convenience proc to clear the status bar text variable proc clearStatus {} { variable status set status "" } ## -- Proc to add variables to the toolbar # # Switches: # -image User-defined image # -imagedata ID for a pre-defined inline button image # -descr Text that appears in the status bar when over button # -shortdescr Text that appears in balloon help when over button # -command The command for the button # # NOTE: An image is required for toolbar buttons # proc addButton {args } { variable toolbar variable tbBtnNum set button afBtn$tbBtnNum incr tbBtnNum set retval [button $toolbar.$button -relief flat -borderwidth 1] pack $toolbar.$button -side left set descr "" set shortdescr "" set command "appframe::stub $button" set image "" foreach {opt val} $args { switch -exact -- $opt { -imagedata {set image [image create photo -data $appframe::btn($val)]} -image {set image $val} -descr {set descr $val} -shortdescr {set shortdescr $val} -command {set command $val} } } if {$image == ""} { error "No image for button \"$button\"" return } $toolbar.$button config -image $image $toolbar.$button config -command $command bind $toolbar.$button "set appframe::status \"$descr\"; if {\[%W cget -state\] == \"normal\"} {%W configure -relief raised}" bind $toolbar.$button "set appframe::status \"\"; %W configure -relief flat" if {$shortdescr != ""} { appframe::balloonhelp::set_balloon $toolbar.$button "$shortdescr" } return $retval } ## -- Proc to add a separator to the toolbar proc addSep {} { variable tbSepNum variable toolbar frame $toolbar.sep$tbSepNum -width 5 -borderwidth 0 pack $toolbar.sep$tbSepNum -side left -fill y -padx 4 incr tbSepNum } proc init {} { variable title LoadPrefs $title "prefs.tcl" # Have to do this, at least in Windows, to ensure app has focus when started focus -force . } ## ## Manage Prefs ## proc LoadPrefs {progname prefsfile} { variable USERDIR variable USERPREFS variable prefs variable appdir # Get current user's home directory: If environment vars not available, # default to subfolder of the installation folder set USERDIR $appdir if {$::tcl_platform(os) == "Windows NT"} { if {[info exists ::env(USERPROFILE)]} { set USERDIR $::env(USERPROFILE) } } if {$::tcl_platform(os) == "Windows 95"} { if {[info exists ::env(windir)] && [info exists ::env(USERNAME)]} { set USERDIR [file join $::env(windir) Profiles $::env(USERNAME)] } } set USERDIR [file join $USERDIR "Application Data" $progname] set USERPREFS [file join $USERDIR $prefsfile] if {[file exists $USERPREFS]} { source $USERPREFS } wm geometry . $prefs(geometry) if {$prefs(isMaximized)} { wm state . zoomed } } proc SavePrefs {} { variable prefs variable USERDIR variable USERPREFS if {![file exists $USERDIR]} { file mkdir $USERDIR } # Find out if the window is zoomed if {[wm state .] == "zoomed"} { set prefs(isMaximized) true } else { set prefs(isMaximized) false # Store the current window geometry set prefs(geometry) [wm geometry .] } # Don't bother about errors. If can't open, then can't save prefs. That's OK. if {![catch {open $USERPREFS w} fileID]} { foreach item [array names prefs] { puts $fileID "set prefs($item) \"$prefs($item)\"" } close $fileID } } namespace eval balloonhelp { ############################################################################## # balloon.tcl - procedures used by balloon help # # Copyright (C) 1996-1997 Stewart Allen # # This is part of vtcl source code # Adapted for general purpose by # Daniel Roche # thanks to D. Richard Hipp for the multi-headed display fix # version 1.2 ( Sep 21 2000 ) # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ############################################################################## bind Bulle { set appframe::balloonhelp::Bulle(set) 0 set appframe::balloonhelp::Bulle(first) 1 set appframe::balloonhelp::Bulle(id) [after 500 {appframe::balloonhelp::balloon %W $Bulle(%W) %X %Y}] } bind Bulle