home *** CD-ROM | disk | FTP | other *** search
/ The Best of Windows 95.com 1996 September / WIN95_09962.iso / vrml / cp2b2x.exe / DATA.Z / ruler.tcl < prev    next >
Text File  |  1996-04-23  |  5KB  |  170 lines
  1. # ruler.tcl --
  2. #
  3. # This demonstration script creates a canvas widget that displays a ruler
  4. # with tab stops that can be set, moved, and deleted.
  5. #
  6. # @(#) ruler.tcl 1.3 95/10/04 15:00:40
  7.  
  8. # rulerMkTab --
  9. # This procedure creates a new triangular polygon in a canvas to
  10. # represent a tab stop.
  11. #
  12. # Arguments:
  13. # c -        The canvas window.
  14. # x, y -    Coordinates at which to create the tab stop.
  15.  
  16. proc rulerMkTab {c x y} {
  17.     upvar #0 demo_rulerInfo v
  18.     $c create polygon $x $y [expr $x+$v(size)] [expr $y+$v(size)] \
  19.         [expr $x-$v(size)] [expr $y+$v(size)]
  20. }
  21.  
  22. set w .ruler
  23. global tk_library
  24. catch {destroy $w}
  25. toplevel $w
  26. wm title $w "Ruler Demonstration"
  27. wm iconname $w "ruler"
  28. positionWindow $w
  29. set c $w.c
  30.  
  31. label $w.msg -font $font -wraplength 5i -justify left -text "This canvas widget shows a mock-up of a ruler.  You can create tab stops by dragging them out of the well to the right of the ruler.  You can also drag existing tab stops.  If you drag a tab stop far enough up or down so that it turns dim, it will be deleted when you release the mouse button."
  32. pack $w.msg -side top
  33.  
  34. frame $w.buttons
  35. pack  $w.buttons -side bottom -expand y -fill x -pady 2m
  36. button $w.buttons.dismiss -text Dismiss -command "destroy $w"
  37. button $w.buttons.code -text "See Code" -command "showCode $w"
  38. pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
  39.  
  40. canvas $c -width 14.8c -height 2.5c
  41. pack $w.c -side top -fill x
  42.  
  43. set demo_rulerInfo(grid) .25c
  44. set demo_rulerInfo(left) [winfo fpixels $c 1c]
  45. set demo_rulerInfo(right) [winfo fpixels $c 13c]
  46. set demo_rulerInfo(top) [winfo fpixels $c 1c]
  47. set demo_rulerInfo(bottom) [winfo fpixels $c 1.5c]
  48. set demo_rulerInfo(size) [winfo fpixels $c .2c]
  49. set demo_rulerInfo(normalStyle) "-fill black"
  50. if {[winfo depth $c] > 1} {
  51.     set demo_rulerInfo(activeStyle) "-fill red -stipple {}"
  52.     set demo_rulerInfo(deleteStyle) \
  53.         "-stipple @$tk_library/demos/images/gray25.bmp -fill red"
  54. } else {
  55.     set demo_rulerInfo(activeStyle) "-fill black -stipple {}"
  56.     set demo_rulerInfo(deleteStyle) \
  57.         "-stipple @$tk_library/demos/images/gray25.bmp -fill black"
  58. }
  59.  
  60. $c create line 1c 0.5c 1c 1c 13c 1c 13c 0.5c -width 1
  61. for {set i 0} {$i < 12} {incr i} {
  62.     set x [expr $i+1]
  63.     $c create line ${x}c 1c ${x}c 0.6c -width 1
  64.     $c create line $x.25c 1c $x.25c 0.8c -width 1
  65.     $c create line $x.5c 1c $x.5c 0.7c -width 1
  66.     $c create line $x.75c 1c $x.75c 0.8c -width 1
  67.     $c create text $x.15c .75c -text $i -anchor sw
  68. }
  69. $c addtag well withtag [$c create rect 13.2c 1c 13.8c 0.5c \
  70.     -outline black -fill [lindex [$c config -bg] 4]]
  71. $c addtag well withtag [rulerMkTab $c [winfo pixels $c 13.5c] \
  72.     [winfo pixels $c .65c]]
  73.  
  74. $c bind well <1> "rulerNewTab $c %x %y"
  75. $c bind tab <1> "rulerSelectTab $c %x %y"
  76. bind $c <B1-Motion> "rulerMoveTab $c %x %y"
  77. bind $c <Any-ButtonRelease-1> "rulerReleaseTab $c"
  78.  
  79. # rulerNewTab --
  80. # Does all the work of creating a tab stop, including creating the
  81. # triangle object and adding tags to it to give it tab behavior.
  82. #
  83. # Arguments:
  84. # c -        The canvas window.
  85. # x, y -    The coordinates of the tab stop.
  86.  
  87. proc rulerNewTab {c x y} {
  88.     upvar #0 demo_rulerInfo v
  89.     $c addtag active withtag [rulerMkTab $c $x $y]
  90.     $c addtag tab withtag active
  91.     set v(x) $x
  92.     set v(y) $y
  93.     rulerMoveTab $c $x $y
  94. }
  95.  
  96. # rulerSelectTab --
  97. # This procedure is invoked when mouse button 1 is pressed over
  98. # a tab.  It remembers information about the tab so that it can
  99. # be dragged interactively.
  100. #
  101. # Arguments:
  102. # c -        The canvas widget.
  103. # x, y -    The coordinates of the mouse (identifies the point by
  104. #        which the tab was picked up for dragging).
  105.  
  106. proc rulerSelectTab {c x y} {
  107.     upvar #0 demo_rulerInfo v
  108.     set v(x) [$c canvasx $x $v(grid)]
  109.     set v(y) [expr $v(top)+2]
  110.     $c addtag active withtag current
  111.     eval "$c itemconf active $v(activeStyle)"
  112.     $c raise active
  113. }
  114.  
  115. # rulerMoveTab --
  116. # This procedure is invoked during mouse motion events to drag a tab.
  117. # It adjusts the position of the tab, and changes its appearance if
  118. # it is about to be dragged out of the ruler.
  119. #
  120. # Arguments:
  121. # c -        The canvas widget.
  122. # x, y -    The coordinates of the mouse.
  123.  
  124. proc rulerMoveTab {c x y} {
  125.     upvar #0 demo_rulerInfo v
  126.     if {[$c find withtag active] == ""} {
  127.     return
  128.     }
  129.     set cx [$c canvasx $x $v(grid)]
  130.     set cy [$c canvasy $y]
  131.     if {$cx < $v(left)} {
  132.     set cx $v(left)
  133.     }
  134.     if {$cx > $v(right)} {
  135.     set cx $v(right)
  136.     }
  137.     if {($cy >= $v(top)) && ($cy <= $v(bottom))} {
  138.     set cy [expr $v(top)+2]
  139.     eval "$c itemconf active $v(activeStyle)"
  140.     } else {
  141.     set cy [expr $cy-$v(size)-2]
  142.     eval "$c itemconf active $v(deleteStyle)"
  143.     }
  144.     $c move active [expr $cx-$v(x)] [expr $cy-$v(y)]
  145.     set v(x) $cx
  146.     set v(y) $cy
  147. }
  148.  
  149. # rulerReleaseTab --
  150. # This procedure is invoked during button release events that end
  151. # a tab drag operation.  It deselects the tab and deletes the tab if
  152. # it was dragged out of the ruler.
  153. #
  154. # Arguments:
  155. # c -        The canvas widget.
  156. # x, y -    The coordinates of the mouse.
  157.  
  158. proc rulerReleaseTab c {
  159.     upvar #0 demo_rulerInfo v
  160.     if {[$c find withtag active] == {}} {
  161.     return
  162.     }
  163.     if {$v(y) != [expr $v(top)+2]} {
  164.     $c delete active
  165.     } else {
  166.     eval "$c itemconf active $v(normalStyle)"
  167.     $c dtag active
  168.     }
  169. }
  170.