[EKB]

''8 July 2005 - I have now [Snit]ified this package. 
The code samples have been replaced with the new Snit versions.''

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 [tooltips] (also known as [balloon help]) using the code from the [Snit Tooltips] page
   * Creating a toolbar and finding button images for it (I embedded some inline images, but you might want to use [ICONS] instead!)
   * Adding a status bar, and connecting it 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 "globalPrefs" array or set using the "''myapp'' setpref" method are automatically saved on exit and retrieved when the program is restarted
   * Balloon help is available for all widgets, including toolbar buttons

***Example***

 package require base64
 
 ## -- Do this before making the GUI
 source "AppFrame.tcl"
 WinApp::appframe myapp -title "Translate Gif" -statusrelief groove
 
 ## -- Set any preferences
 myapp setpref folder $WinApp::appdir
 
 ## -- Init will load preferences and set the focus
 myapp init

 ## -- Create the GUI
 [myapp menu] add cascade -label "File" -menu [myapp menu].file
 menu [myapp menu].file -tearoff false
 [myapp menu].file add command -label "Open" -command FindFile
 [myapp menu].file add command -label "Exit" -command {myapp exitproc} \
    -underline 1 -accelerator "Ctrl+Q"

 set openBtn [myapp addButton -imagedata open -descr "Browse for a GIF file" \
    -shortdescr "Find file" -command FindFile]
 set copyBtn [myapp addButton -imagedata copy -descr "Copy base64-encoded string" \
    -shortdescr "Copy encoded image" -command CopyAll]

 # Interface
 text [myapp main].t -height 1
 pack [myapp main].t -side top -expand yes -fill both
 frame [myapp main].f
 pack [myapp main].f -fill x -side top
 label [myapp main].f.l -text "File: "
 pack [myapp main].f.l -side left
 entry [myapp main].f.e -textvariable filename
 pack [myapp main].f.e -side left -expand yes -fill x
 button [myapp main].f.b -text "Browse..." -command FindFile
 pack [myapp main].f.b
 
 # A button to put the image preview in
 image create photo sampleImg

 frame [myapp main].fi
 pack [myapp main].fi -fill x -padx 2 -pady 4

 label [myapp main].fi.trans -text "Transparent color: "
 pack [myapp main].fi.trans -side left
 label [myapp main].fi.rl -text " R"
 pack [myapp main].fi.rl -side left
 entry [myapp main].fi.r -width 4 -textvariable WinApp::globalPrefs(red)
 pack [myapp main].fi.r -side left
 label [myapp main].fi.gl -text " G"
 pack [myapp main].fi.gl -side left
 entry [myapp main].fi.g -width 4 -textvariable WinApp::globalPrefs(green)
 pack [myapp main].fi.g -side left
 label [myapp main].fi.bl -text " B"
 pack [myapp main].fi.bl -side left
 entry [myapp main].fi.b -width 4 -textvariable WinApp::globalPrefs(blue)
 pack [myapp main].fi.b -side left
 
 button [myapp main].fi.i -image sampleImg -activebackground red -width 22 -height 22
 pack [myapp main].fi.i -side right -anchor e
 WinApp::tooltip register [myapp main].fi.i "Press to check transparency"
 label [myapp main].fi.preview -text "Preview: "
 pack [myapp main].fi.preview -side right -anchor e
 
 ## -- Commands
 proc CopyAll {} {
    [myapp main].t tag remove sel 1.0 end
    [myapp main].t tag add sel 1.0 end
    tk_textCopy [myapp main].t
 }
 
 proc FindFile {} {
    global filename
 
    set filename [tk_getOpenFile -initialdir [myapp getpref folder] \
	-filetypes {{{GIF files} {.gif} } {{All files} * }}]
    
    if {$filename == ""} {return}
    
    myapp setpref 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] != [[myapp main].fi.r get]} {
		set istcolor false
	    } elseif {[lindex $curcolor 1] != [[myapp main].fi.g get]} {
		set istcolor false
	    } elseif {[lindex $curcolor 2] != [[myapp 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
    
    [myapp main].t delete 1.0 end
    [myapp main].t insert end $encodedData
 }

If this application and/or the framework seem useful, please add to them, modify them and improve them!
----
***Framework***
Here's the framework as it currently stands (last modified 8 July 2005). It includes a lot of embedded image data with standard button images (open, save, etc.) -- use [[WinApp::buttonlist]] to see the pre-defined images.

 package require snit

 namespace eval WinApp {

    ## -- Utility proc to easily insert a stub
    proc stub {msg} {
	tk_messageBox -message $msg -title "STUB"
    }
    
    # An array of buttons, defined for convenience (see below)
    variable btn
    
    # An array of prefs that apply to all appframes
    variable globalPrefs
	
    # Save the directory from which the program is called & info about user dirs
    variable appdir [file dirname $argv0]
    snit::type appframe {
	
	##
	## Options
	##
	option -title "AppFrame Application"
	option -exitproc ""
	option -statusrelief flat
	option -icon ""
	option -toplevel "."


	##
	## Variables
	##

	typevariable USERDIR
	typevariable USERPREFS


	# Array with various window components -- main, menu, statusbar, toolbar
	variable component

	# Array with prefs to save and restore
	variable prefs
	
	## Keep track of numbers of separators and buttons on the toolbar
	variable tbSepNum 0
	variable tbBtnNum 0
	
	# This is accessed via the selfns
	variable status
	
	constructor {args} {
	    $self configurelist $args
	    
	    # Generic prefs
	    set prefs(geometry) 300x200
	    set prefs(isMaximized) false

	    ##
	    ## Create the menu
	    ##
	    # Take care of case where toplevel is just "." -- don't have multiple "."'s
	    if {$options(-toplevel) == "."} {
		set tlvl ""
	    } else {
		set tlvl "$options(-toplevel)"
	    }
	    
	    $options(-toplevel) configure -menu $tlvl.appframeMenu
	    set component(menu) [menu $tlvl.appframeMenu]
	    
	    if {$options(-icon) != ""} {
		wm iconbitmap $options(-toplevel) -default $options(-icon)
	    }
	    
	    wm title $options(-toplevel) $options(-title)
	    
	    # Put the exit procedure action in 2 places -- "x" button and keyboard shortcut
	    wm protocol . WM_DELETE_WINDOW [mymethod exitproc]
	    bind . <Control-q> [mymethod exitproc]
	    
	    ## Toolbar
	    set component(toolbar) [frame $tlvl.appFrameToolbar]
	    grid $tlvl.appFrameToolbar -row 0 -sticky ew -columnspan 2
	    
	    ## Status bar & resizer
	    set component(statusbar) [frame $tlvl.appFrameStatus -height 10]
	    grid $tlvl.appFrameStatus -row 2 -sticky ew
	    
	    label $tlvl.appFrameStatus.announce -textvariable [myvar status] -anchor w  \
		-relief $options(-statusrelief)
	    pack $tlvl.appFrameStatus.announce -side left -fill x -expand yes
	    
	    # Make this the same size as the resizer to give it room
	    frame $tlvl.appFrameStatus.resizer -width 16 -height 16
	    pack $tlvl.appFrameStatus.resizer -side right
	    
	    WinApp::sizer::sizer $options(-toplevel)
	    
	    ## Main app space
	    set component(main) [frame $tlvl.appFrameMain]
	    grid $tlvl.appFrameMain -row 1 -sticky nsew
	    
	    ## Application grid
	    grid rowconfig $options(-toplevel) 1 -weight 1
	    grid columnconfig $options(-toplevel) 0 -weight 1
	    
	}
	
	##
	## Methods
	##
	method init {} {
	    $self LoadPrefs $options(-title) "prefs.tcl"
	    # Have to do this, at least in Windows, to ensure app has focus when started
	    focus -force .
	}
	method getpref {id} {
	    return $prefs($id)
	}
	method getprefids {} {
	    return [array names prefs]
	}
	method setpref {id val} {
	    set prefs($id) $val
	}
	method component {item} {
	    if {![info exists component($item)]} {
		error "\"$item\" is not a recognized AppFrame component"
	     }
	    return $component($item)
	}
	# Shortcut for "$self component main"
	method main {} {
	    return $component(main)
	}
	# Shortcut for "$self component menu"
	method menu {} {
	    return $component(menu)
	}
	
	## -- An exit procedure that saves preferences and exits
	method exitproc {} {
	    # handler is the user's exit handler
	    if {$options(-exitproc) != ""} {
		eval $options(-exitproc)
	    }
	    $self SavePrefs
	    exit
	}
	
	method setStatus {msg} {
	    set status $msg
	}
	method clearStatus {} {
	    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
	#
	method addButton {args} {

	    set button afBtn$tbBtnNum
	    incr tbBtnNum
	    
	    set retval [button $component(toolbar).$button -relief flat -borderwidth 1]
	    pack $component(toolbar).$button -side left
	    set descr ""
	    set shortdescr ""
	    set command "WinApp::stub $button"
	    set image ""
	    
	    foreach {opt val} $args {
		switch -exact -- $opt {
		    -imagedata {set image [image create photo -data $WinApp::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
	    }
	    $component(toolbar).$button config -image $image
	    $component(toolbar).$button config -command $command
	    bind $component(toolbar).$button <Enter> "set [myvar status] \"$descr\"; if {\[%W cget -state\] == \"normal\"} {%W configure -relief raised}"
	    bind $component(toolbar).$button <Leave> "set [myvar status] \"\"; %W configure -relief flat"
	    if {$shortdescr != ""} {
	       WinApp::tooltip register $component(toolbar).$button "$shortdescr"
	    }
	    
	    return $retval
	}
	
	## -- Proc to add a separator to the toolbar
	method addSep {} {	    
	    frame $component(toolbar).sep$tbSepNum -width 5 -borderwidth 0
	    pack $component(toolbar).sep$tbSepNum -side left -fill y -padx 4
	    incr tbSepNum
	}
		
	##
	## Manage Prefs
	##
	method LoadPrefs {progname prefsfile} {	    
	    # Get current user's home directory: If environment vars not available,
	    # default to subfolder of the installation folder
	    set USERDIR $WinApp::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
	    }
	}
	
	method SavePrefs {} {
	    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)\""
		}
		foreach item [array names WinApp::globalPrefs] {
		    puts $fileID "set WinApp::globalPrefs($item) \"$WinApp::globalPrefs($item)\""
		}
		close $fileID
	    }
	}
    }
    
    namespace eval sizer {
	######################################################################
	#
	# From mail@kai-morich.de (Tcler's Wiki)
	# Modified by EKB to give the glyph more "breathing room"
	#
	######################################################################
	namespace export sizer
    }
    
    proc sizer::sizer {win} {
	variable config
	variable f
	if {$win=="."} {
	    set config($win-widget) .sizer
	} else {
	    set config($win-widget) $win.sizer
	}
	canvas $config($win-widget) -width 16 -height 16 -cursor "size_nw_se" -bg SystemButtonFace
	foreach i {0 4 8} {
	    # -width 2 means 2point on win98 and 2pixel on w2k
	    $config($win-widget) create line [expr $i+3] 13 14 [expr $i+2] -width 1 -fill SystemButtonShadow
	    $config($win-widget) create line [expr $i+2] 13 14 [expr $i+1] -width 1 -fill SystemButtonShadow
	    $config($win-widget) create line [expr $i+1] 13 14       $i     -width 1 -fill SystemButtonHighlight
	}
	
	set config($win-zoomed) 2 ;# not 0/1
	bind $config($win-widget) <Button-1>  [namespace code [list sizer_start $win %X %Y]]
	bind $config($win-widget) <B1-Motion> [namespace code [list sizer_move $win %X %Y]]
	bind $win		 <Configure> [namespace code [list sizer_update $win]]
    }
    
    proc sizer::sizer_update {win} {
	variable config
	set zoomed [string equal [wm state $win] "zoomed"]
	if {$zoomed!=$config($win-zoomed)} {
	    set config($win-zoomed) $zoomed
	    if {$zoomed} {
		place forget $config($win-widget)
	    } else {
		set x [expr {-16+[$win cget -padx]}]
		set y [expr {-16+[$win cget -pady]}]
		place $config($win-widget) -relx 1.0 -rely 1.0 -x $x -y $y
	    }
	}
    }
    
    proc sizer::sizer_start {win x y} {
	variable config
	set config($win-x) $x
	set config($win-y) $y
	scan [wm geometry $win] "%dx%d" config($win-width) config($win-height)
    }
    
    proc sizer::sizer_move {win x y} {
	variable config
	set width  [expr $config($win-width) +$x-$config($win-x)]
	set height [expr $config($win-height)+$y-$config($win-y)]
	catch {wm geometry $win ${width}x${height} }
    }
    
    ##
    ## Button images
    ##
    
    proc buttonlist {} {
	variable btn
	return [lsort [array names btn]]
    }
    
    ## -- File operations
    set btn(save) {
    R0lGODlhEwASAJEAANnZ2QAAAICAAMDAwCH5BAEAAAAALAAAAAATABIAAAJi
    hI+py0jxEQl2SNB8iwmCHRI03yKCYIcEzbeQINghQfMtJAh2SNB8CwmCHRI0
    30KCYIcIxTeRINhB8tGCYIcIxT8Jgh0iFH8mJAh2iFD8mZAg2CFC8WdCguBT
    fDyCj6nLSQUAOw==  
    }
    set btn(open) {
    R0lGODlhEwASAKIAANnZ2QAAAP//AP///4CAAP///////////yH5BAEAAAAA
    LAAAAAATABIAAANnCLrc/jAyFIqgyx0IGhAIutyKEQiqEYGgqxEYAACBMoKh
    Gwi6GoMyMjIoEwi6GoIjIyM4Egi6GoMygqHLAQgQMoKBpLsBCAAxgoGku4Gg
    GhJIuhsIuhFIuhsIuoChy4Ggy+0Po4QoAQA7
    }
    set btn(new) {
    R0lGODlhFwAWAJEAANnZ2U1NTf///////yH5BAEAAAAALAAAAAAXABYAAAJa
    hI+py+0PoyLxjeBjBsmPIPiIQfJDguDjBcmPiCD4aEHyLwg+WpD8C4KPFiT/
    guCjBcm/IPhoQfIvCD5akPwLgo8WJP+C4KMFyb8g+GgUH4PgY+py+8MopyEF
    ADs=  
    }
    set btn(print) {
    R0lGODlhFwAWAKIAANnZ2U1NTf///9PT06ampv//Tf///////yH5BAEAAAAA
    LAAAAAAXABYAAAN5CLrc/jDKSWtEobsIuryBoquBoMsbKBiqEgi6vIGiq4Gg
    yxsoGKqygaDLgaKrMRgTCLqKocsTOBEIuhA4uhyDMYGgCxi6vIMTCLoQOLpE
    hDMxgaCrgaNbVTgTEQi6iqHLOxgIuhs4uhuDgaDLgKHLgaDL7Q+jnLRClAA7  
    }
    set btn(printpreview) {
    R0lGODlhFwAWAKIAANnZ2U1NTf///9PT06ampk3//////////yH5BAEAAAAA
    LAAAAAAXABYAAAOMCLrc/jDK6VDoLoIuc6DoSgSCLm+g6EoMBoIua6DoSgRG
    IOgyBIouB4IuQ6DoSgRGIOgyBIpu0OBQIOhyoKgGFdYQBYLuBopqTOEMTSDo
    bqCoxgzO0ASC7gaKatDgFFEg6G6g6AYNDgUh6G6g6EoERlAEgq4Gii4HYCiC
    LmDosgJCBIIutz+MctLaUAIAOw==  
    }
    
    ## -- Formatting
    set btn(bold) {
    R0lGODlhFwAWAJEAANnZ2U1NTf///////yH5BAEAAAAALAAAAAAXABYAAAJG
    hI+py+0Po5yUkfhG8DEhIghIBMHHjAijmPAxI8IoJnxMih8EHxMigoBEEHzM
    iDCKCR8zIoxiwkek+EbwMXW5/WGUk9ZKCgA7
    }
    set btn(italic) {
    R0lGODlhFwAWAJEAANnZ2U1NTaampv///yH5BAEAAAAALAAAAAAXABYAAAI8
    hI+py+0Po5wUktgEHxMjhOBjokQQfMyMEIKPiRJB8DEzQgg+JkoEwcfMCCH4
    mEfxCT6mLrc/jHLSagEpADs=
    }
    set btn(underline) {
    R0lGODlhFwAWAJEAANnZ2U1NTaampv///yH5BAEAAAAALAAAAAAXABYAAAJL
    hI+py+0Po5yUkThwQfAxIy4ohI8JEUcJ4WNCxFFC+JgQcZQQPiZEHCWEjwkR
    RwnhY0KEEJQg+JhGsQk+pi4fxT+Cj6nL7Q+jnIcUADs=
    }
    set btn(justcenter) {
    R0lGODlhFwAWAJEAANnZ2U1NTf///////yH5BAEAAAAALAAAAAAXABYAAAI2
    hI+py+0Po4wkPiLBx9RVio8EH1NXKT4iwcfUVYqPBB9TVyk+IsHH1FWKjwQf
    U5fbH0Y5qSMFADs=
    }
    set btn(justright) {
    R0lGODlhFwAWAJEAANnZ2U1NTf///////yH5BAEAAAAALAAAAAAXABYAAAI2
    hI+py+0Po4wkPiLBx9Rlio8EH1MXKT4iwcfUZYqPBB9TFyk+IsHH1GWKjwQf
    U5fbH0Y5KSMFADs=
    }
    set btn(justleft) {
    R0lGODlhFwAWAJEAANnZ2U1NTf///////yH5BAEAAAAALAAAAAAXABYAAAI2
    hI+py+0Po4wkPiLBx9RFio8EH1OXKT4iwcfURYqPBB9Tlyk+IsHH1EWKjwQf
    U5fbH0Y5KSQFADs=
    }
    set btn(justfull) {
    R0lGODlhFwAWAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAAXABYAAAI3
    hI+py+0Po5xUkfiIBB9TFyk+IsHH1EWKj0jwMXWR4iMSfExdpPiIBB9TFyk+
    IsHH1OX2h1FOUgA7  
    }
    set btn(bullets) {
    R0lGODlhFwAWAJEAANnZ2QAAgAAAAP///yH5BAEAAAAALAAAAAAXABYAAAJD
    hI+py+0Po5QkJnzMjAgCKP8I/kUEwcfU5fYnMeFjZkQQQPlH8C8iCD6mLrc/
    iQkfMyOCAMo/gn8RQfAxdbn9YZSHFAA7  
    }
    set btn(numbering) {
    R0lGODlhFwAWAJEAANnZ2QAAgAAAAP///yH5BAEAAAAALAAAAAAXABYAAAJF
    hI+py+0PoyIhfEyNOJJ/BB8DERGBxISPqctLCeFjqoWR/CP4GIiICCQmfExd
    XooJH1PjSP4RfITIzKSE8DF1uf1hlIgUADs= 
    }
    set btn(decindent) {
    R0lGODlhFwAWAJEAANnZ2QAAAAAAgP///yH5BAEAAAAALAAAAAAXABYAAAJG
    hI+py+0PoyLxEQk+pi5SfESCj6mLQjAo/hF8E0GKfwQfSDbBx0QRpPhH8E+Q
    4h/Bx9RFio9I8DF1keIjEnxMXW5/GKUkBQA7  
    }
    set btn(incindent) {
    R0lGODlhFwAWAJEAANnZ2QAAAAAAgP///yH5BAEAAAAALAAAAAAXABYAAAJG
    hI+py+0PoyLxEQk+pi5SfESCj6mLQjAo/hH8EzmKfwQfSDbBx0yRo/hH8E+Q
    4h/Bx9RFio9I8DF1keIjEnxMXW5/GKUkBQA7
    }
    
    ## -- Editing
    set btn(copy) {
    R0lGODlhFwAWAJEAANnZ2U1NTf///01NpiH5BAEAAAAALAAAAAAXABYAAAJp
    hI+py+0PIyLxCT6mhQhJCYKPCSFCUiQIPmZIBCmcT/ARgmTPyQzBx5CIoEwi
    MjIE/4Jkj0TI0DaCbyERQRnlyxB8C5I9QrFlCL5R/CH5MgQfcYRiyxB8xCH5
    MgQfkeYfwcfU5faHUU5SADs=
    }
    set btn(cut) {
    R0lGODlhFwAWAJEAANnZ2U1NTU1Npv///yH5BAEAAAAALAAAAAAXABYAAAJY
    hI+py+0PYyMBIAg+5sUFwce8uCD4mBcBlBA+JgYEwcfMiCD4mBqqekQRwcdM
    ASGJ8DFBRAgCCMFHFBMgAULwEcUESIAQfEQxMZIIHxNECD6mLrc/jBKQAgA7
    }
    set btn(delete) {
    R0lGODlhGAAWANUAANnZ2dQNN9ZkgtsUPN8BKtVgfud9ldVTc9EoTtE2WuzH
    1twONtdFZ9QPON4BKt2Zr9crT9hBY+rZ5tcHMNwBKuGtwNU1WdM8X9oDLdoC
    LObH19EnTefQ39ROcNwCK9kDLeiOpevi7dAhSNQLNd8CK+iIn+fJ2dMMNtgF
    LtMQOd6csdkELdUKM9MTPOmUqueAmNRffdEYQN8DLO3q9NJJa+IzVf//////
    /////////////////////////////////yH5BAEAAAAALAAAAAAYABYAAAaE
    QIBwSCwaj8ikcslsLgMCJ3JAKDiPBgLhYEQkmooFgUFsOB5OAIQQAUgmlIpz
    aCFcMBmNs7ghZIAcIEA4JBaJHc+HADIaiyFRZhQCkUpG49B0QqVCQhCpZDQC
    VCtWK0R0kV5GI6wRCxldspexOKPNjEIgVw0IEA6JReMRmVQumU3nsxgEADs=  
    }
    set btn(paste) {
    R0lGODlhFQAWAKIAANnZ2U1NTf//TaamTaamptPT001Npv///yH5BAEAAAAA
    LAAAAAAVABYAAAOKCLrc/jDKSStAoYGgy4uhKrKKQFdjkCYkAiVoKBB0IQgp
    sHSDBgNBF2KQMHSVCANBF4JwaGgIh4YmEHQhBmlo0HQtEHQhCIeGDE/VDEEX
    YpCGxvBU7QxBN2iQhuwMzc7M0BBUYwiHxvB01RBUgwZpyA5N9wxBF0PV8HTV
    EHQZ0HQZQZfbH0Y5KUQJADs=
    }
    set btn(undo) {
    R0lGODlhFwAWAJEAANnZ2U1Npqampv///yH5BAEAAAAALAAAAAAXABYAAAI+
    hI+py+0Po5y0WkDiCMFHi4sgGCF3Z5QgCD4E4gUlhG+BeEFJCD4E4lFsgh1y
    d3dniEL4mLrc/jDKSau9gBQAOw==  
    }
    set btn(redo) {
    R0lGODlhFwAWAJEAANnZ2aampk1Npv///yH5BAEAAAAALAAAAAAXABYAAAI9
    hI+py+0Po5y0ThJJhOBjWgiSBAAh+AiSJgSJ4CNInpBE+AiSJiSJ4COEJMkm
    +GgSBB9Tl9sfRjlptZeRAgA7  
    }
    
    ## -- Tools
    set btn(checkspelling) {
    R0lGODlhFwAWAJEAANnZ2U1NTU1Npv///yH5BAEAAAAALAAAAAAXABYAAAJh
    hI+py+0PoyIBIgAgKISPFhBAQSAIPmJEACWAAAAgEf4FBAQhCAAQgo8BAUEB
    IEIIPqaKqh4R4WOqqB6JsOXu7kgGgBF8TBARgkTwMU9ESISPmSJC8DFVCD6m
    Lrc/jBKQAgA7  
    }
    set btn(find) {
    R0lGODlhFwAWAKIAANnZ2QAAAOzp2Kyomf///wD//wAAgP///yH5BAEAAAAA
    LAAAAAAXABYAAAOCCLrc/jDKKVFoIOhyK0aIiGAEgi5z4BCRCMoEgi5vIFGV
    CIoEgi5roFCh6Eog6DIEChWKrgSCLkOg6HIg6DIEii4Hgi5roOgKBYIub+Cg
    qNIEgi5zYIgIDZoi6HIHRoSJoRmCLjejiZkh6HIzmpgZgi43o4kZgi53oxmC
    Lrc/jHJGlAA7  
    }
    set btn(replace) {
    R0lGODlhFwAWAKIAANnZ2YAAAAAAAKyomezp2P///wD//wAAgCH5BAEAAAAA
    LAAAAAAXABYAAAN9CLrc/jDKSR0KBF1uBxSBoMvNGKoIutyKARCBoMu9GACB
    oMsqKCIAgIGgyyw4RCMIuhq8SKaKCEcAADAAAkEXhLCMiARBIzQQdEGQVEsA
    AUMVQVdlkLRGAAEiEHQZBIdq5BAUYncXEpW7Q9DldjxF0OV2vEPQ5faHUU5a
    J0oAOw==  
    }
    set btn(paint) {
    R0lGODlhFwAWALMAANnZ2YCAgAAAAP///wCAgMDAwP8AAIAAAAD//wAAgICA
    AAAA/4AAgP//AP///////yH5BAEAAAAALAAAAAAXABYAAAS3EMhJq704671D
    gCIEAYGcVAYxgxBBCAikkFLKEIQMQ0BSBAAiCAjkBGEEAcwRBMEE1BACAjll
    KEuYIwhKUJUgIJCTJrLYESSoBpWAQE4qE2FHENUUFBDISSUMctIgIJCTgjDG
    GKWUAkMQEMhJZSgwyCkEBHLSGcYoJYQQoIBATjrDGKWEEAIUEMhJZxhjlBJC
    gAICOekMY4xSQghQQCAnnWGMUUoIAQoI5KQUCjklBHLSai/Oeu8IADs=
    }
    set btn(help) {
    R0lGODlhGAAWAPcAANnZ2djh9NHc8dDb79Hb79Hc79Db8dPc6+Pn7+Tr+NPc
    8eTo9f38/f////37/ODm89Ld8c3S3Ovv+OLq99bf8Pv//8bz/6jd/pjP/JHJ
    /6nU//j+/////NTf8bq/x+nt9tTe8c7p/3Gy/4ev7N/i7PTw6+Dk8Xmk9k6M
    /sre/////dLd8L3Ax+3x+tfg8+/x9tvq/0qK/12H3v//7v38/qG55///+v75
    8z1z4DZx5u7z/+Dn9JOZpdLW3WuY9Stn4m6LyOPq8FJ/1wExvX+c12aM2hVU
    0Xea4v79/r/I26Gjqdfg8ebt+zNr2zRp0ylfyiJZyRpVyRFMwcbQ4kBx0CFb
    zTlrzvv7/NPe72Vnatnh8srY8yNczTNnzzBlzCxhzCBWxKi1z3uc4BtUxyxh
    zSpfxu3x9dXf8E5PUtjh89be8h9XxTNnzjJmzCJbzGqGwpGt6BBLxC5jzClg
    yyxfw/Hy89bg8kpLTvv6+DNjxSddyjRoziRcy2qJyt/n9zls0CRbyjJmzRxU
    w1F5x/38+MXP4UxNUNPc8Pn6+pCo2A5JvS9jzSphzTtsy2mO2CpfyipeyRFI
    ub3J4Ojt9pCXpFxeYdrg6tfh8v//+Fl+xw1GuxRPxpWkwnCS2RBLwQxGuIGa
    zlJUV5CSmOzw+cfP3+Lq9f//9IGazxZNtz1luZqv2SRZwCVXuZ+v1f//99ni
    9GtweGxucs/T2+Hl7bW9ztjj9OLi5KKxz5ar1LvG3fDx7PLz9tbh8np/iK+y
    uNjb46Glr8bP49fh89nj9Nrj9Nji87C6yVRWWmlqbqeqsOLm7t/j67W4v2Zn
    a0tMT0hJTHV3e8THz+fq8///////////////////////////////////////
    ////////////////////////////////////////////////////////////
    ////////////////////////////////////////////////////////////
    /////////////////////yH5BAEAAAAALAAAAAAYABYAAAj/AAEIHEiwoMGD
    CBMqXMhQYAABAwgUMHAAQUMACRQsYNCgQQMHDyBEkLBwAoUGFSxcwJBBwwYO
    HTx8UAiiQQgRI0iUMHECRQoVK1i0QOjiBYwYMmbQqGHjBo4cOnbw6IEQRAMf
    P4AEETKESIMiRo4gSaIE4RImTZw8gRJFypQGVKpYuYIlC0ItW7h08fIFTJgG
    YsaQKWPmDBqEadSsYdPGzZsGcOLImUOnjp07CF3gyaNnD58+fv4ACiRoEKFC
    hhAeQpRI0SJGjRw9kgMpkqRJlCohtHQJUyZNmzg16OTpEyhMdkKJQjiKVClT
    p1ClUrWKVStXr2DFkpVwFq1aeGzdOMKVS9cuXr2y+Pqg8BewYMKGESsmzNgx
    ZMmUMVzGrJkzgM8EooEWTRpAAAIHEixo8CDChAoXMgwIADs=
    }
    set btn(zoomin) {
    R0lGODlhGAAWAOYAANnZ2dvj9ay33Zqr2put3Z6u2q2439bd8c3W756t2rvO
    6sXp+b7w/rjl+aPE65yt3MzV7pqr2d7q9v///8nr/7jo/6/i/77x/6za+pqq
    2brE56fB5OX9/9ju/5HR9C10xcf5/8Dy/8b4/6C74q653qSz37nk9r7r/6nd
    9L/u+s7//77n+Z2u3r/x/q7h/wFnzNr//9H9/qa14LLT8bns/5vN8p7Q8c3c
    6uf//8To9J+v277J6Zqt3cbz/7bo/7fm8vj///7///3//6K32bjF5fDu8NnV
    1pyq0pm15MDw/9H//9j//+D//+7//9Dd7KKx2/zEc/ipT5eUoKGv2Jqt2J+9
    4L3d7b7b7aa226Sx3NHZ8PqlRcF1TKSAh9PZ78DM66Wz3Z2v3qe24KR+hbu4
    1uDb1fCiSNTX3oBxaKB7gby20ubp8dPV4f//////////////////////////
    /////////////////////////////////////////////////yH5BAEAAAAA
    LAAAAAAYABYAAAfQgACCg4SFhoeIiYqLjIUBAgMEBQYHjYMICQoLDA0ODxCN
    AAEREhMUFRYXGBkBjRobHB0eHyAhIiMkjSUmJx4eHygpKisDjSwtLi8fHx8f
    MDEEjTIzNDU2Hzc3ODk6jTs8PT4/H0BBQkNEjEVGR0hJSktMTU5PAYtFUFFS
    U1RVVoBXWFlagACCg4QARVBbXF1eX2BhYl8BhYUARVBbXGNkhYWFgkVQW1xj
    ZIWFhYNlZlxjZIWFhYRnaGlqhYWFhQBrbIAAgoOEhYaHiImKi4yLgQA7  
    }
    set btn(zoomout) {
    R0lGODlhGAAWAOYAANnZ2dvj9b3I6KOy3Zut3Zqr2pqp1dHZ8Ke13qCv17LT
    68Hy/rjg9p64456u28zV7qi237/M5f///+D3/7fn/7Pl/77x/6jU9Zyr2sDM
    66e64e/9//b8/8Tm/7zu/7Di/7Hk/8b2/5265Km02qe34LLO7Mr1/7Hd+c3+
    /7zn+Z2v3rLY8rTn/4Gz5gFnzN3//838/qe24LDO7rvu/8LR4+j//8nw+aCz
    38Xx/7Tm/8///9////L///3///r//7bR6qGv2qPG8Mf1/8n7/9r//+b///H/
    /+7y+p+v29Xb8PXauvG2ZKSntZup1Jmz37vi+dD7/rjT68LK5v+3UuOKP6Bz
    asjN37nF5p6t27C64axyZaSSsN/i86SRrejg2/+4U9TX3qCAYK1yY8PFy7m2
    w///////////////////////////////////////////////////////////
    /////////////////////////////////////////////////yH5BAEAAAAA
    LAAAAAAYABYAAAfZgACCg4SFhoeIiYqLjIUBAgMEBQYBjYMHCAkKCwwNDg+N
    AAEQERITFBUWFxgBjRkaGxwdHh8gISIjjSQlJieAKIKCKQWAAIKDhIMqKywt
    Li4uLi8wBIWFgzEyM4A0goI1NgWAAIKDhIMZNzg5Ojs8PT4/I4WFgwFAQUJD
    REVGR0hJhYWCSktMTU5PUDZRSFKFhYJKU1RVVldYBAVZAYWFgkpTVFpbXIWF
    hYJKU1RaXVyFhYWCXl9UWl1chYWFg2BhYl1chYWFhWNkXIAAgoOEhYaHiImK
    i4yKgQA7  
    }
    
    ## -- Objects
    set btn(clipart) {
    R0lGODlhFwAWALMAANnZ2QAAAICAgP///4AAAIAAgMDAwP//AICAAP//////
    /////////////////////yH5BAEAAAAALAAAAAAXABYAAATMEMhJq704622D
    gEEEEUQQQQQRIJBTCjjkpFNAIKcMY4whCCEEijFGgEBOKcYYAxI5xxgCAjll
    GGOMIkohkIgxAgRySjHGGMGEQyARYwgI5JRhjIHKKUNAIsYIEMgpxRhilDCO
    gKKMISCQU4YxRghFjADLGCNAIKcUY4yBwjABDjkEBHLKMMYYYhwU4JAjQCCn
    FGOMIQoSAg45BARyyjCGECOEUmAIYwQI5JRiiDJGKafAIsQQEMgpgwgiiCCC
    gEEEESCQk1Z7cdabdwsjADs=  
    }
    set btn(table) {
    R0lGODlhFwAWAKIAANnZ2QAAAAAAgICAgP///////////////yH5BAEAAAAA
    LAAAAAAXABYAAAN8CLrc/jDKSStDocsdCLoQKLrMgaALgaLLHAi6EDi6zIGg
    C0FIQ0SDpKMUCLoQhDRENEg6SoGgC4GjyxwIuhCENEQ0SDpKgaALQUhDRIOk
    oxQIuhA4usyBoAtBSENEg6SjFAi6EIQ0RDRIOkqBoAsYutyBoMvtD6OctFqL
    EgA7
    }
    set btn(picture) {
    R0lGODlhFwAWAKIAANnZ2QAAAP//AP///4CAgMDAwP///////yH5BAEAAAAA
    LAAAAAAXABYAAAOACLrc/jDKSau9KHRZEXQZAmVkZFBGJhB0GQJHRkaQgiQQ
    dBkCZWRkMComEHQZAkdGRpCCJBB0GQJlZGRQRiYQdBkCRyZGcGQkEHQZAmWC
    YjBCJhB0GQIniCiwKiQQdBkCgyiIMKoiEHQZAkkpNLAqEHQZMHRZEXS5/WGU
    k1Z7AUoAOw==  
    }
    
    ## -- VCR controls
    set btn(vcrback) {
    R0lGODlhFQAVAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAAVABUAAAI6
    hI+py+0Po3wkhI+JEapKYsLHtIigED4mUGyCjwkUm+BjWkRQCB/zIoLgY2KE
    qhoSwsfU5faHUc5JCgA7  
    }
    set btn(vcrgoend) {
    R0lGODlhFgAWAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAAWABYAAAJY
    hI+py+0Po5wUkAAAAQCEhOBjxEUQnDAzM4oBFgBG8DEiAigOGMFHio9G8JHi
    oxF8jIgAigNG8DEiLCgBRBB8jLgIghNmZkYBAAIACAnBx9Tl9odRTgpIAQA7  
    }
    set btn(vcrff) {
    R0lGODlhFgAWAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAAWABYAAAJK
    hI+py+0Po5zUkAAAQfAxIeIoIXzMiDCKCR8xIoKQRBB8PIqPBB+N4iPBR4uI
    ICQRBB8vIoxiwkeMuKAQPmZgEHxMXW5/GOWkihQAOw==  
    }
    set btn(vcrforward) {
    R0lGODlhFQAVAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAAVABUAAAI7
    hI+py+0Po5yThPAxM0JVAYkJH/MigkL4mEaxCT4mUGyCjwkRQSF8TIsIgo95
    EaoKSAgfU5fbH0b5SAEAOw==  
    }
    set btn(vcrpause) {
    R0lGODlhEgASAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAASABIAAAJB
    hI+py+0PSQIwgo8WYUEhfLQICwrho0VYUAgfLcKCQvhoERYUwkeLsKAQPlqE
    BYXw0SIsKISPFmFBIXxMXW5/SAoAOw==  
    }
    set btn(vcrrewind) {
    R0lGODlhFgAWAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAAWABYAAAJK
    hI+py+0Po5xUkQAAQfAxIy4ohI8YEUYx4eNFRBCSCIKPRvGR4KNRfCT4eBER
    hCSC4CNGhFFM+JgRFxTCx4TAIPiYutz+MMpJDSkAOw==  
    }
    set btn(vcrgostart) {
    R0lGODlhFgAWAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAAWABYAAAJa
    hI+py+0Po5wUkAQAEAAEhOBjxEUQnDAzM0oAFgAWBB8jIIISREQQfKT4aAQf
    KT4awccIiKAEEREEHyMsggJEBMHHiIsgOGFmZpQAAAKAgBB8TF1ufxjlpIAU
    ADs=  
    }
    set btn(vcrstopcircle) {
    R0lGODlhEgASAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAASABIAAAI0
    hI+py+0PAYlN8NEofhB8pPhH8I/iH8E/in8E/yj+Efyj+EfwkeIHwUej2AQf
    U5fbH8ZECgA7  
    }
    set btn(vcrstopsquare) {
    R0lGODlhFQAVAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAAVABUAAAI7
    hI+py+0Po5yQxD+Cj0bxj+CjUfwj+GgU/wg+GsU/go9G8Y/go1H8I/hoFP8I
    PhrFP4KPqcvtD6OckBQAOw==  
    }
    
    ## -- Directions
    set btn(down) {
    R0lGODlhFAASAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAAUABIAAAI/
    hI+py+1M4uMRfKP4GAT/KD4GwUeKfwQfgeIfwUej+EHwESk2wcek2AQfEyKC
    4GNaRBB8zAtVBRLCx9Tl9kekADs=  
    }
    set btn(downleft) {
    R0lGODlhFQATAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAAVABMAAAJD
    hI+py+1vSAgfMyNUFZCY8DEvIiiEj2kUm+BjAsUn+JgUPwg+IsU3go9H8Y/g
    o1F8JPgIFB+D4CPFRyP4mLrc/tCRAgA7  
    }
    set btn(downright) {
    R0lGODlhFQATAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAAVABMAAAJB
    hI+py+0PSQgfEyNUlcSEj2kRQSF8TKDYBB+T4hN8RIofBB+P4hvBR6P4R/AR
    KD4SfKT4GAT/KD4awcfU5faHjxQAOw==  
    }
    set btn(left) {
    R0lGODlhEgAUAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAASABQAAAI/
    hI+py+1vSAgfMyIyj8Qm+GgUn+AjxTeCbxQfCT7FRyP4RvGR4CPFN4KPRvEJ
    Ph7FJviYEZGZhoTwMXW5/RspADs=  
    }
    set btn(right) {
    R0lGODlhEgAUAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAASABQAAAJA
    hI+py+1GQviYFhEEH5NiE3w8ik/w0Si+EXyk+EjwjeKjEXyKjwTfKL4RfKT4
    BB+NYhN8vIjITBLCx9Tl9oeMFAA7  
    }
    set btn(up) {
    R0lGODlhFAASAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAAUABIAAAI+
    hI+py+1/SAgfE0NVKSZ8TIsIgo8JFJvgY1Jsgo9I8YPgo1H8I/gIFP8IPlJ8
    DIJ/FB+D4BvFxyP4mLrc3qQAOw==  
    }
    set btn(upleft) {
    R0lGODlhFQATAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAAVABMAAAJC
    hI+py+0PH4mPRvCP4mMQfKT4SPARKP4RfDSKbwQfj+IHwUek+AQfk2ITfEyI
    CArhY1pEEHzMi1BVQEL4mLrc/pAUADs=  
    }
    set btn(upright) {
    R0lGODlhFQATAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAAVABMAAAJD
    hI+py+0PHYmPRvCR4mMQfASKjwQfjeIfwcej+EbwESl+EHxMik/wMYFiE3xM
    iwgK4WNeRBB8TIxQVUNC+Ji63P6GFAA7  
    }

 #-----------------------------------------------------------------------
 # Tooltip type
 #
 # The tooltip command is an instance of TooltipType, so that we can
 # have options.
 #
 # Code posted by William Duquette to the Tcler's Wiki on page
 #   "Snit Tooltips"

 snit::type TooltipType {
    #-------------------------------------------------------------------
    # Options

    option -font {Helvetica 8}
    option -background "#FFFFC0"
    option -topbackground black
    option -foreground black
    option -delay 600

    #-------------------------------------------------------------------
    # Variables

    # Tool tip text.  An array, indexed by window name
    variable tiptext

    # Tool tip timeout, or {}
    variable timeout {}

    # Tool tip window, or {}
    variable tipwin {}

    #-------------------------------------------------------------------
    # Constructor

    # Implicit

    #-------------------------------------------------------------------
    # Public methods

    method register {window text} {
	set tiptext($window) $text

	# Add "+" so other actions bound to these events will fire
	bind $window <Enter> "+[mymethod Enter $window]"
	bind $window <Leave> "+[mymethod Leave $window]"
    }

    method unregister {window} {
	unset tiptext($window)
    }

    #-------------------------------------------------------------------
    # Private Methods

    # When the mouse pointer enters the window, set the timer.
    method Enter {window} {
	set timeout [after $options(-delay) [mymethod Popup $window]]
    }

    # Pop up the tooltip.
    method Popup {window} {
	# FIRST, the timeout has fired, so we can forget it.
	set timeout {}

	# NEXT, the tooltip will be a child of the window's toplevel.
	set top [winfo toplevel $window]

	# NEXT, the tooltip's name depends on which toplevel it is.
	set tipwin ".gui_tooltip_window"

	if {$top ne "."} {
	    set tipwin "$top$tipwin"
	}

	# NEXT, create the tooltip window.
	frame $tipwin \
	    -background $options(-topbackground)

	label $tipwin.label \
	    -text $tiptext($window) \
	    -foreground $options(-foreground) \
	    -background $options(-background) \
	    -font $options(-font)

	# Pack the label with a 1 pixel gap, so that there's a box
	# around it.
	pack $tipwin.label -padx 1 -pady 1

	# NEXT, the tipwin will be placed in the toplevel relative to
	# the position of the registered window.  We'll figure this out
	# by getting the position of both relative to the root window.

	set tx [winfo rootx $top]
	set ty [winfo rooty $top]

	set wx [winfo rootx $window]
	set wy [winfo rooty $window]

	# We want to the tip to appear below and to the right of the
	# registered window.
	set offset [expr {[winfo width $window]/2}]

	# Compute the final position.
	set x [expr {($wx - $tx) + $offset}]
	set y [expr {($wy - $ty) + [winfo height $window] + 2}]

	# Finally, place the tipwin in its position.
	place $tipwin -anchor nw -x $x -y $y

	# However, if window is to the right of its toplevel, the
	# tipwin might be too wide.  Slide it to the left, as needed.
	# TBD: I don't know of any way to determine the width of the
	# tipwin without letting it pop up, which causes an ugly
	# jump.
	update idletasks

	set rightEdge [expr {$x + [winfo width $tipwin]}]

	set topWid [winfo width $top]

	if {$rightEdge >= $topWid} {
	    set x [expr {$x - ($rightEdge - $topWid + 2)}]

	    place $tipwin -anchor nw -x $x -y $y
	}
    }

    # When the mouse pointer leaves the window, cancel the timer or
    # popdown the window, as needed.
    method Leave {window} {
	if {$timeout ne ""} {
	    after cancel $timeout
	    set timeout ""
	    return
	}

	if {$tipwin ne ""} {
	    destroy $tipwin
	    set tipwin ""
	}
    }
 }

 #-----------------------------------------------------------------------
 # The tooltip command

 TooltipType tooltip

 }

----
[Category Package] - [Category Windows]