home *** CD-ROM | disk | FTP | other *** search
/ PC World 2002 May / PCWorld_2002-05_cd.bin / Software / TemaCD / activetcltk / ActiveTcl8.3.4.1-8.win32-ix86.exe / ActiveTcl8.3.4.1-win32-ix86 / demos / Tk / image2.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  2.6 KB  |  81 lines
  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. # RCS: @(#) $Id: image2.tcl,v 1.2 1998/09/14 18:23:29 stanton Exp $
  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
  81.