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 / widget.tcl < prev   
Encoding:
Text File  |  2001-10-22  |  13.4 KB  |  392 lines

  1. #!/bin/sh
  2. # the next line restarts using wish \
  3. exec wish "$0" "$@"
  4.  
  5. # widget --
  6. # This script demonstrates the various widgets provided by Tk,
  7. # along with many of the features of the Tk toolkit.  This file
  8. # only contains code to generate the main window for the
  9. # application, which invokes individual demonstrations.  The
  10. # code for the actual demonstrations is contained in separate
  11. # ".tcl" files is this directory, which are sourced by this script
  12. # as needed.
  13. #
  14. # RCS: @(#) $Id: widget,v 1.2 1998/09/14 18:23:30 stanton Exp $
  15.  
  16. eval destroy [winfo child .]
  17. wm title . "Widget Demonstration"
  18. set widgetDemo 1
  19.  
  20. #----------------------------------------------------------------
  21. # The code below create the main window, consisting of a menu bar
  22. # and a text widget that explains how to use the program, plus lists
  23. # all of the demos as hypertext items.
  24. #----------------------------------------------------------------
  25.  
  26. set font {Helvetica 14}
  27. menu .menuBar -tearoff 0
  28. .menuBar add cascade -menu .menuBar.file -label "File" -underline 0
  29. menu .menuBar.file -tearoff 0
  30.  
  31. # On the Mac use the specia .apple menu for the about item
  32. if {$tcl_platform(platform) == "macintosh"} {
  33.     .menuBar add cascade -menu .menuBar.apple
  34.     menu .menuBar.apple -tearoff 0
  35.     .menuBar.apple add command -label "About..." -command "aboutBox"
  36. } else {
  37.     .menuBar.file add command -label "About..." -command "aboutBox" \
  38.     -underline 0 -accelerator "<F1>"
  39.     .menuBar.file add sep
  40. }
  41.  
  42. .menuBar.file add command -label "Quit" -command "exit" -underline 0 \
  43.     -accelerator "Meta-Q"
  44. . configure -menu .menuBar
  45. bind . <F1> aboutBox
  46.  
  47. frame .statusBar
  48. label .statusBar.lab -text "   " -relief sunken -bd 1 \
  49.     -font -*-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -anchor w
  50. label .statusBar.foo -width 8 -relief sunken -bd 1 \
  51.     -font -*-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -anchor w
  52. pack .statusBar.lab -side left -padx 2 -expand yes -fill both
  53. pack .statusBar.foo -side left -padx 2
  54. pack .statusBar -side bottom -fill x -pady 2
  55.  
  56. frame .textFrame
  57. scrollbar .s -orient vertical -command {.t yview} -highlightthickness 0 \
  58.     -takefocus 1
  59. pack .s -in .textFrame -side right -fill y
  60. text .t -yscrollcommand {.s set} -wrap word -width 60 -height 30 -font $font \
  61.     -setgrid 1 -highlightthickness 0 -padx 4 -pady 2 -takefocus 0
  62. pack .t -in .textFrame -expand y -fill both -padx 1
  63. pack  .textFrame -expand yes -fill both
  64.  
  65. # Create a bunch of tags to use in the text widget, such as those for
  66. # section titles and demo descriptions.  Also define the bindings for
  67. # tags.
  68.  
  69. .t tag configure title -font {Helvetica 18 bold}
  70.  
  71. # We put some "space" characters to the left and right of each demo description
  72. # so that the descriptions are highlighted only when the mouse cursor
  73. # is right over them (but not when the cursor is to their left or right)
  74. #
  75. .t tag configure demospace -lmargin1 1c -lmargin2 1c
  76.  
  77.  
  78. if {[winfo depth .] == 1} {
  79.     .t tag configure demo -lmargin1 1c -lmargin2 1c \
  80.     -underline 1
  81.     .t tag configure visited -lmargin1 1c -lmargin2 1c \
  82.     -underline 1
  83.     .t tag configure hot -background black -foreground white
  84. } else {
  85.     .t tag configure demo -lmargin1 1c -lmargin2 1c \
  86.     -foreground blue -underline 1
  87.     .t tag configure visited -lmargin1 1c -lmargin2 1c \
  88.     -foreground #303080 -underline 1
  89.     .t tag configure hot -foreground red -underline 1
  90. }
  91. .t tag bind demo <ButtonRelease-1> {
  92.     invoke [.t index {@%x,%y}]
  93. }
  94. set lastLine ""
  95. .t tag bind demo <Enter> {
  96.     set lastLine [.t index {@%x,%y linestart}]
  97.     .t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars"
  98.     .t config -cursor hand2
  99.     showStatus [.t index {@%x,%y}]
  100. }
  101. .t tag bind demo <Leave> {
  102.     .t tag remove hot 1.0 end
  103.     .t config -cursor xterm
  104.     .statusBar.lab config -text ""
  105. }
  106. .t tag bind demo <Motion> {
  107.     set newLine [.t index {@%x,%y linestart}]
  108.     if {[string compare $newLine $lastLine] != 0} {
  109.     .t tag remove hot 1.0 end
  110.     set lastLine $newLine
  111.  
  112.     set tags [.t tag names {@%x,%y}]
  113.     set i [lsearch -glob $tags demo-*]
  114.     if {$i >= 0} {
  115.         .t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars"
  116.     }
  117.     }
  118.     showStatus [.t index {@%x,%y}]
  119. }
  120.  
  121. # Create the text for the text widget.
  122.  
  123. .t insert end "Tk Widget Demonstrations\n" title
  124. .t insert end {
  125. This application provides a front end for several short scripts that demonstrate what you can do with Tk widgets.  Each of the numbered lines below describes a demonstration;  you can click on it to invoke the demonstration.  Once the demonstration window appears, you can click the "See Code" button to see the Tcl/Tk code that created the demonstration.  If you wish, you can edit the code and click the "Rerun Demo" button in the code window to reinvoke the demonstration with the modified code.
  126.  
  127. }
  128. .t insert end "Labels, buttons, checkbuttons, and radiobuttons" title
  129. .t insert end " \n " {demospace}
  130. .t insert end "1. Labels (text and bitmaps)." {demo demo-label}
  131. .t insert end " \n " {demospace}
  132. .t insert end "2. Buttons." {demo demo-button}
  133. .t insert end " \n " {demospace}
  134. .t insert end "3. Checkbuttons (select any of a group)." {demo demo-check}
  135. .t insert end " \n " {demospace}
  136. .t insert end "4. Radiobuttons (select one of a group)." {demo demo-radio}
  137. .t insert end " \n " {demospace}
  138. .t insert end "5. A 15-puzzle game made out of buttons." {demo demo-puzzle}
  139. .t insert end " \n " {demospace}
  140. .t insert end "6. Iconic buttons that use bitmaps." {demo demo-icon}
  141. .t insert end " \n " {demospace}
  142. .t insert end "7. Two labels displaying images." {demo demo-image1}
  143. .t insert end " \n " {demospace}
  144. .t insert end "8. A simple user interface for viewing images." \
  145.     {demo demo-image2}
  146. .t insert end " \n " {demospace}
  147.  
  148. .t insert end \n {} "Listboxes" title
  149. .t insert end " \n " {demospace}
  150. .t insert end "1. 50 states." {demo demo-states}
  151. .t insert end " \n " {demospace}
  152. .t insert end "2. Colors: change the color scheme for the application." \
  153.     {demo demo-colors}
  154. .t insert end " \n " {demospace}
  155. .t insert end "3. A collection of famous sayings." {demo demo-sayings}
  156. .t insert end " \n " {demospace}
  157.  
  158. .t insert end \n {} "Entries" title
  159. .t insert end " \n " {demospace}
  160. .t insert end "1. Without scrollbars." {demo demo-entry1}
  161. .t insert end " \n " {demospace}
  162. .t insert end "2. With scrollbars." {demo demo-entry2}
  163. .t insert end " \n " {demospace}
  164. .t insert end "3. Simple Rolodex-like form." {demo demo-form}
  165. .t insert end " \n " {demospace}
  166.  
  167. .t insert end \n {} "Text" title
  168. .t insert end " \n " {demospace}
  169. .t insert end "1. Basic editable text." {demo demo-text}
  170. .t insert end " \n " {demospace}
  171. .t insert end "2. Text display styles." {demo demo-style}
  172. .t insert end " \n " {demospace}
  173. .t insert end "3. Hypertext (tag bindings)." {demo demo-bind}
  174. .t insert end " \n " {demospace}
  175. .t insert end "4. A text widget with embedded windows." {demo demo-twind}
  176. .t insert end " \n " {demospace}
  177. .t insert end "5. A search tool built with a text widget." {demo demo-search}
  178. .t insert end " \n " {demospace}
  179.  
  180. .t insert end \n {} "Canvases" title
  181. .t insert end " \n " {demospace}
  182. .t insert end "1. The canvas item types." {demo demo-items}
  183. .t insert end " \n " {demospace}
  184. .t insert end "2. A simple 2-D plot." {demo demo-plot}
  185. .t insert end " \n " {demospace}
  186. .t insert end "3. Text items in canvases." {demo demo-ctext}
  187. .t insert end " \n " {demospace}
  188. .t insert end "4. An editor for arrowheads on canvas lines." {demo demo-arrow}
  189. .t insert end " \n " {demospace}
  190. .t insert end "5. A ruler with adjustable tab stops." {demo demo-ruler}
  191. .t insert end " \n " {demospace}
  192. .t insert end "6. A building floor plan." {demo demo-floor}
  193. .t insert end " \n " {demospace}
  194. .t insert end "7. A simple scrollable canvas." {demo demo-cscroll}
  195. .t insert end " \n " {demospace}
  196.  
  197. .t insert end \n {} "Scales" title
  198. .t insert end " \n " {demospace}
  199. .t insert end "1. Vertical scale." {demo demo-vscale}
  200. .t insert end " \n " {demospace}
  201. .t insert end "2. Horizontal scale." {demo demo-hscale}
  202. .t insert end " \n " {demospace}
  203.  
  204. .t insert end \n {} "Menus" title
  205. .t insert end " \n " {demospace}
  206. .t insert end "1. Menus and cascades." \
  207.     {demo demo-menu}
  208. .t insert end " \n " {demospace}
  209. .t insert end "2. Menubuttons"\
  210.     {demo demo-menubu}
  211. .t insert end " \n " {demospace}
  212.  
  213. .t insert end \n {} "Common Dialogs" title
  214. .t insert end " \n " {demospace}
  215. .t insert end "1. Message boxes." {demo demo-msgbox}
  216. .t insert end " \n " {demospace}
  217. .t insert end "2. File selection dialog." {demo demo-filebox}
  218. .t insert end " \n " {demospace}
  219. .t insert end "3. Color picker." {demo demo-clrpick}
  220. .t insert end " \n " {demospace}
  221.  
  222. .t insert end \n {} "Miscellaneous" title
  223. .t insert end " \n " {demospace}
  224. .t insert end "1. The built-in bitmaps." {demo demo-bitmap}
  225. .t insert end " \n " {demospace}
  226. .t insert end "2. A dialog box with a local grab." {demo demo-dialog1}
  227. .t insert end " \n " {demospace}
  228. .t insert end "3. A dialog box with a global grab." {demo demo-dialog2}
  229. .t insert end " \n " {demospace}
  230.  
  231. .t configure -state disabled
  232. focus .s
  233.  
  234. # positionWindow --
  235. # This procedure is invoked by most of the demos to position a
  236. # new demo window.
  237. #
  238. # Arguments:
  239. # w -        The name of the window to position.
  240.  
  241. proc positionWindow w {
  242.     wm geometry $w +300+300
  243. }
  244.  
  245. # showVars --
  246. # Displays the values of one or more variables in a window, and
  247. # updates the display whenever any of the variables changes.
  248. #
  249. # Arguments:
  250. # w -        Name of new window to create for display.
  251. # args -    Any number of names of variables.
  252.  
  253. proc showVars {w args} {
  254.     catch {destroy $w}
  255.     toplevel $w
  256.     wm title $w "Variable values"
  257.     label $w.title -text "Variable values:" -width 20 -anchor center \
  258.         -font {Helvetica 18}
  259.     pack $w.title -side top -fill x
  260.     set len 1
  261.     foreach i $args {
  262.     if {[string length $i] > $len} {
  263.         set len [string length $i]
  264.     }
  265.     }
  266.     foreach i $args {
  267.     frame $w.$i
  268.     label $w.$i.name -text "$i: " -width [expr $len + 2] -anchor w
  269.     label $w.$i.value -textvar $i -anchor w
  270.     pack $w.$i.name -side left
  271.     pack $w.$i.value -side left -expand 1 -fill x
  272.     pack $w.$i -side top -anchor w -fill x
  273.     }
  274.     button $w.ok -text OK -command "destroy $w" -default active
  275.     bind $w <Return> "tkButtonInvoke $w.ok"
  276.     pack $w.ok -side bottom -pady 2
  277. }
  278.  
  279. # invoke --
  280. # This procedure is called when the user clicks on a demo description.
  281. # It is responsible for invoking the demonstration.
  282. #
  283. # Arguments:
  284. # index -    The index of the character that the user clicked on.
  285.  
  286. proc invoke index {
  287.     global tk_library
  288.     set tags [.t tag names $index]
  289.     set i [lsearch -glob $tags demo-*]
  290.     if {$i < 0} {
  291.     return
  292.     }
  293.     set cursor [.t cget -cursor]
  294.     .t configure -cursor watch
  295.     update
  296.     set demo [string range [lindex $tags $i] 5 end]
  297.     uplevel [list source [file join $tk_library demos $demo.tcl]]
  298.     update
  299.     .t configure -cursor $cursor
  300.  
  301.     .t tag add visited "$index linestart +1 chars" "$index lineend -1 chars"
  302. }
  303.  
  304. # showStatus --
  305. #
  306. #    Show the name of the demo program in the status bar. This procedure
  307. #    is called when the user moves the cursor over a demo description.
  308. #
  309. proc showStatus index {
  310.     global tk_library
  311.     set tags [.t tag names $index]
  312.     set i [lsearch -glob $tags demo-*]
  313.     set cursor [.t cget -cursor]
  314.     if {$i < 0} {
  315.     .statusBar.lab config -text " "
  316.     set newcursor xterm
  317.     } else {
  318.     set demo [string range [lindex $tags $i] 5 end]
  319.     .statusBar.lab config -text "Run the \"$demo\" sample program"
  320.     set newcursor hand2
  321.     }
  322.     if [string compare $cursor $newcursor] {
  323.     .t config -cursor $newcursor
  324.     }
  325. }
  326.  
  327.  
  328. # showCode --
  329. # This procedure creates a toplevel window that displays the code for
  330. # a demonstration and allows it to be edited and reinvoked.
  331. #
  332. # Arguments:
  333. # w -        The name of the demonstration's window, which can be
  334. #        used to derive the name of the file containing its code.
  335.  
  336. proc showCode w {
  337.     global tk_library
  338.     set file [string range $w 1 end].tcl
  339.     if ![winfo exists .code] {
  340.     toplevel .code
  341.     frame .code.buttons
  342.     pack .code.buttons -side bottom -fill x
  343.     button .code.buttons.dismiss -text Dismiss \
  344.             -default active -command "destroy .code"
  345.     button .code.buttons.rerun -text "Rerun Demo" -command {
  346.         eval [.code.text get 1.0 end]
  347.     }
  348.     pack .code.buttons.dismiss .code.buttons.rerun -side left \
  349.         -expand 1 -pady 2
  350.     frame .code.frame
  351.     pack  .code.frame -expand yes -fill both -padx 1 -pady 1
  352.     text .code.text -height 40 -wrap word\
  353.         -xscrollcommand ".code.xscroll set" \
  354.         -yscrollcommand ".code.yscroll set" \
  355.         -setgrid 1 -highlightthickness 0 -pady 2 -padx 3
  356.     scrollbar .code.xscroll -command ".code.text xview" \
  357.         -highlightthickness 0 -orient horizontal
  358.     scrollbar .code.yscroll -command ".code.text yview" \
  359.         -highlightthickness 0 -orient vertical
  360.  
  361.     grid .code.text -in .code.frame -padx 1 -pady 1 \
  362.         -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
  363.     grid .code.yscroll -in .code.frame -padx 1 -pady 1 \
  364.         -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
  365. #    grid .code.xscroll -in .code.frame -padx 1 -pady 1 \
  366. #        -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
  367.     grid rowconfig    .code.frame 0 -weight 1 -minsize 0
  368.     grid columnconfig .code.frame 0 -weight 1 -minsize 0
  369.     } else {
  370.     wm deiconify .code
  371.     raise .code
  372.     }
  373.     wm title .code "Demo code: [file join $tk_library demos $file]"
  374.     wm iconname .code $file
  375.     set id [open [file join $tk_library demos $file]]
  376.     .code.text delete 1.0 end
  377.     .code.text insert 1.0 [read $id]
  378.     .code.text mark set insert 1.0
  379.     close $id
  380. }
  381.  
  382. # aboutBox --
  383. #
  384. #    Pops up a message box with an "about" message
  385. #
  386. proc aboutBox {} {
  387.     tk_messageBox -icon info -type ok -title "About Widget Demo" -message \
  388. "Tk widget demonstration\n\n\
  389. Copyright (c) 1996-1997 Sun Microsystems, Inc."
  390. }
  391.  
  392.