#---------------
# LoadButtons.tcl
#---------------
# William J Giddings, 24/Feb/2006
#---------------
#
# Batch loading of bitmaps for GUI buttons etc.,
#
# switches:
# -pattern filename of image to load, or wilcard e.g., *.gif
#
# returns
# list of images created
#
# Note:
# -----
# The names of the images created is the rootname of file.
#---------------
set DEMO(loadbuttons) yes
# For non-gif filetypes, load the Img Package
package require Img
#---------------
# load bitmaps from specific directory
#---------------
proc LoadButtons {dir args} {
# set default values
set pattern *.gif
set display no
# set switches
foreach {arg val} $args {
set arg [string trimleft $arg -]
set $arg $val
}
# create list of detected files
set k [glob -nocomplain -directory $dir $pattern]
foreach i $k {
# create a list of image names
lappend j [file root [file tail $i]]
}
# create images
set k 0
foreach i [glob -directory $dir $pattern] {
image create photo [lindex $j $k] -file $i
incr k
}
return $j
}
#----------------
# the ubiquitous demo
#----------------
if {$DEMO(loadbuttons)} {
console show
# assume pics are in a sub-directory of their own
set dir [pwd]/pics
set pattern *.gif
puts [LoadButtons $dir -pattern $pattern -display yes]
# create an display
destroy .disp
toplevel .disp
wm title .disp "$dir/$pattern"
canvas .disp.can -yscrollcommand ".disp.vscr set"
scrollbar .disp.vscr -command ".disp.can yview"
pack .disp.can -side left -expand yes -fill both
pack .disp.vscr -side right -fill y
# create graphics viewe
set x 10 ; set y 0
foreach i [lsort [image names]] {
label .disp.can.l$i -text $i -image $i -compound left
.disp.can create window $x $y -window .disp.can.l$i -anchor nw
set h [image height [.disp.can.l$i cget -image]]
if {$h < 15} {set h 15}
incr y [expr $h + 5]
}
.disp.can configure -scrollregion "0 0 50 $y"
}Category Graphics - Category GUI

