mingw/lib/tk8.5/demos/image2.tcl

   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
   6 if {![info exists widgetDemo]} {
   7     error "This script should be run from the \"widget\" demo."
   8 }
   9
  10 package 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
  19 proc 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
  36 proc 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
  54 proc 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
  66 set w .image2
  67 catch {destroy $w}
  68 toplevel $w
  69 wm title $w "Image Demonstration #2"
  70 wm iconname $w "Image2"
  71 positionWindow $w
  72
  73 label $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."
  74 pack $w.msg -side top
  75
  76 ## See Code / Dismiss buttons
  77 set btns [addSeeDismiss $w.buttons $w]
  78 pack $btns -side bottom -fill x
  79
  80 frame $w.mid
  81 pack $w.mid -fill both -expand 1
  82
  83 labelframe $w.dir -text "Directory:"
  84 # Main widget program sets variable tk_demoDirectory
  85 set dirName [file join $tk_demoDirectory images]
  86 entry $w.dir.e -width 30 -textvariable dirName
  87 button $w.dir.b -pady 0 -padx 2m -text "Select Dir." \
  88         -command "selectAndLoadDir $w"
  89 bind $w.dir.e <Return> "loadDir $w"
  90 pack $w.dir.e -side left -fill both -padx 2m     -pady 2m -expand true
  91 pack $w.dir.b -side left -fill y    -padx {0 2m} -pady 2m
  92 labelframe $w.f -text "File:" -padx 2m -pady 2m
  93
  94 listbox $w.f.list -width 20 -height 10 -yscrollcommand "$w.f.scroll set"
  95 scrollbar $w.f.scroll -command "$w.f.list yview"
  96 pack $w.f.list $w.f.scroll -side left -fill y -expand 1
  97 $w.f.list insert 0 earth.gif earthris.gif teapot.ppm
  98 bind $w.f.list <Double-1> "loadImage $w %x %y"
  99
 100 catch {image delete image2a}
 101 image create photo image2a
 102 labelframe $w.image -text "Image:"
 103 label $w.image.image -image image2a
 104 pack $w.image.image -padx 2m -pady 2m
 105
 106 grid $w.dir -        -sticky ew -padx 1m -pady 1m -in $w.mid
 107 grid $w.f   $w.image -sticky nw -padx 1m -pady 1m -in $w.mid
 108 grid columnconfigure $w.mid 1 -weight 1