ttk::scale , a built-in Tk command, is a Ttk scale widget.
Warning! The API of this widget may change in the future.
ttk::scale existed in 8.5.0, but was first documented in 8.5.2.
EG: The following (half baked) code adds two options I needed for an application: -increment and -bigincrement. The default (hardcoded) behaviour of ttk::scale is to increment/decrement by one unit. This also allows for changing the direction in which the scale raises its value; just be sure that the -from option is larger than the -to option, and that -increment and -bigincrement options are negative values.
package require Tk 8.5
namespace eval ::nscale {
variable options
variable State
bind NScale <Destroy> {::nscale::Cleanup %W}
bind NScale <ButtonPress-1> {::nscale::Press %W %x %y}
bind NScale <B1-Motion> {::nscale::Drag %W %x %y}
bind NScale <ButtonRelease-1> {::nscale::Release %W %x %y}
bind NScale <ButtonPress-2> {::nscale::Jump %W %x %y}
bind NScale <B2-Motion> {::nscale::Drag %W %x %y}
bind NScale <ButtonRelease-2> {::nscale::Release %W %x %y}
bind NScale <ButtonPress-3> {::nscale::Jump %W %x %y}
bind NScale <B3-Motion> {::nscale::Drag %W %x %y}
bind NScale <ButtonRelease-3> {::nscale::Release %W %x %y}
bind NScale <Left> {
::nscale::Increment %W [expr {[%W cget -increment] * -1}]}
bind NScale <Up> {
::nscale::Increment %W [expr {[%W cget -increment] * -1}]}
bind NScale <Right> {::nscale::Increment %W [%W cget -increment]}
bind NScale <Down> {::nscale::Increment %W [%W cget -increment]}
bind NScale <Control-Left> {
::nscale::Increment %W [expr {[%W cget -bigincrement] * -1}]}
bind NScale <Control-Up> {
::nscale::Increment %W [expr {[%W cget -bigincrement] * -1}]}
bind NScale <Control-Right> {
::nscale::Increment %W [%W cget -bigincrement]}
bind NScale <Control-Down> {
::nscale::Increment %W [%W cget -bigincrement]}
bind NScale <Home> { %W set [%W cget -from] }
bind NScale <End> { %W set [%W cget -to] }
}
proc ::nscale::scale {w args} {
variable options
ttk::scale $w {*}[dict remove $args -increment -bigincrement -class] \
-class NScale
foreach opt {-increment -bigincrement} val {1 10} {
if {[dict exists $args $opt]} {
dict set options $w $opt [dict get $args $opt]
} else {
dict set options $w $opt $val
}
}
bindtags $w [list $w NScale [winfo toplevel $w] all]
rename ::$w [namespace current]::$w
interp alias {} ::$w {} ::nscale::Dispatch $w
return $w
}
proc ::nscale::Dispatch {w method args} {
switch -- $method {
cg - cge -
cget {
return [Cget $w {*}$args]
}
co - con - conf - confi - config - configu - configur -
configure {
return [Configure $w {*}$args]
}
default {
return [$w $method {*}$args]
}
}
}
proc ::nscale::Cget {w args} {
variable options
if {[llength $args] != 1} {
return -code error -level 2 "wrong # args: should be \"$w\" cget option"
}
set option [lindex $args 0]
if {$option ni {-increment -bigincrement}} {
# the real widget is in our namespace
return [$w cget $option]
}
return [dict get $options $w $option]
}
proc ::nscale::Configure {w args} {
variable options
switch -- [llength $args] {
0 {
set res [$w configure]
lappend res [list -increment [dict get $options $w -increment]]
lappend res [list -bigincrement [dict get $options $w -bigincrement]]
return $res
}
1 {
set opt [lindex $args 0]
if {$opt in {-increment -bigincrement}} {
return [dict get $options $w $opt]
}
return [$w configure $opt]
}
default {
if {[llength $args] & 1} {
return -code error -level 2 "wrong # args: should be \"$w\"\
configure option ?value? ?option value?"
}
foreach {k v} $args {
if {$k in {-increment -bigincrement}} {
dict set options $w $k $v
} else {
$w configure $k $v
}
}
}
}
}
proc ::nscale::Cleanup {w} {
variable options
rename ::$w {}
dict unset options $w
}
proc ::nscale::Press {w x y} {
variable State
set State(dragging) 0
switch -glob -- [$w identify $x $y] {
*track -
*trough {
set inc [::$w cget -increment]
set inc [expr {
((([$w get $x $y] - [$w get]) * $inc) < 0) ?
-1 * $inc : $inc
}]
ttk::Repeatedly Increment $w $inc
}
*slider {
set State(dragging) 1
set State(initial) [$w get]
}
}
}
proc ::nscale::Jump {w x y} {
variable State
set State(dragging) 0
switch -glob -- [$w identify $x $y] {
*track -
*trough {
$w set [Adjust $w [$w get $x $y]]
set State(dragging) 1
set State(initial) [$w get]
}
*slider {
Press $w $x $y
}
}
}
proc ::nscale::Drag {w x y} {
variable State
if {$State(dragging)} {
$w set [Adjust $w [$w get $x $y]]
}
}
proc ::nscale::Release {w x y} {
variable State
set State(dragging) 0
ttk::CancelRepeat
}
proc ::nscale::Increment {w delta} {
if {![winfo exists $w]} return
$w set [expr {[$w get] + $delta}]
}
proc ::nscale::Adjust {w value} {
set f [$w cget -from]
set i [::$w cget -increment]
return [expr {$f + int(($value - $f) / $i) * $i}]
}
MHo 2013-02-08: Just realized that changing the -value of a ttk::scale widget doesn't trigger its -command callback. It only updates the widget itself, which is IMHO no good behaviour?
MG: If you want to trigger the callback, use
$widget set $value
instead of
$widget config -value $value
MHo: Yes, I already changed my code according to this. And I what I really ment above was "...that chaning the value of a -variable varname...", but the effect is the same...
MG: thinks it's deliberate (and desirable). The callback is generally used to perform an action when the user does something with the widget, but by altering the -value option directly you can make programmatic changes (for instance, in response to something the user does in another widget) without the risk of one triggering the callback of a second, which could trigger the callback of the first, and so on.
MHo 2016-11-13: What are the default bindings for the widget? If I use -takefocus 1, and the widget has the focus, cursor left jumps to the minimum value, and cursor right jumps to the maximum. I expected that this decrements or increments the value according to an amount, which isn't configurable (something like -step). So, the scale is only usable with a mouse.