[EKB] 19 April 2005 - 
Instead of using the inline icons I define in the script below, use [ICONS] instead!

----
[EKB] 17 April 2005

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
   * 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.)

If this seems useful, please add to this, modify it and improve it!

----
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 . <Control-q> $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 <Enter> "set appframe::status \"$descr\"; if {\[%W cget -state\] == \"normal\"} {%W configure -relief raised}"
        bind $toolbar.$button <Leave> "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 <daniel.roche@bigfoot.com>
        # 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 <Enter> {
            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 <Button> {
            set appframe::balloonhelp::Bulle(first) 0
            appframe::balloonhelp::kill_balloon
        }
        
        bind Bulle <Leave> {
            set appframe::balloonhelp::Bulle(first) 0
            appframe::balloonhelp::kill_balloon
        }
        
        bind Bulle <Motion> {
            if {$appframe::balloonhelp::Bulle(set) == 0} {
                after cancel $appframe::balloonhelp::Bulle(id)
                set appframe::balloonhelp::Bulle(id) [after 500 {appframe::balloonhelp::balloon %W $appframe::balloonhelp::Bulle(%W) %X %Y}]
            }
        }
        
        proc set_balloon {target message} {
            variable Bulle
            set Bulle($target) $message
            bindtags $target "[bindtags $target] Bulle"
        }
        
        proc kill_balloon {} {
            variable Bulle
            after cancel $Bulle(id)
            if {[winfo exists .balloon] == 1} {
                destroy .balloon
            }
            set Bulle(set) 0
        }
        
        proc balloon {target message {cx 0} {cy 0} } {
            variable Bulle
            if {$Bulle(first) == 1 } {
                set Bulle(first) 2
                if { $cx == 0 && $cy == 0 } {
                    set x [expr [winfo rootx $target] + ([winfo width $target]/2)]
                    set y [expr [winfo rooty $target] + [winfo height $target] + 4]
                } else {
                    set x [expr $cx + 4]
                    set y [expr $cy + 4]
                }
                toplevel .balloon -bg black -screen [winfo screen $target]
                wm overrideredirect .balloon 1
                label .balloon.l \
                    -text $message -relief flat \
                    -bg #ffffaa -fg black -padx 2 -pady 0 -anchor w
                pack .balloon.l -side left -padx 1 -pady 1
                wm geometry .balloon +${x}+${y}
                set Bulle(set) 1
            }
        }
    }
    
    
    namespace eval sizer {
        ######################################################################
        #
        # From mail@kai-morich.de (from "sizer control" on the 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  
    }
 }

----
Here's an application that uses the framework. This is actually the program I used to create the base64-encoded button strings that appear in the code above, so it is hopefully useful by itself.

A couple of things to notice in the code:
   * Any values assigned to the "prefs" array will be automatically saved on exit and retrieved when the program is restarted
   * Balloon help can be applied to widgets in your own program, not just to the toolbar
   * The variables "copyBtn" and "openBtn" aren't used here, but they could be used, e.g.l
 if 0 {
    $copyBtn config -state disabled
 }

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. Try it with this: [http://www.kb-creative.net/images/find.gif].

Here's the application itself:

 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
 }