author | Claus Gittinger <cg@exept.de> |
Tue, 04 Sep 2001 20:59:46 +0200 | |
changeset 1996 | 730a4217e20d |
parent 1985 | 1e21a6928dfb |
child 2495 | 10881807c918 |
permissions | -rw-r--r-- |
0 | 1 |
" |
4 | 2 |
COPYRIGHT (c) 1992 by Claus Gittinger |
24 | 3 |
All Rights Reserved |
0 | 4 |
|
5 |
This software is furnished under a license and may be used |
|
6 |
only in accordance with the terms of that license and with the |
|
7 |
inclusion of the above copyright notice. This software may not |
|
8 |
be provided or otherwise made available to, or used by, any |
|
9 |
other person. No title to or ownership of the software is |
|
10 |
hereby transferred. |
|
11 |
" |
|
12 |
||
1973 | 13 |
"{ Package: 'stx:libwidg2' }" |
14 |
||
0 | 15 |
Scroller subclass:#Slider |
137 | 16 |
instanceVariableNames:'sliderHeight' |
17 |
classVariableNames:'' |
|
18 |
poolDictionaries:'' |
|
19 |
category:'Views-Interactors' |
|
0 | 20 |
! |
21 |
||
11 | 22 |
!Slider class methodsFor:'documentation'! |
23 |
||
24 |
copyright |
|
25 |
" |
|
26 |
COPYRIGHT (c) 1992 by Claus Gittinger |
|
24 | 27 |
All Rights Reserved |
0 | 28 |
|
11 | 29 |
This software is furnished under a license and may be used |
30 |
only in accordance with the terms of that license and with the |
|
31 |
inclusion of the above copyright notice. This software may not |
|
32 |
be provided or otherwise made available to, or used by, any |
|
33 |
other person. No title to or ownership of the software is |
|
34 |
hereby transferred. |
|
35 |
" |
|
36 |
! |
|
0 | 37 |
|
11 | 38 |
documentation |
39 |
" |
|
40 |
this class implements sliders - which are simply scrollers |
|
49 | 41 |
with a constant thumbHeight. For details on actionBlocks and |
42 |
MVC operation, see the documentation in Scroller. |
|
155 | 43 |
|
44 |
[author:] |
|
45 |
Claus Gittinger |
|
11 | 46 |
" |
48 | 47 |
! |
48 |
||
49 |
examples |
|
50 |
" |
|
51 |
a slider with action block (ST/X style): |
|
159 | 52 |
[exBegin] |
53 |
|top s| |
|
48 | 54 |
|
159 | 55 |
top := StandardSystemView new extent:200@200. |
56 |
s := Slider in:top. |
|
1973 | 57 |
s origin:(0.0@0.0) corner:(15@1.0). |
184 | 58 |
s scrollAction:[:percent | Transcript show:'moved to: '; showCR:percent asFloat]. |
159 | 59 |
top open |
60 |
[exEnd] |
|
48 | 61 |
|
49 | 62 |
same, horizontal: |
159 | 63 |
[exBegin] |
64 |
|top s| |
|
49 | 65 |
|
159 | 66 |
top := StandardSystemView new extent:200@200. |
67 |
s := HorizontalSlider in:top. |
|
1973 | 68 |
s origin:(0.0@0.0) corner:(1.0@15). |
184 | 69 |
s scrollAction:[:percent | Transcript show:'moved to: '; showCR:percent asFloat]. |
159 | 70 |
top open |
71 |
[exEnd] |
|
49 | 72 |
|
73 |
with a range other than the default: |
|
159 | 74 |
[exBegin] |
75 |
|top s| |
|
49 | 76 |
|
159 | 77 |
top := StandardSystemView new extent:200@200. |
78 |
s := Slider in:top. |
|
79 |
s origin:(0.0@0.0) corner:(20@1.0). |
|
184 | 80 |
s scrollAction:[:percent | Transcript show:'moved to: '; showCR:percent asFloat]. |
159 | 81 |
s start:-50 stop:50. |
82 |
top open |
|
83 |
[exEnd] |
|
49 | 84 |
|
48 | 85 |
using a model (ST-80 style): |
49 | 86 |
(see the changing value in the inspector) |
159 | 87 |
[exBegin] |
88 |
|top s m| |
|
48 | 89 |
|
159 | 90 |
m := 0 asValue. |
91 |
m inspect. |
|
92 |
top := StandardSystemView new extent:200@200. |
|
93 |
s := Slider in:top. |
|
94 |
s origin:(0.0@0.0) corner:(20@1.0). |
|
95 |
s model:m. |
|
96 |
top open |
|
97 |
[exEnd] |
|
48 | 98 |
|
99 |
reacting to changes from the model: |
|
49 | 100 |
(look at and/or change value using 'self value:' in the inspector). |
159 | 101 |
[exBegin] |
102 |
|top s m| |
|
48 | 103 |
|
159 | 104 |
m := 0 asValue. |
105 |
m inspect. |
|
106 |
top := StandardSystemView new extent:200@200. |
|
107 |
s := Slider in:top. |
|
108 |
s origin:(0.0@0.0) corner:(20@1.0). |
|
109 |
s model:m. |
|
110 |
top open |
|
111 |
[exEnd] |
|
48 | 112 |
|
113 |
using a different changeSelector: |
|
159 | 114 |
[exBegin] |
115 |
|top s1 s2 m| |
|
48 | 116 |
|
159 | 117 |
m := Plug new. |
184 | 118 |
m respondTo:#value1: with:[:v | Transcript show:'scroller 1 moved to: '; showCR:v]. |
119 |
m respondTo:#value2: with:[:v | Transcript show:'scroller 2 moved to: '; showCR:v]. |
|
48 | 120 |
|
159 | 121 |
top := StandardSystemView new extent:200@200. |
122 |
s1 := Slider in:top. |
|
123 |
s1 origin:(0.0@0.0) corner:(20@1.0). |
|
124 |
s1 thumbHeight:10. 'percent'. |
|
125 |
s1 model:m; change:#value1:. |
|
48 | 126 |
|
159 | 127 |
s2 := Slider in:top. |
128 |
s2 origin:(30@0.0) corner:(50@1.0). |
|
129 |
s2 thumbHeight:10. 'percent'. |
|
130 |
s2 model:m; change:#value2:. |
|
131 |
top open |
|
132 |
[exEnd] |
|
62 | 133 |
|
134 |
another example: |
|
159 | 135 |
[exBegin] |
136 |
|top redVal greenVal blueVal |
|
137 |
colorVal upd s1 s2 s3 l| |
|
62 | 138 |
|
159 | 139 |
redVal := 0 asValue. |
140 |
greenVal := 0 asValue. |
|
141 |
blueVal := 0 asValue. |
|
62 | 142 |
|
159 | 143 |
upd := [colorVal value:(Color red:redVal value |
144 |
green:greenVal value |
|
145 |
blue:blueVal value)]. |
|
62 | 146 |
|
159 | 147 |
colorVal := (Color red:0 green:0 blue:0) asValue. |
148 |
colorVal onChangeSend:#value to:[l backgroundColor:colorVal value]. |
|
62 | 149 |
|
159 | 150 |
redVal onChangeSend:#value to:upd. |
151 |
greenVal onChangeSend:#value to:upd. |
|
152 |
blueVal onChangeSend:#value to:upd. |
|
62 | 153 |
|
159 | 154 |
top := StandardSystemView new extent:200@200. |
155 |
top label:'Color mixer'. |
|
62 | 156 |
|
159 | 157 |
s1 := Slider in:top. |
158 |
s1 origin:(0.0@0.0) corner:(20@1.0). |
|
159 |
s1 thumbHeight:10. 'percent'. |
|
160 |
s1 model:redVal. |
|
62 | 161 |
|
159 | 162 |
s2 := Slider in:top. |
163 |
s2 origin:(30@0.0) corner:(50@1.0). |
|
164 |
s2 thumbHeight:10. 'percent'. |
|
165 |
s2 model:greenVal. |
|
62 | 166 |
|
159 | 167 |
s3 := Slider in:top. |
168 |
s3 origin:(60@0.0) corner:(80@1.0). |
|
169 |
s3 thumbHeight:10. 'percent'. |
|
170 |
s3 model:blueVal. |
|
62 | 171 |
|
159 | 172 |
l := Label in:top. |
173 |
l origin:90@0.0 corner:1.0@1.0. |
|
174 |
l backgroundColor:Color black. |
|
62 | 175 |
|
159 | 176 |
top open |
177 |
[exEnd] |
|
62 | 178 |
|
179 |
the same setup, using action blocks: |
|
159 | 180 |
[exBegin] |
181 |
|top red green blue |
|
182 |
colorVal upd s1 s2 s3 labelModel l| |
|
62 | 183 |
|
159 | 184 |
red := green := blue := 0. |
62 | 185 |
|
159 | 186 |
top := StandardSystemView new extent:200@200. |
187 |
top label:'Color mixer'. |
|
62 | 188 |
|
159 | 189 |
s1 := Slider in:top. |
190 |
s1 origin:(0.0@0.0) corner:(20@1.0). |
|
191 |
s1 thumbHeight:10. 'percent'. |
|
192 |
s1 action:[:percent | red := percent. |
|
193 |
l backgroundColor:(Color red:red green:green blue:blue)]. |
|
62 | 194 |
|
159 | 195 |
s2 := Slider in:top. |
196 |
s2 origin:(30@0.0) corner:(50@1.0). |
|
197 |
s2 thumbHeight:10. 'percent'. |
|
198 |
s2 action:[:percent | green := percent. |
|
199 |
l backgroundColor:(Color red:red green:green blue:blue)]. |
|
62 | 200 |
|
159 | 201 |
s3 := Slider in:top. |
202 |
s3 origin:(60@0.0) corner:(80@1.0). |
|
203 |
s3 thumbHeight:10. 'percent'. |
|
204 |
s3 action:[:percent | blue := percent. |
|
205 |
l backgroundColor:(Color red:red green:green blue:blue)]. |
|
62 | 206 |
|
159 | 207 |
l := Label in:top. |
208 |
l origin:90@0.0 corner:1.0@1.0. |
|
209 |
l backgroundColor:Color black. |
|
62 | 210 |
|
159 | 211 |
top open |
212 |
[exEnd] |
|
48 | 213 |
" |
11 | 214 |
! ! |
0 | 215 |
|
1996 | 216 |
!Slider methodsFor:'Compatibility - VW'! |
288 | 217 |
|
218 |
beHorizontal |
|
219 |
"ST-80 compatibility: make the slider a horizontalSlider" |
|
220 |
||
221 |
sliderHeight := (self horizontalPixelPerMillimeter:10) rounded. |
|
222 |
orientation := #horizontal |
|
223 |
||
224 |
"Created: 27.1.1997 / 13:46:42 / cg" |
|
225 |
! |
|
226 |
||
227 |
beVertical |
|
228 |
"ST-80 compatibility: make the slider a verticalSlider" |
|
229 |
||
230 |
sliderHeight := (self verticalPixelPerMillimeter:10) rounded. |
|
231 |
orientation := #vertical |
|
232 |
||
233 |
"Created: 27.1.1997 / 13:47:07 / cg" |
|
234 |
! ! |
|
235 |
||
100 | 236 |
!Slider methodsFor:'accessing'! |
237 |
||
238 |
thumbHeight |
|
239 |
"redefined since a slider has no height - just origin" |
|
240 |
||
241 |
^ nil |
|
242 |
! ! |
|
0 | 243 |
|
870 | 244 |
!Slider methodsFor:'event handling'! |
245 |
||
1583
f5118b115b68
bugfix request focus on button press (to move slider with cursor keys)
ah
parents:
1576
diff
changeset
|
246 |
buttonPress:butt x:x y:y |
f5118b115b68
bugfix request focus on button press (to move slider with cursor keys)
ah
parents:
1576
diff
changeset
|
247 |
"" |
f5118b115b68
bugfix request focus on button press (to move slider with cursor keys)
ah
parents:
1576
diff
changeset
|
248 |
self requestFocus. |
f5118b115b68
bugfix request focus on button press (to move slider with cursor keys)
ah
parents:
1576
diff
changeset
|
249 |
super buttonPress:butt x:x y:y |
f5118b115b68
bugfix request focus on button press (to move slider with cursor keys)
ah
parents:
1576
diff
changeset
|
250 |
|
f5118b115b68
bugfix request focus on button press (to move slider with cursor keys)
ah
parents:
1576
diff
changeset
|
251 |
|
f5118b115b68
bugfix request focus on button press (to move slider with cursor keys)
ah
parents:
1576
diff
changeset
|
252 |
|
f5118b115b68
bugfix request focus on button press (to move slider with cursor keys)
ah
parents:
1576
diff
changeset
|
253 |
! |
f5118b115b68
bugfix request focus on button press (to move slider with cursor keys)
ah
parents:
1576
diff
changeset
|
254 |
|
870 | 255 |
keyPress:key x:x y:y |
1985
1e21a6928dfb
stc does not understand + and - in resources.
Stefan Vogel <sv@exept.de>
parents:
1983
diff
changeset
|
256 |
<resource: #keyboard (#CursorRight #CursorUp #CursorLeft #CursorDown)> |
1973 | 257 |
|
1197
bfccea7d6d80
use keyboardStep value if non-nil.
Claus Gittinger <cg@exept.de>
parents:
1098
diff
changeset
|
258 |
|step| |
1098 | 259 |
|
260 |
enabled ifFalse:[^ self]. |
|
261 |
||
1198 | 262 |
step := keyboardStep ? (rangeEnd - rangeStart / 10). |
263 |
||
1983
ee3be6ecc37a
Move left with cursor left and right with cursor right
Stefan Vogel <sv@exept.de>
parents:
1973
diff
changeset
|
264 |
(key == #CursorLeft |
870 | 265 |
or:[key == #CursorUp |
1983
ee3be6ecc37a
Move left with cursor left and right with cursor right
Stefan Vogel <sv@exept.de>
parents:
1973
diff
changeset
|
266 |
or:[key == $-]]) ifTrue:[ |
ee3be6ecc37a
Move left with cursor left and right with cursor right
Stefan Vogel <sv@exept.de>
parents:
1973
diff
changeset
|
267 |
self scrollStep:step negated. |
870 | 268 |
^ self |
269 |
]. |
|
270 |
||
1983
ee3be6ecc37a
Move left with cursor left and right with cursor right
Stefan Vogel <sv@exept.de>
parents:
1973
diff
changeset
|
271 |
(key == #CursorRight |
870 | 272 |
or:[key == #CursorDown |
1983
ee3be6ecc37a
Move left with cursor left and right with cursor right
Stefan Vogel <sv@exept.de>
parents:
1973
diff
changeset
|
273 |
or:[key == $+]]) ifTrue:[ |
ee3be6ecc37a
Move left with cursor left and right with cursor right
Stefan Vogel <sv@exept.de>
parents:
1973
diff
changeset
|
274 |
self scrollStep:step. |
870 | 275 |
^ self |
276 |
]. |
|
277 |
||
278 |
super keyPress:key x:x y:y |
|
279 |
! ! |
|
280 |
||
100 | 281 |
!Slider methodsFor:'forced scroll'! |
282 |
||
283 |
pageDown |
|
284 |
"ignored - a slider has no concept of page-wise scrolling" |
|
8 | 285 |
|
100 | 286 |
^ self |
287 |
! |
|
288 |
||
289 |
pageUp |
|
290 |
"ignored - a slider has no concept of page-wise scrolling" |
|
24 | 291 |
|
100 | 292 |
^ self |
293 |
! ! |
|
294 |
||
295 |
!Slider methodsFor:'initialization'! |
|
296 |
||
297 |
initStyle |
|
281 | 298 |
"initialize style specifics" |
299 |
||
559 | 300 |
<resource: #style (#'slider.NTallyMarks' #'slider.tallyLevel')> |
165 | 301 |
|
100 | 302 |
super initStyle. |
0 | 303 |
|
559 | 304 |
tallyMarks := StyleSheet at:'slider.NTallyMarks' default:1. |
305 |
tallyLevel := StyleSheet at:'slider.tallyLevel' default:-1. |
|
137 | 306 |
thumbActiveLevel := thumbLevel. |
307 |
||
888 | 308 |
"Modified: / 12.5.1998 / 21:01:43 / cg" |
49 | 309 |
! |
0 | 310 |
|
100 | 311 |
initialize |
312 |
sliderHeight := (self verticalPixelPerMillimeter:10) rounded. |
|
313 |
super initialize. |
|
314 |
thumbHeight := 0. |
|
315 |
! ! |
|
316 |
||
317 |
!Slider methodsFor:'private'! |
|
318 |
||
0 | 319 |
absFromPercent:percent |
320 |
"given a percentage, compute number of pixels" |
|
321 |
||
49 | 322 |
|fullSize| |
0 | 323 |
|
49 | 324 |
(orientation == #vertical) ifTrue:[ |
325 |
fullSize := height |
|
326 |
] ifFalse:[ |
|
327 |
fullSize := width |
|
328 |
]. |
|
329 |
^ ((percent * (fullSize - sliderHeight - (margin * 2))) / 100) rounded |
|
0 | 330 |
! |
331 |
||
332 |
computeThumbFrame |
|
333 |
"redefined, since the thumb-height stays constant" |
|
334 |
||
49 | 335 |
|nh nw ny nx sz m| |
0 | 336 |
|
337 |
thumbHeight := 0. |
|
49 | 338 |
sz := (self absFromPercent:thumbOrigin) + margin. |
339 |
m := margin + inset. |
|
340 |
(orientation == #vertical) ifTrue:[ |
|
341 |
ny := sz. |
|
342 |
nh := sliderHeight. |
|
343 |
nx := m. |
|
344 |
nw := width - (2 * nx). |
|
345 |
] ifFalse:[ |
|
346 |
nx := sz. |
|
347 |
nw := sliderHeight. |
|
348 |
ny := m. |
|
349 |
nh := height - (2 * ny). |
|
350 |
]. |
|
351 |
||
0 | 352 |
" |
353 |
do not create new Rectangle if its the same anyway |
|
354 |
" |
|
355 |
thumbFrame notNil ifTrue:[ |
|
24 | 356 |
(ny == thumbFrame top) ifTrue:[ |
357 |
(nx == thumbFrame left) ifTrue:[ |
|
358 |
(nh == thumbFrame height) ifTrue:[ |
|
359 |
(nw == thumbFrame width) ifTrue:[ ^ self] |
|
360 |
] |
|
361 |
] |
|
362 |
] |
|
0 | 363 |
]. |
364 |
thumbFrame := Rectangle left:nx top:ny width:nw height:nh |
|
49 | 365 |
! |
366 |
||
100 | 367 |
percentFromAbs:absValue |
368 |
"given a number of pixels, compute percentage" |
|
369 |
||
370 |
|fullSize val| |
|
371 |
||
372 |
(orientation == #vertical) ifTrue:[ |
|
672
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
373 |
fullSize := height |
100 | 374 |
] ifFalse:[ |
672
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
375 |
fullSize := width |
100 | 376 |
]. |
377 |
||
672
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
378 |
absValue < 0 ifTrue:[^ rangeStart]. |
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
379 |
absValue > fullSize ifTrue:[^ rangeEnd]. |
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
380 |
|
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
381 |
val := absValue / (fullSize - sliderHeight - (margin * 2)) |
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
382 |
* (rangeEnd - rangeStart). |
100 | 383 |
val := val + rangeStart. |
672
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
384 |
rangeStart < rangeEnd ifTrue:[ |
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
385 |
val < rangeStart ifTrue:[^ rangeStart]. |
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
386 |
val > rangeEnd ifTrue:[^ rangeEnd]. |
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
387 |
] ifFalse:[ |
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
388 |
val > rangeStart ifTrue:[^ rangeStart]. |
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
389 |
val < rangeEnd ifTrue:[^ rangeEnd]. |
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
390 |
]. |
100 | 391 |
^ val |
672
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
392 |
|
48a2f778d482
handle rangeStart > rangeEnd;
Claus Gittinger <cg@exept.de>
parents:
559
diff
changeset
|
393 |
"Modified: / 21.1.1998 / 19:31:08 / cg" |
49 | 394 |
! ! |
395 |
||
100 | 396 |
!Slider class methodsFor:'documentation'! |
49 | 397 |
|
100 | 398 |
version |
1996 | 399 |
^ '$Header: /cvs/stx/stx/libwidg2/Slider.st,v 1.35 2001-09-04 18:59:46 cg Exp $' |
49 | 400 |
! ! |