1# image2.tcl -- 2# 3# This demonstration script creates a simple collection of widgets 4# that allow you to select and view images in a Tk label. 5 6if {![info exists widgetDemo]} { 7 error "This script should be run from the \"widget\" demo." 8} 9 10package require Tk 11 12# loadDir -- 13# This procedure reloads the directory listbox from the directory 14# named in the demo's entry. 15# 16# Arguments: 17# w - Name of the toplevel window of the demo. 18 19proc loadDir w { 20 global dirName 21 22 $w.f.list delete 0 end 23 foreach i [lsort [glob -type f -directory $dirName *]] { 24 $w.f.list insert end [file tail $i] 25 } 26} 27 28# selectAndLoadDir -- 29# This procedure pops up a dialog to ask for a directory to load into 30# the listobx and (if the user presses OK) reloads the directory 31# listbox from the directory named in the demo's entry. 32# 33# Arguments: 34# w - Name of the toplevel window of the demo. 35 36proc selectAndLoadDir w { 37 global dirName 38 set dir [tk_chooseDirectory -initialdir $dirName -parent $w -mustexist 1] 39 if {[string length $dir] != 0} { 40 set dirName $dir 41 loadDir $w 42 } 43} 44 45# loadImage -- 46# Given the name of the toplevel window of the demo and the mouse 47# position, extracts the directory entry under the mouse and loads 48# that file into a photo image for display. 49# 50# Arguments: 51# w - Name of the toplevel window of the demo. 52# x, y- Mouse position within the listbox. 53 54proc loadImage {w x y} { 55 global dirName 56 57 set file [file join $dirName [$w.f.list get @$x,$y]] 58 if {[catch { 59 image2a configure -file $file 60 }]} then { 61 # Mark the file as not loadable 62 $w.f.list itemconfigure @$x,$y -bg \#c00000 -selectbackground \#ff0000 63 } 64} 65 66set w .image2 67catch {destroy $w} 68toplevel $w 69wm title $w "Image Demonstration #2" 70wm iconname $w "Image2" 71positionWindow $w 72 73label $w.msg -font $font -wraplength 4i -justify left -text "This demonstration allows you to view images using a Tk \"photo\" image. First type a directory name in the listbox, then type Return to load the directory into the listbox. Then double-click on a file name in the listbox to see that image." 74pack $w.msg -side top 75 76## See Code / Dismiss buttons 77set btns [addSeeDismiss $w.buttons $w] 78pack $btns -side bottom -fill x 79 80frame $w.mid 81pack $w.mid -fill both -expand 1 82 83labelframe $w.dir -text "Directory:" 84# Main widget program sets variable tk_demoDirectory 85set dirName [file join $tk_demoDirectory images] 86entry $w.dir.e -width 30 -textvariable dirName 87button $w.dir.b -pady 0 -padx 2m -text "Select Dir." \ 88 -command "selectAndLoadDir $w" 89bind $w.dir.e <Return> "loadDir $w" 90pack $w.dir.e -side left -fill both -padx 2m -pady 2m -expand true 91pack $w.dir.b -side left -fill y -padx {0 2m} -pady 2m 92labelframe $w.f -text "File:" -padx 2m -pady 2m 93 94listbox $w.f.list -width 20 -height 10 -yscrollcommand "$w.f.scroll set" 95scrollbar $w.f.scroll -command "$w.f.list yview" 96pack $w.f.list $w.f.scroll -side left -fill y -expand 1 97$w.f.list insert 0 earth.gif earthris.gif teapot.ppm 98bind $w.f.list <Double-1> "loadImage $w %x %y" 99 100catch {image delete image2a} 101image create photo image2a 102labelframe $w.image -text "Image:" 103label $w.image.image -image image2a 104pack $w.image.image -padx 2m -pady 2m 105 106grid $w.dir - -sticky ew -padx 1m -pady 1m -in $w.mid 107grid $w.f $w.image -sticky nw -padx 1m -pady 1m -in $w.mid 108grid columnconfigure $w.mid 1 -weight 1 109