scrollbar.tcl 3.0 KB

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