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 / lib / tk8.3 / scale.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  6.9 KB  |  267 lines
  1. # scale.tcl --
  2. #
  3. # This file defines the default bindings for Tk scale widgets and provides
  4. # procedures that help in implementing the bindings.
  5. #
  6. # RCS: @(#) $Id: scale.tcl,v 1.7 2000/04/14 08:33:31 hobbs Exp $
  7. #
  8. # Copyright (c) 1994 The Regents of the University of California.
  9. # Copyright (c) 1994-1995 Sun Microsystems, Inc.
  10. #
  11. # See the file "license.terms" for information on usage and redistribution
  12. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13. #
  14.  
  15. #-------------------------------------------------------------------------
  16. # The code below creates the default class bindings for entries.
  17. #-------------------------------------------------------------------------
  18.  
  19. # Standard Motif bindings:
  20.  
  21. bind Scale <Enter> {
  22.     if {$tk_strictMotif} {
  23.     set tkPriv(activeBg) [%W cget -activebackground]
  24.     %W config -activebackground [%W cget -background]
  25.     }
  26.     tkScaleActivate %W %x %y
  27. }
  28. bind Scale <Motion> {
  29.     tkScaleActivate %W %x %y
  30. }
  31. bind Scale <Leave> {
  32.     if {$tk_strictMotif} {
  33.     %W config -activebackground $tkPriv(activeBg)
  34.     }
  35.     if {[string equal [%W cget -state] "active"]} {
  36.     %W configure -state normal
  37.     }
  38. }
  39. bind Scale <1> {
  40.     tkScaleButtonDown %W %x %y
  41. }
  42. bind Scale <B1-Motion> {
  43.     tkScaleDrag %W %x %y
  44. }
  45. bind Scale <B1-Leave> { }
  46. bind Scale <B1-Enter> { }
  47. bind Scale <ButtonRelease-1> {
  48.     tkCancelRepeat
  49.     tkScaleEndDrag %W
  50.     tkScaleActivate %W %x %y
  51. }
  52. bind Scale <2> {
  53.     tkScaleButton2Down %W %x %y
  54. }
  55. bind Scale <B2-Motion> {
  56.     tkScaleDrag %W %x %y
  57. }
  58. bind Scale <B2-Leave> { }
  59. bind Scale <B2-Enter> { }
  60. bind Scale <ButtonRelease-2> {
  61.     tkCancelRepeat
  62.     tkScaleEndDrag %W
  63.     tkScaleActivate %W %x %y
  64. }
  65. bind Scale <Control-1> {
  66.     tkScaleControlPress %W %x %y
  67. }
  68. bind Scale <Up> {
  69.     tkScaleIncrement %W up little noRepeat
  70. }
  71. bind Scale <Down> {
  72.     tkScaleIncrement %W down little noRepeat
  73. }
  74. bind Scale <Left> {
  75.     tkScaleIncrement %W up little noRepeat
  76. }
  77. bind Scale <Right> {
  78.     tkScaleIncrement %W down little noRepeat
  79. }
  80. bind Scale <Control-Up> {
  81.     tkScaleIncrement %W up big noRepeat
  82. }
  83. bind Scale <Control-Down> {
  84.     tkScaleIncrement %W down big noRepeat
  85. }
  86. bind Scale <Control-Left> {
  87.     tkScaleIncrement %W up big noRepeat
  88. }
  89. bind Scale <Control-Right> {
  90.     tkScaleIncrement %W down big noRepeat
  91. }
  92. bind Scale <Home> {
  93.     %W set [%W cget -from]
  94. }
  95. bind Scale <End> {
  96.     %W set [%W cget -to]
  97. }
  98.  
  99. # tkScaleActivate --
  100. # This procedure is invoked to check a given x-y position in the
  101. # scale and activate the slider if the x-y position falls within
  102. # the slider.
  103. #
  104. # Arguments:
  105. # w -        The scale widget.
  106. # x, y -    Mouse coordinates.
  107.  
  108. proc tkScaleActivate {w x y} {
  109.     if {[string equal [$w cget -state] "disabled"]} {
  110.     return
  111.     }
  112.     if {[string equal [$w identify $x $y] "slider"]} {
  113.     set state active
  114.     } else {
  115.     set state normal
  116.     }
  117.     if {[string compare [$w cget -state] $state]} {
  118.     $w configure -state $state
  119.     }
  120. }
  121.  
  122. # tkScaleButtonDown --
  123. # This procedure is invoked when a button is pressed in a scale.  It
  124. # takes different actions depending on where the button was pressed.
  125. #
  126. # Arguments:
  127. # w -        The scale widget.
  128. # x, y -    Mouse coordinates of button press.
  129.  
  130. proc tkScaleButtonDown {w x y} {
  131.     global tkPriv
  132.     set tkPriv(dragging) 0
  133.     set el [$w identify $x $y]
  134.     if {[string equal $el "trough1"]} {
  135.     tkScaleIncrement $w up little initial
  136.     } elseif {[string equal $el "trough2"]} {
  137.     tkScaleIncrement $w down little initial
  138.     } elseif {[string equal $el "slider"]} {
  139.     set tkPriv(dragging) 1
  140.     set tkPriv(initValue) [$w get]
  141.     set coords [$w coords]
  142.     set tkPriv(deltaX) [expr {$x - [lindex $coords 0]}]
  143.     set tkPriv(deltaY) [expr {$y - [lindex $coords 1]}]
  144.     $w configure -sliderrelief sunken
  145.     }
  146. }
  147.  
  148. # tkScaleDrag --
  149. # This procedure is called when the mouse is dragged with
  150. # mouse button 1 down.  If the drag started inside the slider
  151. # (i.e. the scale is active) then the scale's value is adjusted
  152. # to reflect the mouse's position.
  153. #
  154. # Arguments:
  155. # w -        The scale widget.
  156. # x, y -    Mouse coordinates.
  157.  
  158. proc tkScaleDrag {w x y} {
  159.     global tkPriv
  160.     if {!$tkPriv(dragging)} {
  161.     return
  162.     }
  163.     $w set [$w get [expr {$x-$tkPriv(deltaX)}] [expr {$y-$tkPriv(deltaY)}]]
  164. }
  165.  
  166. # tkScaleEndDrag --
  167. # This procedure is called to end an interactive drag of the
  168. # slider.  It just marks the drag as over.
  169. #
  170. # Arguments:
  171. # w -        The scale widget.
  172.  
  173. proc tkScaleEndDrag {w} {
  174.     global tkPriv
  175.     set tkPriv(dragging) 0
  176.     $w configure -sliderrelief raised
  177. }
  178.  
  179. # tkScaleIncrement --
  180. # This procedure is invoked to increment the value of a scale and
  181. # to set up auto-repeating of the action if that is desired.  The
  182. # way the value is incremented depends on the "dir" and "big"
  183. # arguments.
  184. #
  185. # Arguments:
  186. # w -        The scale widget.
  187. # dir -        "up" means move value towards -from, "down" means
  188. #        move towards -to.
  189. # big -        Size of increments: "big" or "little".
  190. # repeat -    Whether and how to auto-repeat the action:  "noRepeat"
  191. #        means don't auto-repeat, "initial" means this is the
  192. #        first action in an auto-repeat sequence, and "again"
  193. #        means this is the second repetition or later.
  194.  
  195. proc tkScaleIncrement {w dir big repeat} {
  196.     global tkPriv
  197.     if {![winfo exists $w]} return
  198.     if {[string equal $big "big"]} {
  199.     set inc [$w cget -bigincrement]
  200.     if {$inc == 0} {
  201.         set inc [expr {abs([$w cget -to] - [$w cget -from])/10.0}]
  202.     }
  203.     if {$inc < [$w cget -resolution]} {
  204.         set inc [$w cget -resolution]
  205.     }
  206.     } else {
  207.     set inc [$w cget -resolution]
  208.     }
  209.     if {([$w cget -from] > [$w cget -to]) ^ [string equal $dir "up"]} {
  210.     set inc [expr {-$inc}]
  211.     }
  212.     $w set [expr {[$w get] + $inc}]
  213.  
  214.     if {[string equal $repeat "again"]} {
  215.     set tkPriv(afterId) [after [$w cget -repeatinterval] \
  216.         [list tkScaleIncrement $w $dir $big again]]
  217.     } elseif {[string equal $repeat "initial"]} {
  218.     set delay [$w cget -repeatdelay]
  219.     if {$delay > 0} {
  220.         set tkPriv(afterId) [after $delay \
  221.             [list tkScaleIncrement $w $dir $big again]]
  222.     }
  223.     }
  224. }
  225.  
  226. # tkScaleControlPress --
  227. # This procedure handles button presses that are made with the Control
  228. # key down.  Depending on the mouse position, it adjusts the scale
  229. # value to one end of the range or the other.
  230. #
  231. # Arguments:
  232. # w -        The scale widget.
  233. # x, y -    Mouse coordinates where the button was pressed.
  234.  
  235. proc tkScaleControlPress {w x y} {
  236.     set el [$w identify $x $y]
  237.     if {[string equal $el "trough1"]} {
  238.     $w set [$w cget -from]
  239.     } elseif {[string equal $el "trough2"]} {
  240.     $w set [$w cget -to]
  241.     }
  242. }
  243.  
  244. # tkScaleButton2Down
  245. # This procedure is invoked when button 2 is pressed over a scale.
  246. # It sets the value to correspond to the mouse position and starts
  247. # a slider drag.
  248. #
  249. # Arguments:
  250. # w -        The scrollbar widget.
  251. # x, y -    Mouse coordinates within the widget.
  252.  
  253. proc tkScaleButton2Down {w x y} {
  254.     global tkPriv
  255.  
  256.     if {[string equal [$w cget -state] "disabled"]} {
  257.       return
  258.     }
  259.     $w configure -state active
  260.     $w set [$w get $x $y]
  261.     set tkPriv(dragging) 1
  262.     set tkPriv(initValue) [$w get]
  263.     set coords "$x $y"
  264.     set tkPriv(deltaX) 0
  265.     set tkPriv(deltaY) 0
  266. }
  267.