ttk::scale

ttk::scale , a built-in Tk command, is a Ttk scale widget.

Documentation

official reference

Description

Warning! The API of this widget may change in the future.

History

ttk::scale existed in 8.5.0, but was first documented in 8.5.2.

Discussion

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.

See Also

HoppingSlider
a snit sidgetadaptor that adds -resolution to ttk::scale