#--------------- # 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