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