blob: 2a5cf2e301b8abd4c08502ce015555c6f896c173 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
|
# scale.tcl - Copyright (C) 2004 Pat Thoyts <patthoyts@users.sourceforge.net>
#
# Bindings for the TScale widget
#
# $Id: scale.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $
namespace eval ttk::scale {
variable State
array set State {
dragging 0
}
}
bind TScale <ButtonPress-1> { ttk::scale::Press %W %x %y }
bind TScale <B1-Motion> { ttk::scale::Drag %W %x %y }
bind TScale <ButtonRelease-1> { ttk::scale::Release %W %x %y }
proc ttk::scale::Press {w x y} {
variable State
set State(dragging) 0
switch -glob -- [$w identify $x $y] {
*track -
*trough {
if {[$w get $x $y] <= [$w get]} {
ttk::Repeatedly Increment $w -1
} else {
ttk::Repeatedly Increment $w 1
}
}
*slider {
set State(dragging) 1
set State(initial) [$w get]
}
}
}
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
$w set [expr {[$w get] + $delta}]
}
|