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