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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
|
# $Id: arrowbut.tcl,v 2.6 2002/05/30 17:13:10 jfontain Exp $
class arrowButton {}
proc arrowButton::arrowButton {this parentPath args} composite {
[new canvas $parentPath\
-relief $widget::option(button,relief) -background $widget::option(button,background)\
-borderwidth $widget::option(button,borderwidth) -height $widget::option(scrollbar,width)\
-highlightbackground $widget::option(button,highlightbackground) -highlightcolor $widget::option(button,highlightcolor)\
-highlightthickness $widget::option(button,highlightthickness) -width $widget::option(scrollbar,width)\
] $args
} {
set ($this,triangle) [$widget::($this,path) create polygon 0 0 0 0 0 0]
bind $widget::($this,path) <Configure> "arrowButton::redraw $this %w %h"
set ($this,active) 0
composite::complete $this
}
proc arrowButton::~arrowButton {this} {}
proc arrowButton::options {this} {
# force initialization on direction, on state to initialize foreground color
# force takefocus initialization to initialize key bindings
return [list\
[list -activebackground $widget::option(button,activebackground) $widget::option(button,activebackground)]\
[list -background $widget::option(button,background) $widget::option(button,background)]\
[list -borderwidth $widget::option(button,borderwidth) $widget::option(button,borderwidth)]\
[list -command {} {}]\
[list -direction down]\
[list -disabledforeground $widget::option(button,disabledforeground) $widget::option(button,disabledforeground)]\
[list -foreground $widget::option(button,foreground) $widget::option(button,foreground)]\
[list -height $widget::option(scrollbar,width) $widget::option(scrollbar,width)]\
[list -highlightbackground $widget::option(button,highlightbackground) $widget::option(button,highlightbackground)]\
[list -highlightcolor $widget::option(button,highlightcolor) $widget::option(button,highlightcolor)]\
[list -highlightthickness $widget::option(button,highlightthickness) $widget::option(button,highlightthickness)]\
[list -repeatdelay 0 0]\
[list -state normal]\
[list -takefocus 1]\
[list -width $widget::option(scrollbar,width) $widget::option(scrollbar,width)]\
]
}
# nothing to do since value is automatically taken into account in binding sequence
proc arrowButton::set-activebackground {this value} {}
proc arrowButton::set-state {this value} {
set path $widget::($this,path)
switch $value {
normal {
$path itemconfigure $($this,triangle) -fill $composite::($this,-foreground) -outline $composite::($this,-foreground)
bind $path <Enter> "arrowButton::activate $this"
bind $path <Leave> "arrowButton::deactivate $this; arrowButton::raise $this"
bind $path <ButtonPress-1>\
"set arrowButton::($this,buttonPressed) 1; arrowButton::sink $this; arrowButton::startTimer $this"
bind $path <ButtonRelease-1>\
"arrowButton::raise $this; arrowButton::invoke $this 0; set arrowButton::($this,buttonPressed) 0"
if {$composite::($this,-takefocus)} {
bind $path <KeyPress-space> "arrowButton::sink $this"
bind $path <KeyRelease-space> "arrowButton::raise $this; arrowButton::invoke $this 1"
} else {
bind $path <KeyPress-space> {}
bind $path <KeyRelease-space> {}
}
}
disabled {
$path itemconfigure $($this,triangle)\
-fill $composite::($this,-disabledforeground) -outline $composite::($this,-disabledforeground)
bind $path <Enter> {}
bind $path <Leave> {}
bind $path <ButtonPress-1> {}
bind $path <ButtonRelease-1> {}
bind $path <KeyPress-space> {}
bind $path <KeyRelease-space> {}
}
default {
error "bad state value \"$value\": must be normal or disabled"
}
}
}
foreach option {-background -borderwidth -height -highlightbackground -highlightcolor -highlightthickness -width} {
proc arrowButton::set$option {this value} "\$widget::(\$this,path) configure $option \$value"
}
foreach option {-disabledforeground -foreground} { ;# state option automatically updates foreground colors
proc arrowButton::set$option {this value} {set-state $this $composite::($this,-state)}
}
proc arrowButton::set-command {this value} {} ;# do nothing, command is stored at the composite level
proc arrowButton::set-direction {this value} { ;# valid directions are down, up, left or right or any abbreviation
if {\
([string first $value down]!=0)&&([string first $value up]!=0)&&\
([string first $value left]!=0)&&([string first $value right]!=0)\
} {
error "bad direction value \"$value\": must be down, up, left or right (or any abbreviation)"
}
redraw $this [winfo width $widget::($this,path)] [winfo height $widget::($this,path)]
}
proc arrowButton::set-takefocus {this value} {
if {![regexp {^(0|1)$} $value]} {
error "bad takefocus value \"$value\": must be 0 or 1"
}
$widget::($this,path) configure -takefocus $value
set-state $this $composite::($this,-state)
}
proc arrowButton::set-repeatdelay {this value} {} ;# do nothing, delay is stored at the composite level
proc arrowButton::redraw {this width height} {
# in all cases, make sure largest dimension is even for best shaping
set insideWidth [expr {$width-2*($composite::($this,-borderwidth)+$composite::($this,-highlightthickness))}]
set insideHeight [expr {$height-2*($composite::($this,-borderwidth)+$composite::($this,-highlightthickness))}]
switch -glob $composite::($this,-direction) {
d* {
set insideWidth [maximum [expr {$insideWidth/4}] 1]
$widget::($this,path) coords $($this,triangle) 0 0 [expr {2*$insideWidth}] 0 $insideWidth $insideWidth
}
u* {
set insideWidth [maximum [expr {$insideWidth/4}] 1]
$widget::($this,path) coords $($this,triangle) 0 0 [expr {2*$insideWidth}] 0 $insideWidth -$insideWidth
}
l* {
set insideHeight [maximum [expr {$insideHeight/4}] 1]
$widget::($this,path) coords $($this,triangle) 0 0 0 [expr {2*$insideHeight}] -$insideHeight $insideHeight
}
r* {
set insideHeight [maximum [expr {$insideHeight/4}] 1]
$widget::($this,path) coords $($this,triangle) 0 0 0 [expr {2*$insideHeight}] $insideHeight $insideHeight
}
}
centerTriangle $this $width $height
}
proc arrowButton::centerTriangle {this width height} {
set box [$widget::($this,path) bbox $($this,triangle)]
$widget::($this,path) move $($this,triangle)\
[expr {($width-[lindex $box 2]-[lindex $box 0])/2}] [expr {($height-[lindex $box 3]-[lindex $box 1])/2}]
}
proc arrowButton::activate {this} {
$widget::($this,path) configure -background $composite::($this,-activebackground)
set ($this,active) 1
}
proc arrowButton::deactivate {this} {
$widget::($this,path) configure -background $composite::($this,-background)
set ($this,active) 0
}
proc arrowButton::sink {this} { ;# public procedure for forcing button to sunk state
set path $widget::($this,path)
$path configure -relief sunken
centerTriangle $this [winfo width $path] [winfo height $path] ;# eventually recenter triangle
$path move $($this,triangle) 1 1 ;# and move it slightly to achieve a 3D effect
}
proc arrowButton::raise {this} { ;# public procedure for forcing button to raised state
set path $widget::($this,path)
$path configure -relief raised
centerTriangle $this [winfo width $path] [winfo height $path] ;# recenter triangle
if {[info exists ($this,event)]} {
after cancel $($this,event)
unset ($this,event)
}
}
proc arrowButton::invoke {this fromKey} {
if {([string length $composite::($this,-command)]>0)&&($($this,active)||$fromKey)} {
uplevel #0 $composite::($this,-command) ;# always invoke command at global level as tk buttons do
}
}
proc arrowButton::startTimer {this} {
if {$composite::($this,-repeatdelay)>0} {
set ($this,event) [after $composite::($this,-repeatdelay) "arrowButton::processTimer $this"]
}
}
proc arrowButton::processTimer {this} {
if {$($this,buttonPressed)} {
startTimer $this
invoke $this 0
} else {
unset ($this,event)
}
}
proc arrowButton::maximum {a b} {return [expr {$a>$b?$a:$b}]}
|
