HP/util/HP/lib/tk8.0/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 # SCCS: @(#) image2.tcl 1.9 97/03/02 16:24:48
   7
   8 if {![info exists widgetDemo]} {
   9     error "This script should be run from the \"widget\" demo."
  10 }
  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 [file join $dirName *]]] {
  24         $w.f.list insert end [file tail $i]
  25     }
  26 }
  27
  28 # loadImage --
  29 # Given the name of the toplevel window of the demo and the mouse
  30 # position, extracts the directory entry under the mouse and loads
  31 # that file into a photo image for display.
  32 #
  33 # Arguments:
  34 # w -                   Name of the toplevel window of the demo.
  35 # x, y-                 Mouse position within the listbox.
  36
  37 proc loadImage {w x y} {
  38     global dirName
  39
  40     set file [file join $dirName [$w.f.list get @$x,$y]]
  41     image2a configure -file $file
  42 }
  43
  44 set w .image2
  45 catch {destroy $w}
  46 toplevel $w
  47 wm title $w "Image Demonstration #2"
  48 wm iconname $w "Image2"
  49 positionWindow $w
  50
  51 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."
  52 pack $w.msg -side top
  53
  54 frame $w.buttons
  55 pack $w.buttons -side bottom -fill x -pady 2m
  56 button $w.buttons.dismiss -text Dismiss -command "destroy $w"
  57 button $w.buttons.code -text "See Code" -command "showCode $w"
  58 pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
  59
  60 label $w.dirLabel -text "Directory:"
  61 set dirName [file join $tk_library demos images]
  62 entry $w.dirName -width 30 -textvariable dirName
  63 bind $w.dirName <Return> "loadDir $w"
  64 frame $w.spacer1 -height 3m -width 20
  65 label $w.fileLabel -text "File:"
  66 frame $w.f
  67 pack $w.dirLabel $w.dirName $w.spacer1 $w.fileLabel $w.f -side top -anchor w
  68
  69 listbox $w.f.list -width 20 -height 10 -yscrollcommand "$w.f.scroll set"
  70 scrollbar $w.f.scroll -command "$w.f.list yview"
  71 pack $w.f.list $w.f.scroll -side left -fill y -expand 1
  72 $w.f.list insert 0 earth.gif earthris.gif teapot.ppm
  73 bind $w.f.list <Double-1> "loadImage $w %x %y"
  74
  75 catch {image delete image2a}
  76 image create photo image2a
  77 frame $w.spacer2 -height 3m -width 20
  78 label $w.imageLabel -text "Image:"
  79 label $w.image -image image2a
  80 pack $w.spacer2 $w.imageLabel $w.image -side top -anchor w