diff options
author | rjohnson <rjohnson@noemail.net> | 1998-04-01 09:51:45 (GMT) |
---|---|---|
committer | rjohnson <rjohnson@noemail.net> | 1998-04-01 09:51:45 (GMT) |
commit | 9c5b7f2b7e472536ed2e7c915ead05e2aa264182 (patch) | |
tree | 8fb30cb152c4dc191be47fa043d2e6f5ea38c7ba /library/demos/image2.tcl | |
parent | 1d0efcbe267f2c0eb73869862522fb20fb2d63ca (diff) | |
download | tk-9c5b7f2b7e472536ed2e7c915ead05e2aa264182.zip tk-9c5b7f2b7e472536ed2e7c915ead05e2aa264182.tar.gz tk-9c5b7f2b7e472536ed2e7c915ead05e2aa264182.tar.bz2 |
Initial revision
FossilOrigin-Name: 2bf55ca9aa942b581137b9f474da5ad9c1480de4
Diffstat (limited to 'library/demos/image2.tcl')
-rw-r--r-- | library/demos/image2.tcl | 80 |
1 files changed, 80 insertions, 0 deletions
diff --git a/library/demos/image2.tcl b/library/demos/image2.tcl new file mode 100644 index 0000000..badea14 --- /dev/null +++ b/library/demos/image2.tcl @@ -0,0 +1,80 @@ +# image2.tcl -- +# +# This demonstration script creates a simple collection of widgets +# that allow you to select and view images in a Tk label. +# +# SCCS: @(#) image2.tcl 1.9 97/03/02 16:24:48 + +if {![info exists widgetDemo]} { + error "This script should be run from the \"widget\" demo." +} + +# loadDir -- +# This procedure reloads the directory listbox from the directory +# named in the demo's entry. +# +# Arguments: +# w - Name of the toplevel window of the demo. + +proc loadDir w { + global dirName + + $w.f.list delete 0 end + foreach i [lsort [glob [file join $dirName *]]] { + $w.f.list insert end [file tail $i] + } +} + +# loadImage -- +# Given the name of the toplevel window of the demo and the mouse +# position, extracts the directory entry under the mouse and loads +# that file into a photo image for display. +# +# Arguments: +# w - Name of the toplevel window of the demo. +# x, y- Mouse position within the listbox. + +proc loadImage {w x y} { + global dirName + + set file [file join $dirName [$w.f.list get @$x,$y]] + image2a configure -file $file +} + +set w .image2 +catch {destroy $w} +toplevel $w +wm title $w "Image Demonstration #2" +wm iconname $w "Image2" +positionWindow $w + +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." +pack $w.msg -side top + +frame $w.buttons +pack $w.buttons -side bottom -fill x -pady 2m +button $w.buttons.dismiss -text Dismiss -command "destroy $w" +button $w.buttons.code -text "See Code" -command "showCode $w" +pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + +label $w.dirLabel -text "Directory:" +set dirName [file join $tk_library demos images] +entry $w.dirName -width 30 -textvariable dirName +bind $w.dirName <Return> "loadDir $w" +frame $w.spacer1 -height 3m -width 20 +label $w.fileLabel -text "File:" +frame $w.f +pack $w.dirLabel $w.dirName $w.spacer1 $w.fileLabel $w.f -side top -anchor w + +listbox $w.f.list -width 20 -height 10 -yscrollcommand "$w.f.scroll set" +scrollbar $w.f.scroll -command "$w.f.list yview" +pack $w.f.list $w.f.scroll -side left -fill y -expand 1 +$w.f.list insert 0 earth.gif earthris.gif teapot.ppm +bind $w.f.list <Double-1> "loadImage $w %x %y" + +catch {image delete image2a} +image create photo image2a +frame $w.spacer2 -height 3m -width 20 +label $w.imageLabel -text "Image:" +label $w.image -image image2a +pack $w.spacer2 $w.imageLabel $w.image -side top -anchor w |