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 / twind.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  6.6 KB  |  197 lines
  1. # twind.tcl --
  2. #
  3. # This demonstration script creates a text widget with a bunch of
  4. # embedded windows.
  5. #
  6. # RCS: @(#) $Id: twind.tcl,v 1.2 1998/09/14 18:23:30 stanton Exp $
  7.  
  8. if {![info exists widgetDemo]} {
  9.     error "This script should be run from the \"widget\" demo."
  10. }
  11.  
  12. set w .twind
  13. catch {destroy $w}
  14. toplevel $w
  15. wm title $w "Text Demonstration - Embedded Windows"
  16. wm iconname $w "Embedded Windows"
  17. positionWindow $w
  18.  
  19. frame $w.buttons
  20. pack $w.buttons -side bottom -fill x -pady 2m
  21. button $w.buttons.dismiss -text Dismiss -command "destroy $w"
  22. button $w.buttons.code -text "See Code" -command "showCode $w"
  23. pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
  24.  
  25. frame $w.f -highlightthickness 2 -borderwidth 2 -relief sunken
  26. set t $w.f.text
  27. text $t -yscrollcommand "$w.scroll set" -setgrid true -font $font -width 70 \
  28.     -height 35 -wrap word -highlightthickness 0 -borderwidth 0
  29. pack $t -expand  yes -fill both
  30. scrollbar $w.scroll -command "$t yview"
  31. pack $w.scroll -side right -fill y
  32. pack $w.f -expand yes -fill both
  33. $t tag configure center -justify center -spacing1 5m -spacing3 5m
  34. $t tag configure buttons -lmargin1 1c -lmargin2 1c -rmargin 1c \
  35.     -spacing1 3m -spacing2 0 -spacing3 0
  36.  
  37. button $t.on -text "Turn On" -command "textWindOn $w" \
  38.     -cursor top_left_arrow
  39. button $t.off -text "Turn Off" -command "textWindOff $w" \
  40.     -cursor top_left_arrow
  41. button $t.click -text "Click Here" -command "textWindPlot $t" \
  42.     -cursor top_left_arrow
  43. button $t.delete -text "Delete" -command "textWindDel $w" \
  44.     -cursor top_left_arrow
  45.  
  46. $t insert end "A text widget can contain other widgets embedded "
  47. $t insert end "it.  These are called \"embedded windows\", "
  48. $t insert end "and they can consist of arbitrary widgets.  "
  49. $t insert end "For example, here are two embedded button "
  50. $t insert end "widgets.  You can click on the first button to "
  51. $t window create end -window $t.on
  52. $t insert end " horizontal scrolling, which also turns off "
  53. $t insert end "word wrapping.  Or, you can click on the second "
  54. $t insert end "button to\n"
  55. $t window create end -window $t.off
  56. $t insert end " horizontal scrolling and turn back on word wrapping.\n\n"
  57.  
  58. $t insert end "Or, here is another example.  If you "
  59. $t window create end -window $t.click
  60. $t insert end " a canvas displaying an x-y plot will appear right here."
  61. $t mark set plot insert
  62. $t mark gravity plot left
  63. $t insert end "  You can drag the data points around with the mouse, "
  64. $t insert end "or you can click here to "
  65. $t window create end -window $t.delete
  66. $t insert end " the plot again.\n\n"
  67.  
  68. $t insert end "You may also find it useful to put embedded windows in "
  69. $t insert end "a text without any actual text.  In this case the "
  70. $t insert end "text widget acts like a geometry manager.  For "
  71. $t insert end "example, here is a collection of buttons laid out "
  72. $t insert end "neatly into rows by the text widget.  These buttons "
  73. $t insert end "can be used to change the background color of the "
  74. $t insert end "text widget (\"Default\" restores the color to "
  75. $t insert end "its default).  If you click on the button labeled "
  76. $t insert end "\"Short\", it changes to a longer string so that "
  77. $t insert end "you can see how the text widget automatically "
  78. $t insert end "changes the layout.  Click on the button again "
  79. $t insert end "to restore the short string.\n"
  80.  
  81. button $t.default -text Default -command "embDefBg $t" \
  82.     -cursor top_left_arrow
  83. $t window create end -window $t.default -padx 3
  84. global embToggle
  85. set embToggle Short
  86. checkbutton $t.toggle -textvariable embToggle -indicatoron 0 \
  87.     -variable embToggle -onvalue "A much longer string" \
  88.     -offvalue "Short" -cursor top_left_arrow -pady 5 -padx 2
  89. $t window create end -window $t.toggle -padx 3 -pady 2
  90. set i 1
  91. foreach color {AntiqueWhite3 Bisque1 Bisque2 Bisque3 Bisque4
  92.     SlateBlue3 RoyalBlue1 SteelBlue2 DeepSkyBlue3 LightBlue1
  93.     DarkSlateGray1 Aquamarine2 DarkSeaGreen2 SeaGreen1
  94.     Yellow1 IndianRed1 IndianRed2 Tan1 Tan4} {
  95.     button $t.color$i -text $color -cursor top_left_arrow -command \
  96.         "$t configure -bg $color"
  97.     $t window create end -window $t.color$i -padx 3 -pady 2
  98.     incr i
  99. }
  100. $t tag add buttons $t.default end
  101.  
  102. proc textWindOn w {
  103.     catch {destroy $w.scroll2}
  104.     set t $w.f.text
  105.     scrollbar $w.scroll2 -orient horizontal -command "$t xview"
  106.     pack $w.scroll2 -after $w.buttons -side bottom -fill x
  107.     $t configure -xscrollcommand "$w.scroll2 set" -wrap none
  108. }
  109.  
  110. proc textWindOff w {
  111.     catch {destroy $w.scroll2}
  112.     set t $w.f.text
  113.     $t configure -xscrollcommand {} -wrap word
  114. }
  115.  
  116. proc textWindPlot t {
  117.     set c $t.c
  118.     if [winfo exists $c] {
  119.     return
  120.     }
  121.     canvas $c -relief sunken -width 450 -height 300 -cursor top_left_arrow
  122.  
  123.     set font {Helvetica 18}
  124.  
  125.     $c create line 100 250 400 250 -width 2
  126.     $c create line 100 250 100 50 -width 2
  127.     $c create text 225 20 -text "A Simple Plot" -font $font -fill brown
  128.     
  129.     for {set i 0} {$i <= 10} {incr i} {
  130.     set x [expr {100 + ($i*30)}]
  131.     $c create line $x 250 $x 245 -width 2
  132.     $c create text $x 254 -text [expr 10*$i] -anchor n -font $font
  133.     }
  134.     for {set i 0} {$i <= 5} {incr i} {
  135.     set y [expr {250 - ($i*40)}]
  136.     $c create line 100 $y 105 $y -width 2
  137.     $c create text 96 $y -text [expr $i*50].0 -anchor e -font $font
  138.     }
  139.     
  140.     foreach point {{12 56} {20 94} {33 98} {32 120} {61 180}
  141.         {75 160} {98 223}} {
  142.     set x [expr {100 + (3*[lindex $point 0])}]
  143.     set y [expr {250 - (4*[lindex $point 1])/5}]
  144.     set item [$c create oval [expr $x-6] [expr $y-6] \
  145.         [expr $x+6] [expr $y+6] -width 1 -outline black \
  146.         -fill SkyBlue2]
  147.     $c addtag point withtag $item
  148.     }
  149.  
  150.     $c bind point <Any-Enter> "$c itemconfig current -fill red"
  151.     $c bind point <Any-Leave> "$c itemconfig current -fill SkyBlue2"
  152.     $c bind point <1> "embPlotDown $c %x %y"
  153.     $c bind point <ButtonRelease-1> "$c dtag selected"
  154.     bind $c <B1-Motion> "embPlotMove $c %x %y"
  155.     while {[string first [$t get plot] " \t\n"] >= 0} {
  156.     $t delete plot
  157.     }
  158.     $t insert plot "\n"
  159.     $t window create plot -window $c
  160.     $t tag add center plot
  161.     $t insert plot "\n"
  162. }
  163.  
  164. set embPlot(lastX) 0
  165. set embPlot(lastY) 0
  166.  
  167. proc embPlotDown {w x y} {
  168.     global embPlot
  169.     $w dtag selected
  170.     $w addtag selected withtag current
  171.     $w raise current
  172.     set embPlot(lastX) $x
  173.     set embPlot(lastY) $y
  174. }
  175.  
  176. proc embPlotMove {w x y} {
  177.     global embPlot
  178.     $w move selected [expr $x-$embPlot(lastX)] [expr $y-$embPlot(lastY)]
  179.     set embPlot(lastX) $x
  180.     set embPlot(lastY) $y
  181. }
  182.  
  183. proc textWindDel w {
  184.     set t $w.f.text
  185.     if [winfo exists $t.c] {
  186.     $t delete $t.c
  187.     while {[string first [$t get plot] " \t\n"] >= 0} {
  188.         $t delete plot
  189.     }
  190.     $t insert plot "  "
  191.     }
  192. }
  193.  
  194. proc embDefBg t {
  195.     $t configure -background [lindex [$t configure -background] 3]
  196. }
  197.