# scale.tcl - Copyright (C) 2004 Pat Thoyts # # Bindings for the TScale widget namespace eval ttk::scale { variable State array set State { dragging 0 } } bind TScale { ttk::scale::Press %W %x %y } bind TScale { ttk::scale::Drag %W %x %y } bind TScale { ttk::scale::Release %W %x %y } bind TScale { ttk::scale::Jump %W %x %y } bind TScale { ttk::scale::Drag %W %x %y } bind TScale { ttk::scale::Release %W %x %y } bind TScale { ttk::scale::Jump %W %x %y } bind TScale { ttk::scale::Drag %W %x %y } bind TScale { ttk::scale::Release %W %x %y } ## Keyboard navigation bindings: # bind TScale <> { %W set [%W cget -from] } bind TScale <> { %W set [%W cget -to] } bind TScale <> { ttk::scale::Increment %W -1 } bind TScale <> { ttk::scale::Increment %W -1 } bind TScale <> { ttk::scale::Increment %W 1 } bind TScale <> { ttk::scale::Increment %W 1 } bind TScale <> { ttk::scale::Increment %W -10 } bind TScale <> { ttk::scale::Increment %W -10 } bind TScale <> { ttk::scale::Increment %W 10 } bind TScale <> { ttk::scale::Increment %W 10 } proc ttk::scale::Press {w x y} { variable State set State(dragging) 0 switch -glob -- [$w identify $x $y] { *track - *trough { set inc [expr {([$w get $x $y] <= [$w get]) ^ ([$w cget -from] > [$w cget -to]) ? -1 : 1}] ttk::Repeatedly Increment $w $inc } *slider { set State(dragging) 1 set State(initial) [$w get] } } } # scale::Jump -- Button-2/3 binding for scale acts like # Press except that clicking in the trough jumps to the # clicked position. proc ttk::scale::Jump {w x y} { variable State set State(dragging) 0 switch -glob -- [$w identify $x $y] { *track - *trough { $w set [$w get $x $y] set State(dragging) 1 set State(initial) [$w get] } *slider { Press $w $x $y } } } proc ttk::scale::Drag {w x y} { variable State if {$State(dragging)} { $w set [$w get $x $y] } } proc ttk::scale::Release {w x y} { variable State set State(dragging) 0 ttk::CancelRepeat } proc ttk::scale::Increment {w delta} { if {![winfo exists $w]} return if {([$w cget -from] > [$w cget -to])} { set delta [expr {-$delta}] } $w set [expr {[$w get] + $delta}] }