scrollbar.tcl 3.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126
  1. #
  2. # Bindings for TScrollbar widget
  3. #
  4. namespace eval ttk::scrollbar {
  5. variable State
  6. # State(xPress) --
  7. # State(yPress) -- initial position of mouse at start of drag.
  8. # State(first) -- value of -first at start of drag.
  9. }
  10. bind TScrollbar <Button-1> { ttk::scrollbar::Press %W %x %y }
  11. bind TScrollbar <B1-Motion> { ttk::scrollbar::Drag %W %x %y }
  12. bind TScrollbar <ButtonRelease-1> { ttk::scrollbar::Release %W %x %y }
  13. bind TScrollbar <Button-2> { ttk::scrollbar::Jump %W %x %y }
  14. bind TScrollbar <B2-Motion> { ttk::scrollbar::Drag %W %x %y }
  15. bind TScrollbar <ButtonRelease-2> { ttk::scrollbar::Release %W %x %y }
  16. # Redirect scrollwheel bindings to the scrollbar widget
  17. #
  18. # The shift-bindings scroll left/right (not up/down)
  19. # if a widget has both possibilities
  20. set eventList [list <MouseWheel> <Shift-MouseWheel>]
  21. switch [tk windowingsystem] {
  22. aqua {
  23. lappend eventList <Option-MouseWheel> <Shift-Option-MouseWheel>
  24. }
  25. x11 {
  26. lappend eventList <Button-4> <Button-5> \
  27. <Shift-Button-4> <Shift-Button-5>
  28. }
  29. }
  30. foreach event $eventList {
  31. bind TScrollbar $event [bind Scrollbar $event]
  32. }
  33. unset eventList event
  34. proc ttk::scrollbar::Scroll {w n units} {
  35. set cmd [$w cget -command]
  36. if {$cmd ne ""} {
  37. uplevel #0 $cmd scroll $n $units
  38. }
  39. }
  40. proc ttk::scrollbar::Moveto {w fraction} {
  41. set cmd [$w cget -command]
  42. if {$cmd ne ""} {
  43. uplevel #0 $cmd moveto $fraction
  44. }
  45. }
  46. proc ttk::scrollbar::Press {w x y} {
  47. variable State
  48. set State(xPress) $x
  49. set State(yPress) $y
  50. switch -glob -- [$w identify $x $y] {
  51. *uparrow -
  52. *leftarrow {
  53. ttk::Repeatedly Scroll $w -1 units
  54. }
  55. *downarrow -
  56. *rightarrow {
  57. ttk::Repeatedly Scroll $w 1 units
  58. }
  59. *grip -
  60. *thumb {
  61. set State(first) [lindex [$w get] 0]
  62. }
  63. *trough {
  64. set f [$w fraction $x $y]
  65. if {$f < [lindex [$w get] 0]} {
  66. # Clicked in upper/left trough
  67. ttk::Repeatedly Scroll $w -1 pages
  68. } elseif {$f > [lindex [$w get] 1]} {
  69. # Clicked in lower/right trough
  70. ttk::Repeatedly Scroll $w 1 pages
  71. } else {
  72. # Clicked on thumb (???)
  73. set State(first) [lindex [$w get] 0]
  74. }
  75. }
  76. }
  77. }
  78. proc ttk::scrollbar::Drag {w x y} {
  79. variable State
  80. if {![info exists State(first)]} {
  81. # Initial buttonpress was not on the thumb,
  82. # or something screwy has happened. In either case, ignore:
  83. return;
  84. }
  85. set xDelta [expr {$x - $State(xPress)}]
  86. set yDelta [expr {$y - $State(yPress)}]
  87. Moveto $w [expr {$State(first) + [$w delta $xDelta $yDelta]}]
  88. }
  89. proc ttk::scrollbar::Release {w x y} {
  90. variable State
  91. unset -nocomplain State(xPress) State(yPress) State(first)
  92. ttk::CancelRepeat
  93. }
  94. # scrollbar::Jump -- Button-2 binding for scrollbars.
  95. # Behaves exactly like scrollbar::Press, except that
  96. # clicking in the trough jumps to the the selected position.
  97. #
  98. proc ttk::scrollbar::Jump {w x y} {
  99. variable State
  100. switch -glob -- [$w identify $x $y] {
  101. *grip -
  102. *thumb -
  103. *trough {
  104. set State(first) [$w fraction $x $y]
  105. Moveto $w $State(first)
  106. set State(xPress) $x
  107. set State(yPress) $y
  108. }
  109. default {
  110. Press $w $x $y
  111. }
  112. }
  113. }