home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 June / PCWorld_2005-06_cd.bin / software / vyzkuste / firewally / firewally.exe / framework-2.3.exe / scale.tcl < prev    next >
Text File  |  2003-09-01  |  8KB  |  275 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.9 2002/02/26 01:07:08 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 tk::Priv(activeBg) [%W cget -activebackground]
  24.     %W config -activebackground [%W cget -background]
  25.     }
  26.     tk::ScaleActivate %W %x %y
  27. }
  28. bind Scale <Motion> {
  29.     tk::ScaleActivate %W %x %y
  30. }
  31. bind Scale <Leave> {
  32.     if {$tk_strictMotif} {
  33.     %W config -activebackground $tk::Priv(activeBg)
  34.     }
  35.     if {[string equal [%W cget -state] "active"]} {
  36.     %W configure -state normal
  37.     }
  38. }
  39. bind Scale <1> {
  40.     tk::ScaleButtonDown %W %x %y
  41. }
  42. bind Scale <B1-Motion> {
  43.     tk::ScaleDrag %W %x %y
  44. }
  45. bind Scale <B1-Leave> { }
  46. bind Scale <B1-Enter> { }
  47. bind Scale <ButtonRelease-1> {
  48.     tk::CancelRepeat
  49.     tk::ScaleEndDrag %W
  50.     tk::ScaleActivate %W %x %y
  51. }
  52. bind Scale <2> {
  53.     tk::ScaleButton2Down %W %x %y
  54. }
  55. bind Scale <B2-Motion> {
  56.     tk::ScaleDrag %W %x %y
  57. }
  58. bind Scale <B2-Leave> { }
  59. bind Scale <B2-Enter> { }
  60. bind Scale <ButtonRelease-2> {
  61.     tk::CancelRepeat
  62.     tk::ScaleEndDrag %W
  63.     tk::ScaleActivate %W %x %y
  64. }
  65. if {[string equal $tcl_platform(platform) "windows"]} {
  66.     # On Windows do the same with button 3, as that is the right mouse button
  67.     bind Scale <3>        [bind Scale <2>]
  68.     bind Scale <B3-Motion>    [bind Scale <B2-Motion>]
  69.     bind Scale <B3-Leave>    [bind Scale <B2-Leave>]
  70.     bind Scale <B3-Enter>    [bind Scale <B2-Enter>]
  71.     bind Scale <ButtonRelease-3> [bind Scale <ButtonRelease-2>]
  72. }
  73. bind Scale <Control-1> {
  74.     tk::ScaleControlPress %W %x %y
  75. }
  76. bind Scale <Up> {
  77.     tk::ScaleIncrement %W up little noRepeat
  78. }
  79. bind Scale <Down> {
  80.     tk::ScaleIncrement %W down little noRepeat
  81. }
  82. bind Scale <Left> {
  83.     tk::ScaleIncrement %W up little noRepeat
  84. }
  85. bind Scale <Right> {
  86.     tk::ScaleIncrement %W down little noRepeat
  87. }
  88. bind Scale <Control-Up> {
  89.     tk::ScaleIncrement %W up big noRepeat
  90. }
  91. bind Scale <Control-Down> {
  92.     tk::ScaleIncrement %W down big noRepeat
  93. }
  94. bind Scale <Control-Left> {
  95.     tk::ScaleIncrement %W up big noRepeat
  96. }
  97. bind Scale <Control-Right> {
  98.     tk::ScaleIncrement %W down big noRepeat
  99. }
  100. bind Scale <Home> {
  101.     %W set [%W cget -from]
  102. }
  103. bind Scale <End> {
  104.     %W set [%W cget -to]
  105. }
  106.  
  107. # ::tk::ScaleActivate --
  108. # This procedure is invoked to check a given x-y position in the
  109. # scale and activate the slider if the x-y position falls within
  110. # the slider.
  111. #
  112. # Arguments:
  113. # w -        The scale widget.
  114. # x, y -    Mouse coordinates.
  115.  
  116. proc ::tk::ScaleActivate {w x y} {
  117.     if {[string equal [$w cget -state] "disabled"]} {
  118.     return
  119.     }
  120.     if {[string equal [$w identify $x $y] "slider"]} {
  121.     set state active
  122.     } else {
  123.     set state normal
  124.     }
  125.     if {[string compare [$w cget -state] $state]} {
  126.     $w configure -state $state
  127.     }
  128. }
  129.  
  130. # ::tk::ScaleButtonDown --
  131. # This procedure is invoked when a button is pressed in a scale.  It
  132. # takes different actions depending on where the button was pressed.
  133. #
  134. # Arguments:
  135. # w -        The scale widget.
  136. # x, y -    Mouse coordinates of button press.
  137.  
  138. proc ::tk::ScaleButtonDown {w x y} {
  139.     variable ::tk::Priv
  140.     set Priv(dragging) 0
  141.     set el [$w identify $x $y]
  142.     if {[string equal $el "trough1"]} {
  143.     ScaleIncrement $w up little initial
  144.     } elseif {[string equal $el "trough2"]} {
  145.     ScaleIncrement $w down little initial
  146.     } elseif {[string equal $el "slider"]} {
  147.     set Priv(dragging) 1
  148.     set Priv(initValue) [$w get]
  149.     set coords [$w coords]
  150.     set Priv(deltaX) [expr {$x - [lindex $coords 0]}]
  151.     set Priv(deltaY) [expr {$y - [lindex $coords 1]}]
  152.     $w configure -sliderrelief sunken
  153.     }
  154. }
  155.  
  156. # ::tk::ScaleDrag --
  157. # This procedure is called when the mouse is dragged with
  158. # mouse button 1 down.  If the drag started inside the slider
  159. # (i.e. the scale is active) then the scale's value is adjusted
  160. # to reflect the mouse's position.
  161. #
  162. # Arguments:
  163. # w -        The scale widget.
  164. # x, y -    Mouse coordinates.
  165.  
  166. proc ::tk::ScaleDrag {w x y} {
  167.     variable ::tk::Priv
  168.     if {!$Priv(dragging)} {
  169.     return
  170.     }
  171.     $w set [$w get [expr {$x-$Priv(deltaX)}] [expr {$y-$Priv(deltaY)}]]
  172. }
  173.  
  174. # ::tk::ScaleEndDrag --
  175. # This procedure is called to end an interactive drag of the
  176. # slider.  It just marks the drag as over.
  177. #
  178. # Arguments:
  179. # w -        The scale widget.
  180.  
  181. proc ::tk::ScaleEndDrag {w} {
  182.     variable ::tk::Priv
  183.     set Priv(dragging) 0
  184.     $w configure -sliderrelief raised
  185. }
  186.  
  187. # ::tk::ScaleIncrement --
  188. # This procedure is invoked to increment the value of a scale and
  189. # to set up auto-repeating of the action if that is desired.  The
  190. # way the value is incremented depends on the "dir" and "big"
  191. # arguments.
  192. #
  193. # Arguments:
  194. # w -        The scale widget.
  195. # dir -        "up" means move value towards -from, "down" means
  196. #        move towards -to.
  197. # big -        Size of increments: "big" or "little".
  198. # repeat -    Whether and how to auto-repeat the action:  "noRepeat"
  199. #        means don't auto-repeat, "initial" means this is the
  200. #        first action in an auto-repeat sequence, and "again"
  201. #        means this is the second repetition or later.
  202.  
  203. proc ::tk::ScaleIncrement {w dir big repeat} {
  204.     variable ::tk::Priv
  205.     if {![winfo exists $w]} return
  206.     if {[string equal $big "big"]} {
  207.     set inc [$w cget -bigincrement]
  208.     if {$inc == 0} {
  209.         set inc [expr {abs([$w cget -to] - [$w cget -from])/10.0}]
  210.     }
  211.     if {$inc < [$w cget -resolution]} {
  212.         set inc [$w cget -resolution]
  213.     }
  214.     } else {
  215.     set inc [$w cget -resolution]
  216.     }
  217.     if {([$w cget -from] > [$w cget -to]) ^ [string equal $dir "up"]} {
  218.     set inc [expr {-$inc}]
  219.     }
  220.     $w set [expr {[$w get] + $inc}]
  221.  
  222.     if {[string equal $repeat "again"]} {
  223.     set Priv(afterId) [after [$w cget -repeatinterval] \
  224.         [list tk::ScaleIncrement $w $dir $big again]]
  225.     } elseif {[string equal $repeat "initial"]} {
  226.     set delay [$w cget -repeatdelay]
  227.     if {$delay > 0} {
  228.         set Priv(afterId) [after $delay \
  229.             [list tk::ScaleIncrement $w $dir $big again]]
  230.     }
  231.     }
  232. }
  233.  
  234. # ::tk::ScaleControlPress --
  235. # This procedure handles button presses that are made with the Control
  236. # key down.  Depending on the mouse position, it adjusts the scale
  237. # value to one end of the range or the other.
  238. #
  239. # Arguments:
  240. # w -        The scale widget.
  241. # x, y -    Mouse coordinates where the button was pressed.
  242.  
  243. proc ::tk::ScaleControlPress {w x y} {
  244.     set el [$w identify $x $y]
  245.     if {[string equal $el "trough1"]} {
  246.     $w set [$w cget -from]
  247.     } elseif {[string equal $el "trough2"]} {
  248.     $w set [$w cget -to]
  249.     }
  250. }
  251.  
  252. # ::tk::ScaleButton2Down
  253. # This procedure is invoked when button 2 is pressed over a scale.
  254. # It sets the value to correspond to the mouse position and starts
  255. # a slider drag.
  256. #
  257. # Arguments:
  258. # w -        The scrollbar widget.
  259. # x, y -    Mouse coordinates within the widget.
  260.  
  261. proc ::tk::ScaleButton2Down {w x y} {
  262.     variable ::tk::Priv
  263.  
  264.     if {[string equal [$w cget -state] "disabled"]} {
  265.       return
  266.     }
  267.     $w configure -state active
  268.     $w set [$w get $x $y]
  269.     set Priv(dragging) 1
  270.     set Priv(initValue) [$w get]
  271.     set coords "$x $y"
  272.     set Priv(deltaX) 0
  273.     set Priv(deltaY) 0
  274. }
  275.