1 | "
|
---|
2 | COPYRIGHT (c) 1989 by Claus Gittinger
|
---|
3 | All Rights Reserved
|
---|
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 | 'From Smalltalk/X jv-branch, Version:6.2.6.0 on 06-01-2017 at 09:45:37 AM' !
|
---|
13 |
|
---|
14 | "{ Package: 'stx:libwidg' }"
|
---|
15 |
|
---|
16 | "{ NameSpace: Smalltalk }"
|
---|
17 |
|
---|
18 | View subclass:#Scroller
|
---|
19 | instanceVariableNames:'thumbOrigin thumbHeight thumbColor thumbFrameColor scrollAction
|
---|
20 | orientation thumbFrame thumbLevel scrolling pressOffset
|
---|
21 | synchronousOperation shadowForm lightForm inset thumbShadowColor
|
---|
22 | thumbLightColor thumbEdgeStyle thumbHalfShadowColor
|
---|
23 | thumbHalfLightColor thumbEnteredColor thumbFrameSizeDifference
|
---|
24 | tallyLevel tallyMarks fixThumbHeight frameBeforeMove ghostColor
|
---|
25 | ghostFrameColor ghostLevel rangeStart rangeEnd rangeStep entered
|
---|
26 | thumbActiveLevel originBeforeMove thumbImage enabled keyboardStep
|
---|
27 | autoRepeat repeatBlock initialRepeatDelay repeatDelay
|
---|
28 | lastMousePosition thumbActiveColor virtualModelValue'
|
---|
29 | classVariableNames:'HandleShadowForm HandleLightForm DefaultViewBackground
|
---|
30 | DefaultShadowColor DefaultLightColor DefaultThumbColor
|
---|
31 | DefaultThumbShadowColor DefaultThumbLightColor
|
---|
32 | DefaultThumbHalfShadowColor DefaultThumbHalfLightColor
|
---|
33 | DefaultHalfShadowColor DefaultHalfLightColor DefaultTallyMarks
|
---|
34 | DefaultTallyLevel DefaultLevel DefaultBorderWidth
|
---|
35 | DefaultThumbLevel DefaultInset DefaultThumbFrameColor
|
---|
36 | DefaultGhostColor DefaultGhostFrameColor DefaultGhostLevel
|
---|
37 | DefaultFixThumbHeight DefaultEdgeStyle DefaultFullViewBackground
|
---|
38 | DefaultThumbEnteredColor DefaultThumbActiveColor
|
---|
39 | DefaultThumbActiveLevel SnapBackDistance DefaultMiddleButtonJump
|
---|
40 | NewCursors DefaultThumbImage HandleImage DefaultHScrollerHeight
|
---|
41 | DefaultVScrollerWidth DefaultStopPagerAtThumb DefaultTallyInset
|
---|
42 | MinThumbSize DefaultTallyDistance DefaultVerticalThumbFrameImage
|
---|
43 | DefaultHorizontalThumbFrameImage'
|
---|
44 | poolDictionaries:''
|
---|
45 | category:'Views-Interactors'
|
---|
46 | !
|
---|
47 |
|
---|
48 | !Scroller class methodsFor:'documentation'!
|
---|
49 |
|
---|
50 | copyright
|
---|
51 | "
|
---|
52 | COPYRIGHT (c) 1989 by Claus Gittinger
|
---|
53 | All Rights Reserved
|
---|
54 |
|
---|
55 | This software is furnished under a license and may be used
|
---|
56 | only in accordance with the terms of that license and with the
|
---|
57 | inclusion of the above copyright notice. This software may not
|
---|
58 | be provided or otherwise made available to, or used by, any
|
---|
59 | other person. No title to or ownership of the software is
|
---|
60 | hereby transferred.
|
---|
61 | "
|
---|
62 | !
|
---|
63 |
|
---|
64 | documentation
|
---|
65 | "
|
---|
66 | this class implements the scroller for scrollbars.
|
---|
67 | it can also be used by itself for scrollbars without step-buttons.
|
---|
68 | When moved, either a predefined action is performed (scrollAction),
|
---|
69 | or a model is informed via the changeMsg (which is #value: by default).
|
---|
70 |
|
---|
71 | The scroller can work synchronous (i.e. every move leads to an immediate evaluation
|
---|
72 | of the action, or asynchronous (i.e. perform action on end-of move).
|
---|
73 | By default, scrollers are synchronous. Asynchronous operation makes sense,
|
---|
74 | if the scroll operation (redraw) is expensive and takes a long time.
|
---|
75 |
|
---|
76 | This class is used both for concrete instances (vertical scrollers)
|
---|
77 | and as an abstract superclass for horizontalScrollers, sliders and
|
---|
78 | miniScrollers.
|
---|
79 |
|
---|
80 | range:
|
---|
81 | the value passed to the model or via the action blocks is scaled according
|
---|
82 | to the min/maxRange instance variables.
|
---|
83 | These default to 0..100 for percentage values.
|
---|
84 | It does not make sense to change the range for scrollbar-scrollers,
|
---|
85 | but may be useful with Sliders or in special applications.
|
---|
86 |
|
---|
87 | style stuff:
|
---|
88 |
|
---|
89 | Beside the obvious 3D rectangle, a scroller may draw a know-form
|
---|
90 | (as in NeXT) or little tally marks (as on SGI) in itself.
|
---|
91 | These are controlled by the shadowForm, lightForm, tallyLevel and tallyMarks
|
---|
92 | instance variables. All of this is initialized from the styleSheet.
|
---|
93 |
|
---|
94 | [Instance variables:]
|
---|
95 |
|
---|
96 | thumbOrigin <Number> origin of thumb (in percent)
|
---|
97 | thumbHeight <Number> height of thumb (in percent)
|
---|
98 | thumbColor <Color> color of thumb
|
---|
99 | thumbFrameColor <Color> color of the frame around the thumb
|
---|
100 | scrollAction <Block> 1 arg block to be evaluated when scrolled
|
---|
101 | (arg is position in percent)
|
---|
102 | orientation <Symbol> #horizontal or #vertical
|
---|
103 | thumbFrame <Rectangle> frame of thumb in pixels (cached)
|
---|
104 | thumbLevel <Number> level of thumb if 3d
|
---|
105 | scrolling <Boolean> true during scroll
|
---|
106 | pressOffset <Number> temporary (offset into frame when move started)
|
---|
107 | synchronousOperation <Boolean> true if synchronous (i.e. dont wait till release
|
---|
108 | to perform action)
|
---|
109 | shadowForm <Form> bitmap of knob if any (shadow part)
|
---|
110 | lightForm <Form> bitmap of knob if any (light part)
|
---|
111 | inset <Integer> number of pixels to inset thumb from view borders
|
---|
112 | thumbShadowColor <Color> color do draw dark parts of thumb
|
---|
113 | thumblightColor <Color> color to draw light parts of thumb
|
---|
114 | thumbEdgeStyle <SymbolOrNil> #soft or nil
|
---|
115 | thumbHalfShadowColor <Color> used to draw smooth edges
|
---|
116 | thumbHalfLightColor <Color> used to draw smooth edges
|
---|
117 | thumbFrameSizeDifference <Integer> number of pixels the thumb is larger than
|
---|
118 | it should be (can be negative for mswin-style)
|
---|
119 | tallyLevel <Integer> if not zero, specifies if tally-marks should
|
---|
120 | go into or out of the display (actually only <0/>0 is checked)
|
---|
121 | I dont know of a better word for these ...
|
---|
122 | tallyMarks <Integer> number of tally marks
|
---|
123 | fixThumbHeight <Boolean> perform 'wrong' height computation a la mswindows
|
---|
124 | rangeStart <Number> the range of the scroller
|
---|
125 | rangeEnd (defaults to 0..100)
|
---|
126 | rangeStep not currently implemented
|
---|
127 |
|
---|
128 | [style settings:]
|
---|
129 |
|
---|
130 | scrollerLevel <Integer> the level of the scroller w.r.t. its enclosing view
|
---|
131 | scrollerBorderWidth <Integer> the borderWidth (ignored for 3D styles)
|
---|
132 |
|
---|
133 | scrollerViewBackground <Color> the viewBackground (color or image)
|
---|
134 | scrollerShadowColor <Color> the color of 3D shadowed edges (ignored in 2D styles)
|
---|
135 | scrollerLightColor <Color> the color of 3D lighted edges (ignored in 2D styles)
|
---|
136 |
|
---|
137 | scrollerThumbColor <Color> the thumbs color (color or image)
|
---|
138 | scrollerThumbShadowColor <Color> the color of the thumbs shadowed edges (ignored in 2D styles)
|
---|
139 | scrollerThumbLightColor <Color> the color of the thumbs shadowed edges (ignored in 2D styles)
|
---|
140 | scrollerThumbEdgeStyle <Symbol> the edge style for the thumb (#soft or nil)
|
---|
141 | scrollerThumbLevel <Integer> the 3D height of the thumb
|
---|
142 | scrollerThumbHalfShadowColor<Color> the halfShadow for soft edged thumbs
|
---|
143 | scrollerThumbHalfLightColor <Color> the halfLight for soft edged thumbs
|
---|
144 | scrollerThumbFrameColor <Color> if non-nil, a rectangle is drawn around the thumb is this color
|
---|
145 | scrollerThumbInset <Integer> inset of thumb from the scrollers boundary
|
---|
146 | scrollerThumbFixHeight <Boolean> if true, use a fix thumb height (as in mswindows)
|
---|
147 | scrollerGhostColor <Color> the color in which a ghost-rectangle is drawn
|
---|
148 | scrollerGhostFrameColor <Color> if non-nil, a rectangle is drawn around the ghost is this color
|
---|
149 | scrollerGhostLevel <Color> the 3D level of the ghost rectangle
|
---|
150 | scrollerNTallyMarks <Integer> number of tally-marks to draw on the thumb
|
---|
151 | scrollerTallyLevel <Integer> the 3D level of any tally marks
|
---|
152 | scrollerSnapBack <Boolean> win95 behavior: snap back to original position if scrollers view
|
---|
153 | is left by mouse (with some distance)
|
---|
154 | scrollerMiddleButtonJump <Boolean> xterm behavior: middle button has shift-click behavior
|
---|
155 | (positions absolute to click position)
|
---|
156 |
|
---|
157 | notice: for mswindows style, we force a WRONG thumb-frame
|
---|
158 | computation, to make the thumb have constant size;
|
---|
159 | if you dont like that (I do not :-),
|
---|
160 | set scrollerThumbFixHeight to false (in the StyleSheet).
|
---|
161 |
|
---|
162 | [author:]
|
---|
163 | Claus Gittinger
|
---|
164 |
|
---|
165 | [see also:]
|
---|
166 | ScrollBar
|
---|
167 | ScrollableView HVScrollableView
|
---|
168 | "
|
---|
169 | !
|
---|
170 |
|
---|
171 | examples
|
---|
172 | "
|
---|
173 | basic scroller setup:
|
---|
174 | [exBegin]
|
---|
175 | |top s|
|
---|
176 |
|
---|
177 | top := StandardSystemView new extent:200@200.
|
---|
178 | s := Scroller in:top.
|
---|
179 | s origin:(0.0@0.0) corner:(20@1.0).
|
---|
180 | s thumbHeight:10. 'percent'.
|
---|
181 | top open
|
---|
182 | [exEnd]
|
---|
183 |
|
---|
184 | setting its thumb-height:
|
---|
185 | [exBegin]
|
---|
186 | |top s|
|
---|
187 |
|
---|
188 | top := StandardSystemView new extent:200@200.
|
---|
189 | s := Scroller in:top.
|
---|
190 | s origin:(0.0@0.0) corner:(20@1.0).
|
---|
191 | s thumbHeight:50. 'percent'.
|
---|
192 | top open
|
---|
193 | [exEnd]
|
---|
194 |
|
---|
195 | setting its thumb-origin:
|
---|
196 | [exBegin]
|
---|
197 | |top s|
|
---|
198 |
|
---|
199 | top := StandardSystemView new extent:200@200.
|
---|
200 | s := Scroller in:top.
|
---|
201 | s origin:(0.0@0.0) corner:(20@1.0).
|
---|
202 | s thumbHeight:10. 'percent'.
|
---|
203 | s thumbOrigin:30. 'percent'.
|
---|
204 | top open
|
---|
205 | [exEnd]
|
---|
206 |
|
---|
207 | a scroller with action block (ST/X style):
|
---|
208 | [exBegin]
|
---|
209 | |top s|
|
---|
210 |
|
---|
211 | top := StandardSystemView new extent:200@200.
|
---|
212 | s := Scroller in:top.
|
---|
213 | s origin:(0.0@0.0) corner:(20@1.0).
|
---|
214 | s thumbHeight:10. 'percent'.
|
---|
215 | s scrollAction:[:percent | Transcript show:'moved to: '; showCR:percent asFloat].
|
---|
216 | top open
|
---|
217 | [exEnd]
|
---|
218 |
|
---|
219 | setting its range:
|
---|
220 | [exBegin]
|
---|
221 | |top s|
|
---|
222 |
|
---|
223 | top := StandardSystemView new extent:200@200.
|
---|
224 | s := Scroller in:top.
|
---|
225 | s origin:(0.0@0.0) corner:(20@1.0).
|
---|
226 | s thumbHeight:10. 'percent'.
|
---|
227 | s scrollAction:[:percent | Transcript show:'moved to: '; showCR:percent asFloat].
|
---|
228 | s start:0 stop:1.
|
---|
229 | top open
|
---|
230 | [exEnd]
|
---|
231 |
|
---|
232 | create a scroller in its default extent and have it positioned
|
---|
233 | at the side; beside another view:
|
---|
234 | [exBegin]
|
---|
235 | |top s v|
|
---|
236 |
|
---|
237 | top := StandardSystemView new extent:200@200.
|
---|
238 | s := Scroller in:top.
|
---|
239 | s origin:(0.0@0.0) corner:(0.0@1.0).
|
---|
240 | s rightInset:(s preferredExtent x negated).
|
---|
241 | s thumbHeight:10.
|
---|
242 | s level:1.
|
---|
243 |
|
---|
244 | v := View in:top.
|
---|
245 | v origin:0.0@0.0 corner:1.0@1.0.
|
---|
246 | v leftInset:(s preferredExtent x).
|
---|
247 | v viewBackground:Color red.
|
---|
248 | v level:2.
|
---|
249 |
|
---|
250 | top open
|
---|
251 | [exEnd]
|
---|
252 |
|
---|
253 | using a model (ST-80 style):
|
---|
254 | [exBegin]
|
---|
255 | |top s m|
|
---|
256 |
|
---|
257 | m := 0 asValue.
|
---|
258 | InspectorView openOn:m monitor:'value'. 'look at value'.
|
---|
259 |
|
---|
260 | top := StandardSystemView new extent:200@200.
|
---|
261 | s := Scroller in:top.
|
---|
262 | s origin:(0.0@0.0) corner:(20@1.0).
|
---|
263 | s thumbHeight:10. 'percent'.
|
---|
264 | s model:m.
|
---|
265 | top open
|
---|
266 | [exEnd]
|
---|
267 |
|
---|
268 | using a different changeSelector:
|
---|
269 | [exBegin]
|
---|
270 | |top s1 s2 m|
|
---|
271 |
|
---|
272 | m := Plug new.
|
---|
273 | m respondTo:#value1: with:[:v | Transcript show:'scroller 1 moved to: '; showCR:v].
|
---|
274 | m respondTo:#value2: with:[:v | Transcript show:'scroller 2 moved to: '; showCR:v].
|
---|
275 |
|
---|
276 | top := StandardSystemView new extent:200@200.
|
---|
277 | s1 := Scroller in:top.
|
---|
278 | s1 origin:(0.0@0.0) corner:(20@1.0).
|
---|
279 | s1 thumbHeight:10. 'percent'.
|
---|
280 | s1 model:m; change:#value1:.
|
---|
281 |
|
---|
282 | s2 := Scroller in:top.
|
---|
283 | s2 origin:(30@0.0) corner:(50@1.0).
|
---|
284 | s2 thumbHeight:10. 'percent'.
|
---|
285 | s2 model:m; change:#value2:.
|
---|
286 | top open
|
---|
287 | [exEnd]
|
---|
288 | "
|
---|
289 | ! !
|
---|
290 |
|
---|
291 | !Scroller class methodsFor:'defaults'!
|
---|
292 |
|
---|
293 | handleLightFormOn:aDisplay
|
---|
294 | "answer the form used for the handles light area;
|
---|
295 | cache the one for Display for the next round"
|
---|
296 |
|
---|
297 | |f|
|
---|
298 |
|
---|
299 | ((aDisplay == Display) and:[HandleLightForm notNil]) ifTrue:[
|
---|
300 | ^ HandleLightForm
|
---|
301 | ].
|
---|
302 | f := Smalltalk imageFromFileNamed:'HandleLight.xbm' forClass:self.
|
---|
303 | f notNil ifTrue:[
|
---|
304 | f := f onDevice:aDisplay
|
---|
305 | ] ifFalse:[
|
---|
306 | f := Form width:8 height:8 fromArray:#[2r00000000
|
---|
307 | 2r00000010
|
---|
308 | 2r00000011
|
---|
309 | 2r00000011
|
---|
310 | 2r00000011
|
---|
311 | 2r00000011
|
---|
312 | 2r00000110
|
---|
313 | 2r00111100]
|
---|
314 | onDevice:aDisplay
|
---|
315 | ].
|
---|
316 | (aDisplay == Display) ifTrue:[
|
---|
317 | HandleLightForm := f
|
---|
318 | ].
|
---|
319 | ^ f
|
---|
320 |
|
---|
321 | "Modified: 23.10.2031 / 01:00:00 / cg"
|
---|
322 | !
|
---|
323 |
|
---|
324 | handleShadowFormOn:aDisplay
|
---|
325 | "answer the form used for the handles shadow area;
|
---|
326 | cache the one for Display for the next round"
|
---|
327 |
|
---|
328 | |f|
|
---|
329 |
|
---|
330 | ((aDisplay == Display) and:[HandleShadowForm notNil]) ifTrue:[
|
---|
331 | ^ HandleShadowForm
|
---|
332 | ].
|
---|
333 | f := Smalltalk imageFromFileNamed:'HandleShadow.xbm' forClass:self.
|
---|
334 | f notNil ifTrue:[
|
---|
335 | f := f onDevice:aDisplay
|
---|
336 | ] ifFalse:[
|
---|
337 | f := Form width:8 height:8 fromArray:#[2r00111100
|
---|
338 | 2r01100000
|
---|
339 | 2r11000000
|
---|
340 | 2r11000000
|
---|
341 | 2r11000000
|
---|
342 | 2r11000000
|
---|
343 | 2r01000000
|
---|
344 | 2r00000000]
|
---|
345 | onDevice:aDisplay
|
---|
346 | ].
|
---|
347 | (aDisplay == Display) ifTrue:[
|
---|
348 | HandleShadowForm := f
|
---|
349 | ].
|
---|
350 | ^ f
|
---|
351 |
|
---|
352 | "Modified: 19.12.1996 / 01:00:00 / cg"
|
---|
353 | !
|
---|
354 |
|
---|
355 | updateStyleCache
|
---|
356 | "extract values from the styleSheet and cache them in class variables"
|
---|
357 |
|
---|
358 | <resource: #style (#'scroller.viewBackground' #'scroller.fullViewBackground'
|
---|
359 | #'scroller.thumbColor'
|
---|
360 | #'scroller.shadowColor' #'scroller.lightColor'
|
---|
361 | #'scroller.thumbShadowColor' #'scroller.thumbLightColor'
|
---|
362 | #'scroller.thumbHalfShadowColor' #'scroller.thumbHalfLightColor'
|
---|
363 | #'scroller.thumbFrameColor' #'scroller.ghostColor'
|
---|
364 | #'scroller.ghostLevel' #'scroller.ghostFrameColor'
|
---|
365 | #'scroller.NTallyMarks' #'scroller.tallyLevel' #'scroller.tallyInset'
|
---|
366 | #'scroller.level' #'scroller.borderWidth'
|
---|
367 | #'scroller.thumbLevel' #'scroller.thumbInset'
|
---|
368 | #'scroller.thumbFixHeight' #'scroller.thumbEdgeStyle'
|
---|
369 | #'scroller.thumbEnteredColor' #'scroller.thumbActiveLevel'
|
---|
370 | #'scroller.thumbActiveColor'
|
---|
371 | #'scroller.middleButtonJump'
|
---|
372 | #'scroller.newCursors'
|
---|
373 | #'scroller.thumbImage' #'scroller.handleImage'
|
---|
374 | #'scroller.vScrollerWidth' #'scroller.hScrollerHeight'
|
---|
375 | #'scroller.stopPagerAtThumb'
|
---|
376 | #'scroller.verticalThumbFrameImage' #'scroller.horizontalThumbFrameImage'
|
---|
377 | )>
|
---|
378 |
|
---|
379 | DefaultViewBackground := StyleSheet colorAt:#'scroller.viewBackground'.
|
---|
380 | DefaultFullViewBackground := StyleSheet colorAt:#'scroller.fullViewBackground'.
|
---|
381 | DefaultThumbColor := StyleSheet colorAt:#'scroller.thumbColor'.
|
---|
382 | DefaultThumbEnteredColor := StyleSheet colorAt:#'scroller.thumbEnteredColor'.
|
---|
383 | DefaultThumbActiveColor := StyleSheet colorAt:#'scroller.thumbActiveColor'.
|
---|
384 | DefaultShadowColor := StyleSheet colorAt:#'scroller.shadowColor'.
|
---|
385 | DefaultLightColor := StyleSheet colorAt:#'scroller.lightColor'.
|
---|
386 | DefaultThumbShadowColor := StyleSheet colorAt:#'scroller.thumbShadowColor'.
|
---|
387 | DefaultThumbLightColor := StyleSheet colorAt:#'scroller.thumbLightColor'.
|
---|
388 | DefaultThumbHalfShadowColor := StyleSheet colorAt:#'scroller.thumbHalfShadowColor'.
|
---|
389 | DefaultThumbHalfLightColor := StyleSheet colorAt:#'scroller.thumbHalfLightColor'.
|
---|
390 | DefaultThumbFrameColor := StyleSheet colorAt:#'scroller.thumbFrameColor'.
|
---|
391 | DefaultGhostColor := StyleSheet colorAt:#'scroller.ghostColor' default:nil.
|
---|
392 | DefaultGhostFrameColor := StyleSheet colorAt:#'scroller.ghostFrameColor' default:nil.
|
---|
393 | DefaultGhostLevel := StyleSheet at:#'scroller.ghostLevel' default:0.
|
---|
394 | DefaultTallyMarks := StyleSheet at:#'scroller.NTallyMarks' default:0.
|
---|
395 |
|
---|
396 | DefaultTallyLevel := DefaultTallyInset := 0.
|
---|
397 | DefaultTallyMarks ~~ 0 ifTrue:[
|
---|
398 | DefaultTallyLevel := StyleSheet at:#'scroller.tallyLevel' default:1.
|
---|
399 | DefaultTallyInset := StyleSheet at:#'scroller.tallyInset' default:0.
|
---|
400 | DefaultTallyDistance := StyleSheet at:#'scroller.tallyDistance'.
|
---|
401 | ].
|
---|
402 | DefaultLevel := StyleSheet at:#'scroller.level' default:0.
|
---|
403 | DefaultBorderWidth := StyleSheet at:#'scroller.borderWidth' default:(StyleSheet at:#'borderWidth').
|
---|
404 | DefaultThumbLevel := StyleSheet at:#'scroller.thumbLevel' default:0.
|
---|
405 | DefaultThumbActiveLevel := StyleSheet at:#'scroller.thumbActiveLevel' default:DefaultThumbLevel.
|
---|
406 | DefaultInset := StyleSheet at:#'scroller.thumbInset' default:0.
|
---|
407 | DefaultFixThumbHeight := StyleSheet at:#'scroller.thumbFixHeight' default:false.
|
---|
408 | DefaultEdgeStyle := StyleSheet at:#'scroller.thumbEdgeStyle'.
|
---|
409 | DefaultMiddleButtonJump := StyleSheet at:#'scroller.middleButtonJump' default:false.
|
---|
410 | NewCursors := StyleSheet at:#'scroller.newCursors' default:true.
|
---|
411 | DefaultThumbImage := StyleSheet at:#'scroller.thumbImage'.
|
---|
412 | HandleImage := StyleSheet at:#'scroller.handleImage'.
|
---|
413 | DefaultVerticalThumbFrameImage := StyleSheet at:#'scroller.verticalThumbFrameImage'.
|
---|
414 | DefaultHorizontalThumbFrameImage := StyleSheet at:#'scroller.horizontalThumbFrameImage'.
|
---|
415 |
|
---|
416 | DefaultVScrollerWidth := StyleSheet at:#'scroller.vScrollerWidth' default:nil.
|
---|
417 | DefaultHScrollerHeight := StyleSheet at:#'scroller.hScrollerHeight' default:nil.
|
---|
418 |
|
---|
419 | StyleSheet fileReadFailed ifTrue:[
|
---|
420 | DefaultViewBackground := Grey.
|
---|
421 | DefaultThumbColor := Color white.
|
---|
422 | DefaultThumbFrameColor := Color black.
|
---|
423 | DefaultInset := 1.
|
---|
424 | ].
|
---|
425 |
|
---|
426 | DefaultStopPagerAtThumb := StyleSheet at:#'scroller.stopPagerAtThumb' default:true.
|
---|
427 |
|
---|
428 | SnapBackDistance := StyleSheet at:#'scroller.snapBackDistance' default:30.
|
---|
429 | MinThumbSize := StyleSheet at:#'scroller.minThumbSize' default:8.
|
---|
430 |
|
---|
431 | "
|
---|
432 | self updateStyleCache
|
---|
433 | "
|
---|
434 |
|
---|
435 | "Modified: / 28.4.1999 / 19:23:24 / cg"
|
---|
436 | ! !
|
---|
437 |
|
---|
438 | !Scroller methodsFor:'accessing'!
|
---|
439 |
|
---|
440 | keyboardStep
|
---|
441 | "return the scrollers keyboard step. If non-nil,
|
---|
442 | thats the stepping value used with cursorUp/cursorDown keys.
|
---|
443 | (not used with Scrollers, but provided for subclasses)"
|
---|
444 |
|
---|
445 | ^ keyboardStep
|
---|
446 | !
|
---|
447 |
|
---|
448 | keyboardStep:aNumber
|
---|
449 | "set the scrollers keyboard step. If non-nil,
|
---|
450 | thats the stepping value used with cursorUp/cursorDown keys.
|
---|
451 | (not used with Scrollers, but provided for subclasses)"
|
---|
452 |
|
---|
453 | keyboardStep := aNumber
|
---|
454 | !
|
---|
455 |
|
---|
456 | start
|
---|
457 | "return the scrollers range min.
|
---|
458 | (not used with Scrollers, but provided for subclasses)"
|
---|
459 |
|
---|
460 | ^ rangeStart
|
---|
461 | !
|
---|
462 |
|
---|
463 | start:start
|
---|
464 | "set the scrollers range min.
|
---|
465 | (not used with Scrollers, but provided for subclasses)"
|
---|
466 |
|
---|
467 | self start:start stop:rangeEnd.
|
---|
468 |
|
---|
469 | "Modified: 25.5.1996 / 11:28:22 / cg"
|
---|
470 | !
|
---|
471 |
|
---|
472 | start:start stop:stop
|
---|
473 | "set the range.
|
---|
474 | (not used with Scrollers, but provided for subclasses)"
|
---|
475 |
|
---|
476 | |org|
|
---|
477 |
|
---|
478 | org := self thumbOrigin.
|
---|
479 |
|
---|
480 | rangeStart := start.
|
---|
481 | rangeEnd := stop.
|
---|
482 |
|
---|
483 | rangeStart = rangeEnd ifTrue:[
|
---|
484 | self error:'invalid slider range (start = stop)' mayProceed:true.
|
---|
485 | rangeEnd := rangeStart + (rangeStep ? 1).
|
---|
486 | ].
|
---|
487 |
|
---|
488 | org < rangeStart ifTrue:[
|
---|
489 | org := rangeStart
|
---|
490 | ] ifFalse:[
|
---|
491 | org > rangeEnd ifTrue:[
|
---|
492 | org := rangeEnd
|
---|
493 | ]
|
---|
494 | ].
|
---|
495 | self thumbOrigin:org.
|
---|
496 |
|
---|
497 | "Modified: / 21.1.1998 / 19:22:07 / cg"
|
---|
498 | !
|
---|
499 |
|
---|
500 | start:start stop:stop step:step
|
---|
501 | "set the range.
|
---|
502 | (not used with Scrollers, but provided for subclasses)"
|
---|
503 |
|
---|
504 | self start:start stop:stop.
|
---|
505 | rangeStep := step.
|
---|
506 |
|
---|
507 | "Created: 25.5.1996 / 11:24:09 / cg"
|
---|
508 | "Modified: 25.5.1996 / 11:27:43 / cg"
|
---|
509 | !
|
---|
510 |
|
---|
511 | step
|
---|
512 | "return the scrollers range step.
|
---|
513 | (not used with Scrollers, but provided for subclasses)"
|
---|
514 |
|
---|
515 | ^ rangeStep
|
---|
516 | !
|
---|
517 |
|
---|
518 | step:step
|
---|
519 | "set the scrollers range step.
|
---|
520 | (not used with Scrollers, but provided for subclasses)"
|
---|
521 |
|
---|
522 | rangeStep := step
|
---|
523 | !
|
---|
524 |
|
---|
525 | stop
|
---|
526 | "return the scrollers range max.
|
---|
527 | (not used with Scrollers, but provided for subclasses)"
|
---|
528 |
|
---|
529 | ^ rangeEnd
|
---|
530 | !
|
---|
531 |
|
---|
532 | stop:stop
|
---|
533 | "set the scrollers range max.
|
---|
534 | (not used with Scrollers, but provided for subclasses)"
|
---|
535 |
|
---|
536 | self start:rangeStart stop:stop.
|
---|
537 |
|
---|
538 | "Modified: 25.5.1996 / 11:28:35 / cg"
|
---|
539 | !
|
---|
540 |
|
---|
541 | thumbFrame
|
---|
542 | "return the area used by the thumbFrame (in device coordinates).
|
---|
543 | Allows access to the thumbs physical screen position, for
|
---|
544 | example to position a label below (see Slider-Examples)"
|
---|
545 |
|
---|
546 | thumbFrame isNil ifTrue:[ self computeThumbFrame].
|
---|
547 | ^ thumbFrame
|
---|
548 | !
|
---|
549 |
|
---|
550 | thumbHeight
|
---|
551 | "answer the thumbs height (in percent by default)"
|
---|
552 |
|
---|
553 | ^ thumbHeight * (rangeEnd - rangeStart) abs / 100
|
---|
554 |
|
---|
555 | "Modified: / 21.1.1998 / 19:25:33 / cg"
|
---|
556 | !
|
---|
557 |
|
---|
558 | thumbHeight:aNumber
|
---|
559 | "set the thumbs height (in percent by default)"
|
---|
560 |
|
---|
561 | |newHeight realNewHeight oldFrame nBg|
|
---|
562 |
|
---|
563 | newHeight := aNumber / ((rangeEnd - rangeStart) abs / 100).
|
---|
564 |
|
---|
565 | (newHeight > 100) ifTrue:[
|
---|
566 | realNewHeight := 100
|
---|
567 | ] ifFalse:[
|
---|
568 | realNewHeight := newHeight
|
---|
569 | ].
|
---|
570 | ((realNewHeight ~= thumbHeight) or:[thumbFrame isNil]) ifTrue:[
|
---|
571 | thumbHeight := realNewHeight.
|
---|
572 |
|
---|
573 | (DefaultFullViewBackground notNil
|
---|
574 | and:[DefaultViewBackground notNil
|
---|
575 | and:[DefaultFullViewBackground ~~ DefaultViewBackground]]) ifTrue:[
|
---|
576 | realNewHeight >= 100 ifTrue:[
|
---|
577 | nBg := DefaultFullViewBackground.
|
---|
578 | ] ifFalse:[
|
---|
579 | nBg := DefaultViewBackground
|
---|
580 | ].
|
---|
581 | nBg := nBg onDevice:device.
|
---|
582 | nBg ~~ viewBackground ifTrue:[
|
---|
583 | self viewBackground:nBg.
|
---|
584 | self invalidate.
|
---|
585 | ]
|
---|
586 | ].
|
---|
587 |
|
---|
588 | shown ifTrue:[
|
---|
589 | oldFrame := thumbFrame.
|
---|
590 | self computeThumbFrame.
|
---|
591 | oldFrame ~= thumbFrame ifTrue:[
|
---|
592 | self invalidate.
|
---|
593 | ]
|
---|
594 | ] ifFalse:[
|
---|
595 | thumbFrame := nil.
|
---|
596 | self invalidate.
|
---|
597 | ].
|
---|
598 | ]
|
---|
599 |
|
---|
600 | "Modified: / 21.10.1998 / 22:35:31 / cg"
|
---|
601 | !
|
---|
602 |
|
---|
603 | thumbOrigin
|
---|
604 | "answer the thumbs origin (in percent by default)"
|
---|
605 |
|
---|
606 | |org|
|
---|
607 |
|
---|
608 | org := thumbOrigin * (rangeEnd - rangeStart) / 100 + rangeStart.
|
---|
609 | rangeStep notNil ifTrue:[
|
---|
610 | org := org roundTo:rangeStep.
|
---|
611 | rangeStep isInteger ifTrue:[
|
---|
612 | org := org asInteger
|
---|
613 | ]
|
---|
614 | ].
|
---|
615 | ^ org
|
---|
616 |
|
---|
617 | "Modified: / 21.1.1998 / 19:13:48 / cg"
|
---|
618 | !
|
---|
619 |
|
---|
620 | thumbOrigin:aNumber
|
---|
621 | "set the thumbs origin (in percent by default)"
|
---|
622 |
|
---|
623 | |org newOrigin realNewOrigin
|
---|
624 | oldFrame oldTop oldBot oldLeft oldRight
|
---|
625 | thumbTop thumbBot thumbLeft thumbRight
|
---|
626 | tH "{ Class: SmallInteger }"
|
---|
627 | tW "{ Class: SmallInteger }"
|
---|
628 | delta needFullDraw
|
---|
629 | bgLeft bgTop bgWidth bgHeight|
|
---|
630 |
|
---|
631 | aNumber isNil ifTrue:[
|
---|
632 | newOrigin := 0
|
---|
633 | ] ifFalse:[
|
---|
634 | org := aNumber.
|
---|
635 | rangeStep notNil ifTrue:[
|
---|
636 | org := org roundTo:rangeStep.
|
---|
637 | rangeStep isInteger ifTrue:[
|
---|
638 | org := org asInteger
|
---|
639 | ]
|
---|
640 | ].
|
---|
641 | newOrigin := (org - rangeStart) asFloat / (rangeEnd - rangeStart / 100).
|
---|
642 | ].
|
---|
643 |
|
---|
644 | ((newOrigin + thumbHeight) > 100) ifTrue:[
|
---|
645 | realNewOrigin := 100 - thumbHeight
|
---|
646 | ] ifFalse: [
|
---|
647 | realNewOrigin := newOrigin
|
---|
648 | ].
|
---|
649 | (realNewOrigin > 100) ifTrue:[
|
---|
650 | realNewOrigin := 100
|
---|
651 | ] ifFalse: [
|
---|
652 | (realNewOrigin < 0) ifTrue:[
|
---|
653 | realNewOrigin := 0
|
---|
654 | ]
|
---|
655 | ].
|
---|
656 | ((realNewOrigin ~= thumbOrigin) or:[thumbFrame isNil]) ifTrue:[
|
---|
657 | thumbOrigin := realNewOrigin.
|
---|
658 |
|
---|
659 | shown ifTrue:[
|
---|
660 | oldFrame := thumbFrame.
|
---|
661 | self computeThumbFrame.
|
---|
662 | (thumbHeight = 100) ifTrue:[
|
---|
663 | "/ full: don't draw
|
---|
664 | ^ self
|
---|
665 | ].
|
---|
666 |
|
---|
667 | (thumbFrame ~= oldFrame) ifTrue:[
|
---|
668 | oldFrame isNil ifTrue:[
|
---|
669 | self invalidate.
|
---|
670 | ^ self
|
---|
671 | ].
|
---|
672 | tH := thumbFrame height.
|
---|
673 | tW := thumbFrame width.
|
---|
674 |
|
---|
675 | oldTop := oldFrame top.
|
---|
676 | oldBot := oldTop + tH.
|
---|
677 | oldLeft := oldFrame left.
|
---|
678 | oldRight := oldLeft + tW.
|
---|
679 |
|
---|
680 | thumbTop := thumbFrame top.
|
---|
681 | thumbBot := thumbTop + tH.
|
---|
682 | thumbLeft := thumbFrame left.
|
---|
683 | thumbRight := thumbLeft + tW.
|
---|
684 |
|
---|
685 | needFullDraw := self exposeEventPending
|
---|
686 | or:[((orientation == #vertical) and:[oldBot >= height])
|
---|
687 | or:[((orientation ~~ #vertical) and:[oldRight >= width])]].
|
---|
688 |
|
---|
689 | needFullDraw ifTrue:[
|
---|
690 | "
|
---|
691 | cannot copy since thumb was below the end
|
---|
692 | or may be not available for the copy
|
---|
693 | "
|
---|
694 | self invalidate.
|
---|
695 | ^ self
|
---|
696 | ].
|
---|
697 |
|
---|
698 | self catchExpose.
|
---|
699 | "
|
---|
700 | copy the thumbs pixels
|
---|
701 | "
|
---|
702 | (orientation == #vertical) ifTrue:[
|
---|
703 | self
|
---|
704 | copyFrom:self
|
---|
705 | x:thumbLeft y:oldTop
|
---|
706 | toX:thumbLeft y:thumbTop
|
---|
707 | width:tW height:tH
|
---|
708 | async:true.
|
---|
709 | ] ifFalse:[
|
---|
710 | self
|
---|
711 | copyFrom:self
|
---|
712 | x:oldLeft y:thumbTop
|
---|
713 | toX:thumbLeft y:thumbTop
|
---|
714 | width:tW height:tH
|
---|
715 | async:true.
|
---|
716 | ].
|
---|
717 |
|
---|
718 | "
|
---|
719 | clear some of the previous thumbs area to background
|
---|
720 | "
|
---|
721 | (orientation == #vertical) ifTrue:[
|
---|
722 | bgLeft := thumbLeft.
|
---|
723 | bgWidth := tW.
|
---|
724 | oldTop > thumbTop ifTrue:[
|
---|
725 | delta := oldTop - thumbTop.
|
---|
726 | oldTop > thumbBot ifTrue:[
|
---|
727 | bgTop := oldTop.
|
---|
728 | bgHeight := tH + 1
|
---|
729 | ] ifFalse:[
|
---|
730 | bgTop := thumbBot.
|
---|
731 | bgHeight := delta
|
---|
732 | ]
|
---|
733 | ] ifFalse:[
|
---|
734 | delta := thumbTop - oldTop.
|
---|
735 | oldBot < thumbTop ifTrue:[
|
---|
736 | bgTop := oldTop.
|
---|
737 | bgHeight := tH + 1
|
---|
738 | ] ifFalse:[
|
---|
739 | bgTop := oldTop.
|
---|
740 | bgHeight := delta
|
---|
741 | ]
|
---|
742 | ].
|
---|
743 | ] ifFalse:[
|
---|
744 | bgTop := thumbTop.
|
---|
745 | bgHeight := tH.
|
---|
746 | oldLeft > thumbLeft ifTrue:[
|
---|
747 | delta := oldLeft - thumbLeft.
|
---|
748 | oldLeft > thumbRight ifTrue:[
|
---|
749 | bgLeft := oldLeft.
|
---|
750 | bgWidth := tW + 1.
|
---|
751 | ] ifFalse:[
|
---|
752 | bgLeft := thumbRight.
|
---|
753 | bgWidth := delta.
|
---|
754 | ]
|
---|
755 | ] ifFalse:[
|
---|
756 | delta := thumbLeft - oldLeft.
|
---|
757 | oldRight < thumbLeft ifTrue:[
|
---|
758 | bgLeft := oldLeft.
|
---|
759 | bgWidth := tW + 1.
|
---|
760 | ] ifFalse:[
|
---|
761 | bgLeft := oldLeft.
|
---|
762 | bgWidth := delta.
|
---|
763 | ]
|
---|
764 | ].
|
---|
765 | ].
|
---|
766 | self drawThumbBackgroundInX:bgLeft y:bgTop width:bgWidth height:bgHeight.
|
---|
767 | self waitForExpose
|
---|
768 | ]
|
---|
769 | ] ifFalse:[
|
---|
770 | thumbFrame := nil
|
---|
771 | ]
|
---|
772 | ]
|
---|
773 |
|
---|
774 | "Modified: / 4.5.1999 / 18:57:28 / cg"
|
---|
775 | !
|
---|
776 |
|
---|
777 | thumbOrigin:originNumber thumbHeight:heightNumber
|
---|
778 | "set both thumbs height and origin (in percent by default)"
|
---|
779 |
|
---|
780 | |newHeight newOrigin realNewOrigin realNewHeight old new changed
|
---|
781 | nBg range|
|
---|
782 |
|
---|
783 | range := rangeEnd - rangeStart.
|
---|
784 |
|
---|
785 | newOrigin := (originNumber - rangeStart) / (range / 100).
|
---|
786 | newHeight := heightNumber / (range abs / 100).
|
---|
787 |
|
---|
788 | (newHeight > 100) ifTrue:[
|
---|
789 | realNewHeight := 100
|
---|
790 | ] ifFalse:[
|
---|
791 | realNewHeight := newHeight
|
---|
792 | ].
|
---|
793 | ((newOrigin + realNewHeight) > 100) ifTrue:[
|
---|
794 | realNewOrigin := 100 - realNewHeight
|
---|
795 | ] ifFalse: [
|
---|
796 | realNewOrigin := newOrigin
|
---|
797 | ].
|
---|
798 | (realNewOrigin < 0) ifTrue: [
|
---|
799 | realNewOrigin := 0
|
---|
800 | ].
|
---|
801 |
|
---|
802 | changed := (realNewHeight ~= thumbHeight) or:[realNewOrigin ~= thumbOrigin].
|
---|
803 | (changed or:[thumbFrame isNil]) ifTrue:[
|
---|
804 | old := self absFromPercent:thumbOrigin.
|
---|
805 | new := self absFromPercent:realNewOrigin.
|
---|
806 | changed := old ~~ new.
|
---|
807 | changed ifFalse:[
|
---|
808 | old := self absFromPercent:thumbHeight.
|
---|
809 | new := self absFromPercent:realNewHeight.
|
---|
810 | changed := (old ~~ new)
|
---|
811 | ].
|
---|
812 | (changed or:[thumbFrame isNil]) ifTrue:[
|
---|
813 | thumbOrigin := realNewOrigin.
|
---|
814 | thumbHeight := realNewHeight.
|
---|
815 |
|
---|
816 | (DefaultFullViewBackground notNil
|
---|
817 | and:[DefaultViewBackground notNil
|
---|
818 | and:[DefaultFullViewBackground ~~ DefaultViewBackground]]) ifTrue:[
|
---|
819 | realNewHeight >= 100 ifTrue:[
|
---|
820 | nBg := DefaultFullViewBackground.
|
---|
821 | ] ifFalse:[
|
---|
822 | nBg := DefaultViewBackground
|
---|
823 | ].
|
---|
824 | nBg := nBg onDevice:device.
|
---|
825 | nBg ~~ viewBackground ifTrue:[
|
---|
826 | self viewBackground:nBg.
|
---|
827 | ]
|
---|
828 | ].
|
---|
829 |
|
---|
830 | thumbFrame := nil.
|
---|
831 | self invalidate.
|
---|
832 | ]
|
---|
833 | ]
|
---|
834 |
|
---|
835 | "Modified: / 21.1.1998 / 19:32:41 / cg"
|
---|
836 | !
|
---|
837 |
|
---|
838 | virtualModelValue
|
---|
839 | ^ virtualModelValue
|
---|
840 |
|
---|
841 | "Modified (format): / 05-01-2017 / 13:48:27 / svestkap"
|
---|
842 | !
|
---|
843 |
|
---|
844 | virtualModelValue:aNumber
|
---|
845 | virtualModelValue := aNumber.
|
---|
846 |
|
---|
847 | "Modified (format): / 05-01-2017 / 13:48:32 / svestkap"
|
---|
848 | ! !
|
---|
849 |
|
---|
850 | !Scroller methodsFor:'accessing-behavior'!
|
---|
851 |
|
---|
852 | action:aBlock
|
---|
853 | "for protocol compatibility; same as scrollAction:"
|
---|
854 |
|
---|
855 | self scrollAction:aBlock
|
---|
856 | !
|
---|
857 |
|
---|
858 | asynchronousOperation
|
---|
859 | <resource:#obsolete>
|
---|
860 | self obsoleteMethodWarning:'use #beAsynchronous'.
|
---|
861 | self beAsynchronous
|
---|
862 | !
|
---|
863 |
|
---|
864 | beAsynchronous
|
---|
865 | "set scroll-mode to be asynchronous - scroll action is only performed after
|
---|
866 | scrolling, when mouse-button is finally released (no tracking)."
|
---|
867 |
|
---|
868 | synchronousOperation := false
|
---|
869 |
|
---|
870 | "Modified: / 12-12-2016 / 13:16:38 / svestkap"
|
---|
871 | !
|
---|
872 |
|
---|
873 | beSynchronous
|
---|
874 | "set scroll-mode to be synchronous - scroll action is performed for
|
---|
875 | every movement of thumb (tracking)."
|
---|
876 |
|
---|
877 | synchronousOperation := true
|
---|
878 | !
|
---|
879 |
|
---|
880 | enabled
|
---|
881 | "return enable/disable state of the scoller"
|
---|
882 |
|
---|
883 | ^ enabled
|
---|
884 |
|
---|
885 | "Created: / 30.3.1999 / 15:24:50 / stefan"
|
---|
886 | !
|
---|
887 |
|
---|
888 | enabled:aBoolean
|
---|
889 | "enable/disable the scoller"
|
---|
890 |
|
---|
891 | enabled ~~ aBoolean ifTrue:[
|
---|
892 | enabled := aBoolean.
|
---|
893 | self updateBackground.
|
---|
894 | aBoolean ifFalse:[
|
---|
895 | self cursor: Cursor normal
|
---|
896 | ]
|
---|
897 | ]
|
---|
898 |
|
---|
899 | "Created: / 30.3.1999 / 15:23:14 / stefan"
|
---|
900 | !
|
---|
901 |
|
---|
902 | isSynchronous
|
---|
903 | "return true if the scroll-mode is synchronous.
|
---|
904 | If true, the scroll action is performed for every movement of the thumb (tracking).
|
---|
905 | If false, the scroll action is only performed at the end."
|
---|
906 |
|
---|
907 | ^ synchronousOperation
|
---|
908 | !
|
---|
909 |
|
---|
910 | scrollAction
|
---|
911 | "answer the scroll action block"
|
---|
912 |
|
---|
913 | ^ scrollAction
|
---|
914 | !
|
---|
915 |
|
---|
916 | scrollAction:aBlock
|
---|
917 | "set the scroll action, aBlock which is evaluated when scrolled"
|
---|
918 |
|
---|
919 | scrollAction := aBlock
|
---|
920 | !
|
---|
921 |
|
---|
922 | scrollDownAction:aBlock
|
---|
923 | "ignored -
|
---|
924 | but implemented, so that scroller can be used in place of a scrollbar"
|
---|
925 | !
|
---|
926 |
|
---|
927 | scrollLeftAction:aBlock
|
---|
928 | "ignored -
|
---|
929 | but implemented, so that scroller can be used in place of a scrollbar"
|
---|
930 | !
|
---|
931 |
|
---|
932 | scrollRightAction:aBlock
|
---|
933 | "ignored -
|
---|
934 | but implemented, so that scroller can be used in place of a scrollbar"
|
---|
935 | !
|
---|
936 |
|
---|
937 | scrollUpAction:aBlock
|
---|
938 | "ignored -
|
---|
939 | but implemented, so that scroller can be used in place of a scrollbar"
|
---|
940 | !
|
---|
941 |
|
---|
942 | synchronousOperation
|
---|
943 | <resource:#obsolete>
|
---|
944 | self obsoleteMethodWarning:'use #beSynchronous'.
|
---|
945 | self beSynchronous
|
---|
946 | ! !
|
---|
947 |
|
---|
948 | !Scroller methodsFor:'accessing-bg & border'!
|
---|
949 |
|
---|
950 | allViewBackground:something if:condition
|
---|
951 | "ignore here for all scrollers (I want my own background)"
|
---|
952 |
|
---|
953 | "/ ^ super allViewBackground:something
|
---|
954 | ! !
|
---|
955 |
|
---|
956 | !Scroller methodsFor:'accessing-look'!
|
---|
957 |
|
---|
958 | is3D
|
---|
959 | "return true, if I use a 3D style"
|
---|
960 |
|
---|
961 | <resource: #style (#name)>
|
---|
962 |
|
---|
963 | styleSheet name = #mswindows ifTrue:[^ true].
|
---|
964 | ^ super is3D
|
---|
965 |
|
---|
966 | "Modified: 17.1.1997 / 23:21:42 / cg"
|
---|
967 | !
|
---|
968 |
|
---|
969 | orientation
|
---|
970 | "return the scrollers orientation (#vertical or #horizontal)"
|
---|
971 |
|
---|
972 | ^ orientation
|
---|
973 | !
|
---|
974 |
|
---|
975 | orientation:aSymbol
|
---|
976 | "set the scrollers orientation (#vertical or #horizontal)"
|
---|
977 |
|
---|
978 | |oldFrame|
|
---|
979 |
|
---|
980 | orientation := aSymbol.
|
---|
981 | preferredExtent := nil.
|
---|
982 |
|
---|
983 | shown ifTrue:[
|
---|
984 | oldFrame := thumbFrame.
|
---|
985 | self computeThumbFrame.
|
---|
986 |
|
---|
987 | oldFrame ~= thumbFrame ifTrue:[
|
---|
988 | self invalidate.
|
---|
989 | ]
|
---|
990 | ]
|
---|
991 |
|
---|
992 | "Created: 1.4.1997 / 12:18:32 / cg"
|
---|
993 | "Modified: 1.4.1997 / 12:20:46 / cg"
|
---|
994 | !
|
---|
995 |
|
---|
996 | thumb
|
---|
997 | "for compatibility with scrollBars, return the receiver"
|
---|
998 |
|
---|
999 | ^ self
|
---|
1000 |
|
---|
1001 | "Created: 26.5.1996 / 12:21:12 / cg"
|
---|
1002 | !
|
---|
1003 |
|
---|
1004 | thumbColor
|
---|
1005 | "return the thumbs color"
|
---|
1006 |
|
---|
1007 | ^ thumbColor
|
---|
1008 | !
|
---|
1009 |
|
---|
1010 | thumbColor:aColor
|
---|
1011 | "change the color of the thumb"
|
---|
1012 |
|
---|
1013 | <resource: #style (#name)>
|
---|
1014 |
|
---|
1015 | |avgColor graphicsDevice|
|
---|
1016 |
|
---|
1017 | graphicsDevice := device.
|
---|
1018 | thumbColor := aColor onDevice:graphicsDevice.
|
---|
1019 | (styleSheet name ~~ #normal) ifTrue:[
|
---|
1020 | avgColor := aColor averageColorIn:(0@0 corner:7@7).
|
---|
1021 | thumbShadowColor := avgColor darkened onDevice:graphicsDevice.
|
---|
1022 | thumbLightColor := avgColor lightened onDevice:graphicsDevice.
|
---|
1023 | thumbHalfShadowColor := thumbShadowColor darkened onDevice:graphicsDevice.
|
---|
1024 | thumbHalfLightColor := thumbLightColor lightened onDevice:graphicsDevice.
|
---|
1025 | ].
|
---|
1026 | self invalidate
|
---|
1027 |
|
---|
1028 | "Modified: 8.2.1997 / 15:15:58 / cg"
|
---|
1029 | ! !
|
---|
1030 |
|
---|
1031 | !Scroller methodsFor:'autoRepeat'!
|
---|
1032 |
|
---|
1033 | installRepeat
|
---|
1034 | self installRepeat:repeatDelay.
|
---|
1035 | !
|
---|
1036 |
|
---|
1037 | installRepeat:repeatDelay
|
---|
1038 | |repeatBlockCopy|
|
---|
1039 |
|
---|
1040 | "protect against races"
|
---|
1041 | repeatBlockCopy := repeatBlock.
|
---|
1042 | repeatBlockCopy notNil ifTrue:[
|
---|
1043 | self repairDamage.
|
---|
1044 | Processor addTimedBlock:repeatBlockCopy afterSeconds:repeatDelay
|
---|
1045 | ]
|
---|
1046 | !
|
---|
1047 |
|
---|
1048 | pagedAbovePointer
|
---|
1049 | lastMousePosition notNil ifTrue:[
|
---|
1050 | orientation == #horizontal ifTrue:[
|
---|
1051 | ^ lastMousePosition x > thumbFrame center x
|
---|
1052 | ] ifFalse:[
|
---|
1053 | ^ lastMousePosition y > thumbFrame center y
|
---|
1054 | ].
|
---|
1055 | ].
|
---|
1056 | ^ false.
|
---|
1057 | !
|
---|
1058 |
|
---|
1059 | pagedBelowPointer
|
---|
1060 | lastMousePosition notNil ifTrue:[
|
---|
1061 | thumbFrame isNil ifTrue:[
|
---|
1062 | self computeThumbFrame.
|
---|
1063 | thumbFrame isNil ifTrue:[^ false].
|
---|
1064 | ].
|
---|
1065 | orientation == #horizontal ifTrue:[
|
---|
1066 | ^ lastMousePosition x < thumbFrame center x
|
---|
1067 | ] ifFalse:[
|
---|
1068 | ^ lastMousePosition y < thumbFrame center y
|
---|
1069 | ].
|
---|
1070 | ].
|
---|
1071 | ^ false.
|
---|
1072 | !
|
---|
1073 |
|
---|
1074 | repeatPageDown
|
---|
1075 | repeatBlock notNil ifTrue:[
|
---|
1076 | "stop scroll"
|
---|
1077 | (DefaultStopPagerAtThumb and:[self pagedBelowPointer]) ifTrue:[^ self].
|
---|
1078 | self repairDamage.
|
---|
1079 | self pageDown.
|
---|
1080 | self installRepeat.
|
---|
1081 | ]
|
---|
1082 | !
|
---|
1083 |
|
---|
1084 | repeatPageUp
|
---|
1085 | repeatBlock notNil ifTrue:[
|
---|
1086 | "stop scroll"
|
---|
1087 | (DefaultStopPagerAtThumb and:[self pagedAbovePointer]) ifTrue:[^ self].
|
---|
1088 | self repairDamage.
|
---|
1089 | self pageUp.
|
---|
1090 | self installRepeat.
|
---|
1091 | ]
|
---|
1092 | ! !
|
---|
1093 |
|
---|
1094 | !Scroller methodsFor:'drawing'!
|
---|
1095 |
|
---|
1096 | drawEdgedLineFrom:x1 y:y1 toX:x2 y:y2 level:lvl lightColor:lightColor shadowColor:shadowColor
|
---|
1097 | |color1 color2 x y dl|
|
---|
1098 |
|
---|
1099 | "iris style - draw tallys"
|
---|
1100 |
|
---|
1101 | lvl > 0 ifTrue:[
|
---|
1102 | color1 := lightColor.
|
---|
1103 | color2 := shadowColor.
|
---|
1104 | ] ifFalse:[
|
---|
1105 | color1 := shadowColor.
|
---|
1106 | color2 := lightColor.
|
---|
1107 | ].
|
---|
1108 |
|
---|
1109 | dl := 1.
|
---|
1110 |
|
---|
1111 | self paint:color1.
|
---|
1112 | x1 = x2 ifTrue:[
|
---|
1113 | "/ vertical
|
---|
1114 | self displayLineFromX:x1 y:y1-dl toX:x2 y:y2-dl.
|
---|
1115 | self paint:color2.
|
---|
1116 | x := x1 + 1.
|
---|
1117 | self displayLineFromX:x y:y1 toX:x y:y2.
|
---|
1118 | ] ifFalse:[
|
---|
1119 | "/ horizontal
|
---|
1120 | self displayLineFromX:x1-dl y:y1 toX:x2-dl y:y2.
|
---|
1121 | self paint:color2.
|
---|
1122 | y := y1 + 1.
|
---|
1123 | self displayLineFromX:x1 y:y toX:x2 y:y.
|
---|
1124 | ].
|
---|
1125 | !
|
---|
1126 |
|
---|
1127 | drawHandleFormAtX:x y:y
|
---|
1128 | "styles with a handle in the middle (NeXT) use this"
|
---|
1129 |
|
---|
1130 | thumbShadowColor := thumbShadowColor onDevice:device.
|
---|
1131 |
|
---|
1132 | self paint:thumbShadowColor.
|
---|
1133 | self displayForm:shadowForm x:x y:y.
|
---|
1134 | lightForm notNil ifTrue:[
|
---|
1135 | thumbLightColor := thumbLightColor onDevice:device.
|
---|
1136 | self paint:thumbLightColor.
|
---|
1137 | self displayForm:lightForm x:x y:y.
|
---|
1138 | ].
|
---|
1139 |
|
---|
1140 | "Modified: / 19.5.1998 / 16:26:49 / cg"
|
---|
1141 | !
|
---|
1142 |
|
---|
1143 | drawTallyMarks
|
---|
1144 | "draw the thumb"
|
---|
1145 |
|
---|
1146 | |color1 color2
|
---|
1147 | lvl "{ Class: SmallInteger }"
|
---|
1148 | t "{ Class: SmallInteger }"
|
---|
1149 | l "{ Class: SmallInteger }"
|
---|
1150 | w "{ Class: SmallInteger }"
|
---|
1151 | h "{ Class: SmallInteger }"
|
---|
1152 | x "{ Class: SmallInteger }"
|
---|
1153 | y "{ Class: SmallInteger }"
|
---|
1154 | xL xR yT yB dist yTop yBot xLeft xRight
|
---|
1155 | light shadow|
|
---|
1156 |
|
---|
1157 | "iris style - draw tallys"
|
---|
1158 |
|
---|
1159 | lvl := thumbLevel.
|
---|
1160 | scrolling ifTrue:[
|
---|
1161 | lvl := thumbActiveLevel
|
---|
1162 | ].
|
---|
1163 |
|
---|
1164 | thumbFrame isNil ifTrue:[^ self].
|
---|
1165 | w := thumbFrame width.
|
---|
1166 | h := thumbFrame height.
|
---|
1167 | l := thumbFrame left.
|
---|
1168 | t := thumbFrame top.
|
---|
1169 |
|
---|
1170 | light := thumbLightColor.
|
---|
1171 | shadow := thumbShadowColor.
|
---|
1172 | (styleSheet at:#'scroller.vista3DStyle' default:false) "styleSheet name == #winVista" ifTrue:[
|
---|
1173 | light := (entered ifTrue:[thumbEnteredColor] ifFalse:[thumbColor]) lightened.
|
---|
1174 | shadow := (entered ifTrue:[thumbEnteredColor] ifFalse:[thumbColor]) darkened.
|
---|
1175 | ].
|
---|
1176 |
|
---|
1177 | tallyLevel > 0 ifTrue:[
|
---|
1178 | color1 := light.
|
---|
1179 | color2 := shadow.
|
---|
1180 | ] ifFalse:[
|
---|
1181 | color1 := shadow.
|
---|
1182 | color2 := light.
|
---|
1183 | ].
|
---|
1184 |
|
---|
1185 | "draw tally marks"
|
---|
1186 |
|
---|
1187 | (orientation == #vertical) ifTrue:[
|
---|
1188 | y := t + (h // 2) - 1.
|
---|
1189 | xL := l + lvl - 1 + DefaultTallyInset.
|
---|
1190 | xR := l + w - lvl + 1 - DefaultTallyInset.
|
---|
1191 |
|
---|
1192 | dist := DefaultTallyDistance ? device verticalPixelPerMillimeter rounded.
|
---|
1193 |
|
---|
1194 | tallyMarks even ifTrue:[
|
---|
1195 | yTop := y - (dist // 2).
|
---|
1196 | yBot := y + (dist - (dist // 2)).
|
---|
1197 | self drawEdgedLineFrom:xL y:yTop toX:xR y:yTop level:tallyLevel lightColor:light shadowColor:shadow.
|
---|
1198 | self drawEdgedLineFrom:xL y:yBot toX:xR y:yBot level:tallyLevel lightColor:light shadowColor:shadow.
|
---|
1199 | ] ifFalse:[
|
---|
1200 | self drawEdgedLineFrom:xL y:y toX:xR y:y level:tallyLevel lightColor:light shadowColor:shadow.
|
---|
1201 | yTop := yBot := y.
|
---|
1202 | ].
|
---|
1203 |
|
---|
1204 | tallyMarks > 1 ifTrue:[
|
---|
1205 | "dont draw other marks if there is not enough space"
|
---|
1206 |
|
---|
1207 | h > (dist * (tallyMarks * 2)) ifTrue:[
|
---|
1208 | self drawEdgedLineFrom:xL y:(yTop - dist) toX:xR y:(yTop - dist) level:tallyLevel lightColor:light shadowColor:shadow.
|
---|
1209 | self drawEdgedLineFrom:xL y:(yBot + dist) toX:xR y:(yBot + dist) level:tallyLevel lightColor:light shadowColor:shadow.
|
---|
1210 | ]
|
---|
1211 | ]
|
---|
1212 | ] ifFalse:[
|
---|
1213 | x := l + (w // 2) - 1.
|
---|
1214 | yT := t + lvl - 1 + DefaultTallyInset.
|
---|
1215 | yB := t + h - lvl + 1 - DefaultTallyInset.
|
---|
1216 |
|
---|
1217 | dist := DefaultTallyDistance ? device horizontalPixelPerMillimeter rounded.
|
---|
1218 |
|
---|
1219 | tallyMarks even ifTrue:[
|
---|
1220 | xLeft := x - (dist // 2).
|
---|
1221 | xRight := x + (dist - (dist // 2)).
|
---|
1222 | self drawEdgedLineFrom:xLeft y:yT toX:xLeft y:yB level:tallyLevel lightColor:light shadowColor:shadow.
|
---|
1223 | self drawEdgedLineFrom:xRight y:yT toX:xRight y:yB level:tallyLevel lightColor:light shadowColor:shadow.
|
---|
1224 | ] ifFalse:[
|
---|
1225 | self drawEdgedLineFrom:x y:yT toX:x y:yB level:tallyLevel lightColor:light shadowColor:shadow.
|
---|
1226 | xLeft := xRight := x.
|
---|
1227 | ].
|
---|
1228 | tallyMarks > 1 ifTrue:[
|
---|
1229 | "dont draw other marks if there is not enough space"
|
---|
1230 |
|
---|
1231 | w > (dist * (tallyMarks * 2)) ifTrue:[
|
---|
1232 | self drawEdgedLineFrom:(xLeft - dist) y:yT toX:(xLeft - dist) y:yB level:tallyLevel lightColor:light shadowColor:shadow.
|
---|
1233 | self drawEdgedLineFrom:(xRight + dist) y:yT toX:(xRight + dist) y:yB level:tallyLevel lightColor:light shadowColor:shadow.
|
---|
1234 | ]
|
---|
1235 | ]
|
---|
1236 | ]
|
---|
1237 |
|
---|
1238 | "Modified: / 29.4.1999 / 09:35:52 / cg"
|
---|
1239 | !
|
---|
1240 |
|
---|
1241 | drawThumb
|
---|
1242 | "draw the thumb"
|
---|
1243 |
|
---|
1244 | |handleX handleY l t lvl
|
---|
1245 | w "{ Class: SmallInteger }"
|
---|
1246 | h "{ Class: SmallInteger }"
|
---|
1247 | clr clr2 styleName xpStyle vistaStyle n frameImageOrNil frameImage|
|
---|
1248 |
|
---|
1249 | (thumbHeight >= 100) ifTrue:[^ self].
|
---|
1250 | thumbFrame isNil ifTrue:[^ self].
|
---|
1251 |
|
---|
1252 | styleName := styleSheet name.
|
---|
1253 | xpStyle := styleName == #winXP.
|
---|
1254 | vistaStyle := styleSheet at:#'scroller.vista3DStyle' default:false. "/ styleName == #winVista.
|
---|
1255 |
|
---|
1256 | w := thumbFrame width.
|
---|
1257 | h := thumbFrame height.
|
---|
1258 | l := thumbFrame left.
|
---|
1259 | t := thumbFrame top.
|
---|
1260 |
|
---|
1261 | (scrolling and:[thumbActiveColor notNil]) ifTrue:[
|
---|
1262 | clr := thumbActiveColor
|
---|
1263 | ] ifFalse:[
|
---|
1264 | clr := entered
|
---|
1265 | ifTrue:[thumbEnteredColor]
|
---|
1266 | ifFalse:[thumbColor].
|
---|
1267 | ].
|
---|
1268 |
|
---|
1269 | clr notNil ifTrue:[
|
---|
1270 | (styleSheet at:#'scroller.vista3DStyle' default:false) ifTrue:[
|
---|
1271 | "/ color gradient drawing
|
---|
1272 | "/ with colors rougly smilar to the vista colors, which are:
|
---|
1273 | "/ 243 242 240 236 234 233 215 211 207 205 200 192 206
|
---|
1274 | clr2 := styleSheet colorAt:#'scroller.vista3DStyleLightColor' default:Color white.
|
---|
1275 |
|
---|
1276 | (orientation == #vertical) ifTrue:[
|
---|
1277 | n := w
|
---|
1278 | ] ifFalse:[
|
---|
1279 | n := h
|
---|
1280 | ].
|
---|
1281 | 1 to:n-1 do:[:i |
|
---|
1282 | |m|
|
---|
1283 |
|
---|
1284 | i == (n-1) ifTrue:[
|
---|
1285 | m := 0.4.
|
---|
1286 | ] ifFalse:[
|
---|
1287 | i <= (n//2) ifTrue:[
|
---|
1288 | i <= (n//4) ifTrue:[
|
---|
1289 | m := 3.
|
---|
1290 | ] ifFalse:[
|
---|
1291 | i <= (n//3) ifTrue:[
|
---|
1292 | m := 2.5.
|
---|
1293 | ] ifFalse:[
|
---|
1294 | m := 2.
|
---|
1295 | ].
|
---|
1296 | ].
|
---|
1297 | ] ifFalse:[
|
---|
1298 | i > (n*3//4) ifTrue:[
|
---|
1299 | i > (n*4//5) ifTrue:[
|
---|
1300 | m := 0.
|
---|
1301 | ] ifFalse:[
|
---|
1302 | m := 0.2.
|
---|
1303 | ]
|
---|
1304 | ] ifFalse:[
|
---|
1305 | i > (n*2//3) ifTrue:[
|
---|
1306 | m := 0.4
|
---|
1307 | ] ifFalse:[
|
---|
1308 | m := 0.8.
|
---|
1309 | ].
|
---|
1310 | ].
|
---|
1311 | ].
|
---|
1312 | ].
|
---|
1313 | self paint:(clr2 mixed:m with:clr).
|
---|
1314 | (orientation == #vertical) ifTrue:[
|
---|
1315 | self displayLineFromX:(l+i-1) y:t+1 toX:(l+i-1) y:(t+h-2)
|
---|
1316 | ] ifFalse:[
|
---|
1317 | self displayLineFromX:(l+1) y:(t+i-1) toX:(l+w-2) y:(t+i-1)
|
---|
1318 | ].
|
---|
1319 | ].
|
---|
1320 | ] ifFalse:[
|
---|
1321 | self paint:clr.
|
---|
1322 | (xpStyle and:[self isMiniScroller not]) ifTrue:[
|
---|
1323 | "/ hack for xp
|
---|
1324 | (orientation == #vertical) ifTrue:[
|
---|
1325 | self fillRectangleX:l y:t+1 width:w-2 height:h-4.
|
---|
1326 | ] ifFalse:[
|
---|
1327 | self fillRectangleX:l+1 y:t width:w-4 height:h-2.
|
---|
1328 | ]
|
---|
1329 | ] ifFalse:[
|
---|
1330 | (styleSheet at:#'scroller.roundStyle' default:false) ifTrue:[
|
---|
1331 | "/ hack for osx
|
---|
1332 | (orientation == #vertical) ifTrue:[
|
---|
1333 | 1 to:3 do:[:i |
|
---|
1334 | |yLine left right|
|
---|
1335 |
|
---|
1336 | left := l+i-1.
|
---|
1337 | right := l+w-i+1.
|
---|
1338 | yLine := t+3-i.
|
---|
1339 | self displayLineFromX:left y:yLine toX:right y:yLine.
|
---|
1340 | yLine := t+h-3-1+i.
|
---|
1341 | self displayLineFromX:left y:yLine toX:right y:yLine.
|
---|
1342 | ].
|
---|
1343 | self fillRectangleX:l y:t+3 width:w height:h-6.
|
---|
1344 | ] ifFalse:[
|
---|
1345 | 1 to:3 do:[:i |
|
---|
1346 | |xLine top bot|
|
---|
1347 |
|
---|
1348 | top := t+i-1.
|
---|
1349 | bot := t+h-i+1.
|
---|
1350 | xLine := l+3-i.
|
---|
1351 | self displayLineFromX:xLine y:top toX:xLine y:bot.
|
---|
1352 | xLine := l+w-3-1+i.
|
---|
1353 | self displayLineFromX:xLine y:top toX:xLine y:bot.
|
---|
1354 | ].
|
---|
1355 | self fillRectangleX:l+3 y:t width:w-6 height:h.
|
---|
1356 | ].
|
---|
1357 | ] ifFalse:[
|
---|
1358 | self fillRectangleX:l y:t width:w height:h.
|
---|
1359 | ].
|
---|
1360 | ].
|
---|
1361 | ].
|
---|
1362 | ].
|
---|
1363 | lvl := thumbLevel.
|
---|
1364 | scrolling ifTrue:[
|
---|
1365 | lvl := thumbActiveLevel
|
---|
1366 | ].
|
---|
1367 |
|
---|
1368 | lvl ~~ 0 ifTrue:[
|
---|
1369 | self drawEdgesForX:l y:t width:w height:h level:lvl
|
---|
1370 | shadow:thumbShadowColor light:thumbLightColor
|
---|
1371 | halfShadow:thumbHalfShadowColor halfLight:thumbHalfLightColor
|
---|
1372 | style:thumbEdgeStyle.
|
---|
1373 | ].
|
---|
1374 | frameImageOrNil := (orientation == #vertical)
|
---|
1375 | ifTrue:[ DefaultVerticalThumbFrameImage ]
|
---|
1376 | ifFalse:[ DefaultHorizontalThumbFrameImage ].
|
---|
1377 | frameImageOrNil notNil ifTrue:[
|
---|
1378 | frameImage := frameImageOrNil magnifiedTo:(w @ h).
|
---|
1379 | frameImage displayOn:self x:l y:t
|
---|
1380 | ].
|
---|
1381 |
|
---|
1382 | self isMiniScroller ifTrue:[^ self].
|
---|
1383 |
|
---|
1384 | thumbFrameColor notNil ifTrue:[
|
---|
1385 | clr2 := styleSheet colorAt:#'scroller.thumbFrameColor2'.
|
---|
1386 | clr2 notNil ifTrue:[
|
---|
1387 | self paint:clr2.
|
---|
1388 | (orientation == #vertical) ifTrue:[
|
---|
1389 | self displayLineFromX:l+w-2 y:t+1 toX:l+w-2 y:t+h-3.
|
---|
1390 | self displayLineFromX:l y:t+h-3 toX:l+w-2 y:t+h-3.
|
---|
1391 | ] ifFalse:[
|
---|
1392 | self displayLineFromX:l+2 y:t+h-2 toX:l+w-3 y:t+h-2.
|
---|
1393 | self displayLineFromX:l+w-3 y:t toX:l+w-3 y:t+h-2.
|
---|
1394 | ].
|
---|
1395 | ].
|
---|
1396 |
|
---|
1397 | vistaStyle ifTrue:[
|
---|
1398 | self paint:clr slightlyDarkened.
|
---|
1399 | ] ifFalse:[
|
---|
1400 | self paint:thumbFrameColor.
|
---|
1401 | ].
|
---|
1402 | xpStyle ifTrue:[
|
---|
1403 | (orientation == #vertical) ifTrue:[
|
---|
1404 | self displayLineFromX:l+w-1 y:t+1 toX:l+w-1 y:t+h-3.
|
---|
1405 | self displayLineFromX:l+1 y:t+h-2 toX:l+w-2 y:t+h-2.
|
---|
1406 | self displayLineFromX:l+w-2 y:t+h-3 toX:l+w-2 y:t+h-3.
|
---|
1407 | "/ self displayLineFromX:l-2 y:t+h-3 toX:l-2 y:t+h-3.
|
---|
1408 | ] ifFalse:[
|
---|
1409 | self displayLineFromX:l+2 y:t+h-1 toX:l+w-3 y:t+h-1.
|
---|
1410 | self displayLineFromX:l+w-2 y:t+1 toX:l+w-2 y:t+h-2.
|
---|
1411 | self displayLineFromX:l+w-3 y:t+h-2 toX:l+w-3 y:t+h-2.
|
---|
1412 | ].
|
---|
1413 | ] ifFalse:[
|
---|
1414 | h := h - 1.
|
---|
1415 | self displayRectangleX:l y:t width:w height:h.
|
---|
1416 | ].
|
---|
1417 | vistaStyle ifTrue:[
|
---|
1418 | self paint:clr lightened.
|
---|
1419 | self displayPointX:l y:t.
|
---|
1420 | self displayPointX:l+w-1 y:t.
|
---|
1421 | self displayPointX:l y:t+h-1.
|
---|
1422 | self displayPointX:l+w-1 y:t+h-1.
|
---|
1423 | ].
|
---|
1424 | ].
|
---|
1425 |
|
---|
1426 | thumbImage notNil ifTrue:[
|
---|
1427 | thumbImage displayOn:self x:l y:t
|
---|
1428 | ].
|
---|
1429 |
|
---|
1430 | (false "tallyLevel == 0" or:[tallyMarks == 0]) ifTrue:[
|
---|
1431 | shadowForm notNil ifTrue:[
|
---|
1432 | "next style - draw tally bitmap"
|
---|
1433 | handleX := l + ((w - 8) // 2).
|
---|
1434 | handleY := t + ((h - 8) // 2).
|
---|
1435 | self drawHandleFormAtX:handleX y:handleY
|
---|
1436 | ].
|
---|
1437 | ^ self
|
---|
1438 | ].
|
---|
1439 |
|
---|
1440 | "iris style - draw tallys"
|
---|
1441 | self drawTallyMarks.
|
---|
1442 |
|
---|
1443 | "Modified: / 29-11-2011 / 11:55:24 / cg"
|
---|
1444 | !
|
---|
1445 |
|
---|
1446 | drawThumbBackgroundInX:x y:y width:w height:h
|
---|
1447 | "draw part of the thumbs background; defined as a separate
|
---|
1448 | method, to allow drawing of arbitrary patterns under thumb
|
---|
1449 | (see ColorSlider)."
|
---|
1450 |
|
---|
1451 | |oldClip gX gY gW gH|
|
---|
1452 |
|
---|
1453 | shown ifTrue:[
|
---|
1454 | oldClip := self clippingRectangleOrNil.
|
---|
1455 | self clippingRectangle:(Rectangle left:x top:y width:w height:h).
|
---|
1456 | self clearDeviceRectangleX:x y:y width:w height:h.
|
---|
1457 |
|
---|
1458 | styleSheet name == #winVista ifTrue:[
|
---|
1459 | self paint:(Color greyByte:16rE3).
|
---|
1460 | (orientation == #vertical) ifTrue:[
|
---|
1461 | self displayLineFromX:0 y:0 toX:0 y:height-1.
|
---|
1462 | self displayLineFromX:1 y:0 toX:1 y:height-1.
|
---|
1463 | ] ifFalse:[
|
---|
1464 | self displayLineFromX:0 y:0 toX:width-1 y:0.
|
---|
1465 | self displayLineFromX:0 y:1 toX:width-1 y:1.
|
---|
1466 | ].
|
---|
1467 | ].
|
---|
1468 |
|
---|
1469 | frameBeforeMove notNil ifTrue:[
|
---|
1470 | (ghostColor notNil
|
---|
1471 | or:[ghostFrameColor notNil
|
---|
1472 | or:[ghostLevel ~~ 0]]) ifTrue:[
|
---|
1473 | (frameBeforeMove intersects:(x@y extent:w@h)) ifTrue:[
|
---|
1474 | gX := frameBeforeMove left.
|
---|
1475 | gY := frameBeforeMove top.
|
---|
1476 | gW := frameBeforeMove width.
|
---|
1477 | gH := frameBeforeMove height.
|
---|
1478 |
|
---|
1479 | ghostColor notNil ifTrue:[
|
---|
1480 | self paint:ghostColor.
|
---|
1481 | self fillRectangle:frameBeforeMove.
|
---|
1482 | ].
|
---|
1483 | (ghostLevel ~~ 0) ifTrue:[
|
---|
1484 | self drawEdgesForX:gX y:gY width:gW height:gH level:ghostLevel
|
---|
1485 | ].
|
---|
1486 | ghostFrameColor notNil ifTrue:[
|
---|
1487 | self paint:ghostFrameColor.
|
---|
1488 | self displayRectangleX:gX y:gY width:gW height:gH
|
---|
1489 | ].
|
---|
1490 | ]
|
---|
1491 | ]
|
---|
1492 | ].
|
---|
1493 | self clippingRectangle:oldClip
|
---|
1494 | ]
|
---|
1495 |
|
---|
1496 | "Modified: / 4.5.1999 / 18:51:53 / cg"
|
---|
1497 | ! !
|
---|
1498 |
|
---|
1499 | !Scroller methodsFor:'event handling'!
|
---|
1500 |
|
---|
1501 | buttonControlPress:button x:x y:y
|
---|
1502 | "mouse-click with control - jump to top/bottom"
|
---|
1503 |
|
---|
1504 | |curr limit1 limit2|
|
---|
1505 |
|
---|
1506 | thumbFrame isNil ifTrue:[
|
---|
1507 | self computeThumbFrame.
|
---|
1508 | thumbFrame isNil ifTrue:[
|
---|
1509 | ^ self.
|
---|
1510 | ]
|
---|
1511 | ].
|
---|
1512 | (orientation == #vertical) ifTrue:[
|
---|
1513 | curr := y.
|
---|
1514 | limit1 := thumbFrame top.
|
---|
1515 | limit2 := thumbFrame bottom
|
---|
1516 | ] ifFalse:[
|
---|
1517 | curr := x.
|
---|
1518 | limit1 := thumbFrame left.
|
---|
1519 | limit2 := thumbFrame right
|
---|
1520 | ].
|
---|
1521 |
|
---|
1522 | (curr < limit1) ifTrue:[
|
---|
1523 | "to top"
|
---|
1524 | self thumbOrigin:0.
|
---|
1525 | self tellOthers
|
---|
1526 | ] ifFalse:[
|
---|
1527 | (curr > limit2) ifTrue:[
|
---|
1528 | "to bottom"
|
---|
1529 | self thumbOrigin:100.
|
---|
1530 | self tellOthers
|
---|
1531 | ]
|
---|
1532 | ].
|
---|
1533 | !
|
---|
1534 |
|
---|
1535 | buttonMotion:state x:x y:y
|
---|
1536 | "mouse-button was moved while pressed;
|
---|
1537 | redraw thumb at its new position and, if scroll-mode is asynchronous,
|
---|
1538 | the scroll action is performed"
|
---|
1539 |
|
---|
1540 | <resource: #style (#name
|
---|
1541 | #'scroller.snapBack')>
|
---|
1542 |
|
---|
1543 | |pos curr limit prevOrigin newOrigin snap|
|
---|
1544 |
|
---|
1545 | lastMousePosition := x@y.
|
---|
1546 |
|
---|
1547 | (self sensor hasButtonMotionEventFor:self) ifTrue:[
|
---|
1548 | ^ self.
|
---|
1549 | ].
|
---|
1550 |
|
---|
1551 | enabled ifFalse:[^ self].
|
---|
1552 |
|
---|
1553 | scrolling ifFalse: [
|
---|
1554 | thumbFrame notNil ifTrue:[
|
---|
1555 | self highlightThumbForPointerX:x y:y.
|
---|
1556 | ].
|
---|
1557 | ^ self
|
---|
1558 | ].
|
---|
1559 |
|
---|
1560 | entered := true.
|
---|
1561 | frameBeforeMove isNil ifTrue:[
|
---|
1562 | self startMove.
|
---|
1563 | ].
|
---|
1564 |
|
---|
1565 | (orientation == #vertical) ifTrue:[
|
---|
1566 | curr := y.
|
---|
1567 | limit := height.
|
---|
1568 | snap := (x < SnapBackDistance negated) or:[x > (width + SnapBackDistance)].
|
---|
1569 | ] ifFalse:[
|
---|
1570 | curr := x.
|
---|
1571 | limit := width.
|
---|
1572 | snap := (y < SnapBackDistance negated) or:[y > (height + SnapBackDistance)].
|
---|
1573 | ].
|
---|
1574 |
|
---|
1575 | (curr < 0) ifTrue:[ "check against limits"
|
---|
1576 | pos := 0
|
---|
1577 | ] ifFalse:[
|
---|
1578 | (curr > limit) ifTrue:[
|
---|
1579 | pos := limit
|
---|
1580 | ] ifFalse:[
|
---|
1581 | pos := curr
|
---|
1582 | ]
|
---|
1583 | ].
|
---|
1584 |
|
---|
1585 | prevOrigin := self thumbOrigin.
|
---|
1586 | newOrigin := self percentFromAbs:(pos - pressOffset).
|
---|
1587 |
|
---|
1588 | snap ifTrue:[
|
---|
1589 | (styleSheet at:#'scroller.snapBack' default:false) ifTrue:[
|
---|
1590 | newOrigin := originBeforeMove.
|
---|
1591 | ]
|
---|
1592 | ].
|
---|
1593 |
|
---|
1594 | prevOrigin ~= newOrigin ifTrue:[
|
---|
1595 | self thumbOrigin:newOrigin.
|
---|
1596 |
|
---|
1597 | synchronousOperation ifTrue: [
|
---|
1598 | self tellOthers.
|
---|
1599 | ]
|
---|
1600 | ]
|
---|
1601 |
|
---|
1602 | "Modified: / 14.4.1998 / 18:37:34 / cg"
|
---|
1603 | !
|
---|
1604 |
|
---|
1605 | buttonPress:button x:x y:y
|
---|
1606 | "button was pressed - if above thumb, page up; if below thumb, page down;
|
---|
1607 | otherwise start scrolling.
|
---|
1608 | If either shift is pressed, or the 'scrollerMiddleButtonJump' styleSheet
|
---|
1609 | value is true and its the middle button, do a jump to the clicked position."
|
---|
1610 |
|
---|
1611 | |curr limit1 limit2 sensor|
|
---|
1612 |
|
---|
1613 | enabled ifFalse:[^ self].
|
---|
1614 | shown ifFalse:[^ self].
|
---|
1615 | scrolling ifTrue:[^ self].
|
---|
1616 | "/virtualRange isNil ifTrue:[virtualRange := (rangeEnd-rangeStart)/2.].
|
---|
1617 |
|
---|
1618 | sensor := self sensor.
|
---|
1619 | (sensor shiftDown
|
---|
1620 | or:[DefaultMiddleButtonJump and:[button ~~ 1]]) ifTrue:[
|
---|
1621 | ^ self buttonShiftPress:button x:x y:y
|
---|
1622 | ].
|
---|
1623 | sensor ctrlDown ifTrue:[
|
---|
1624 | ^ self buttonControlPress:button x:x y:y
|
---|
1625 | ].
|
---|
1626 | (button ~~ #select and:[button ~~ 1]) ifTrue:[
|
---|
1627 | ^ self
|
---|
1628 | ].
|
---|
1629 |
|
---|
1630 | thumbFrame isNil ifTrue:[
|
---|
1631 | self computeThumbFrame.
|
---|
1632 | thumbFrame isNil ifTrue:[^ self].
|
---|
1633 | ].
|
---|
1634 |
|
---|
1635 | (orientation == #vertical) ifTrue:[
|
---|
1636 | curr := y.
|
---|
1637 | limit1 := thumbFrame top.
|
---|
1638 | limit2 := thumbFrame bottom
|
---|
1639 | ] ifFalse:[
|
---|
1640 | curr := x.
|
---|
1641 | limit1 := thumbFrame left.
|
---|
1642 | limit2 := thumbFrame right
|
---|
1643 | ].
|
---|
1644 |
|
---|
1645 | self highlightThumbForPointerX:x y:y.
|
---|
1646 | self changeCursorFor:(x@y).
|
---|
1647 |
|
---|
1648 | (curr < limit1) ifTrue:[
|
---|
1649 | "page up/left"
|
---|
1650 | self moveLeft.
|
---|
1651 | autoRepeat ifTrue:[
|
---|
1652 | repeatBlock notNil ifTrue:[
|
---|
1653 | Processor removeTimedBlock:repeatBlock.
|
---|
1654 | ].
|
---|
1655 | repeatBlock := [self sensor pushUserEvent:#repeatPageUp for:self].
|
---|
1656 | sensor pushUserEvent:#installRepeat: for:self withArgument:initialRepeatDelay.
|
---|
1657 | ]
|
---|
1658 | ] ifFalse:[
|
---|
1659 | (curr > limit2) ifTrue:[
|
---|
1660 | "page down/right"
|
---|
1661 | self moveRight.
|
---|
1662 | autoRepeat ifTrue:[
|
---|
1663 | repeatBlock notNil ifTrue:[
|
---|
1664 | Processor removeTimedBlock:repeatBlock.
|
---|
1665 | ].
|
---|
1666 | repeatBlock := [self sensor pushUserEvent:#repeatPageDown for:self].
|
---|
1667 | sensor pushUserEvent:#installRepeat: for:self withArgument:initialRepeatDelay.
|
---|
1668 | ]
|
---|
1669 | ] ifFalse:[
|
---|
1670 | pressOffset := curr - limit1.
|
---|
1671 | scrolling := true.
|
---|
1672 | (thumbActiveColor notNil and:[thumbColor ~~ thumbActiveColor]) ifTrue:[
|
---|
1673 | self drawThumb
|
---|
1674 | ]
|
---|
1675 | ]
|
---|
1676 | ].
|
---|
1677 |
|
---|
1678 | "Modified: / 02-02-1998 / 23:30:26 / stefan"
|
---|
1679 | "Modified: / 15-12-2010 / 10:13:10 / cg"
|
---|
1680 | "Modified (format): / 04-01-2017 / 13:29:34 / svestkap"
|
---|
1681 | !
|
---|
1682 |
|
---|
1683 | buttonRelease:button x:x y:y
|
---|
1684 | "mouse-button was released - if scroll-mode is asynchronous, the scroll
|
---|
1685 | action is now performed"
|
---|
1686 |
|
---|
1687 | |rect mustDrawThumb|
|
---|
1688 |
|
---|
1689 | lastMousePosition := nil.
|
---|
1690 |
|
---|
1691 | repeatBlock notNil ifTrue:[
|
---|
1692 | repeatBlock := nil.
|
---|
1693 | Processor removeTimedBlock:repeatBlock.
|
---|
1694 | repeatBlock := nil
|
---|
1695 | ].
|
---|
1696 |
|
---|
1697 | (button == 1 or:[DefaultMiddleButtonJump])
|
---|
1698 | ifFalse:[
|
---|
1699 | ^ super buttonRelease:button x:x y:y
|
---|
1700 | ].
|
---|
1701 |
|
---|
1702 |
|
---|
1703 | scrolling ifTrue:[
|
---|
1704 | scrolling := false.
|
---|
1705 | thumbFrame notNil ifTrue:[
|
---|
1706 | mustDrawThumb := false.
|
---|
1707 |
|
---|
1708 | frameBeforeMove notNil ifTrue:[
|
---|
1709 | rect := frameBeforeMove.
|
---|
1710 | frameBeforeMove := nil.
|
---|
1711 | self drawThumbBackgroundInX:rect left
|
---|
1712 | y:rect top
|
---|
1713 | width:rect width
|
---|
1714 | height:rect height.
|
---|
1715 |
|
---|
1716 | (rect intersects:thumbFrame) ifTrue:[
|
---|
1717 | mustDrawThumb := true.
|
---|
1718 | ]
|
---|
1719 | ].
|
---|
1720 | thumbLevel ~~ thumbActiveLevel ifTrue:[
|
---|
1721 | mustDrawThumb := true
|
---|
1722 | ].
|
---|
1723 | (thumbActiveColor notNil and:[thumbColor ~~ thumbActiveColor]) ifTrue:[
|
---|
1724 | mustDrawThumb := true
|
---|
1725 | ].
|
---|
1726 | mustDrawThumb ifTrue:[
|
---|
1727 | self drawThumb
|
---|
1728 | ].
|
---|
1729 |
|
---|
1730 | "/ scrolling := false.
|
---|
1731 | synchronousOperation ifFalse: [
|
---|
1732 | self tellOthers.
|
---|
1733 | ]
|
---|
1734 | ]
|
---|
1735 | ].
|
---|
1736 | self changeCursorFor:(x@y)
|
---|
1737 |
|
---|
1738 | "Modified: / 19-01-1998 / 13:45:59 / cg"
|
---|
1739 | "Modified: / 02-02-1998 / 23:37:27 / stefan"
|
---|
1740 | "Modified: / 02-01-2017 / 13:51:29 / svestkap"
|
---|
1741 | !
|
---|
1742 |
|
---|
1743 | buttonShiftPress:button x:x y:y
|
---|
1744 | "mouse-click with shift - jump to position"
|
---|
1745 |
|
---|
1746 | |pos curr curr2 limit1 limit2|
|
---|
1747 |
|
---|
1748 | thumbFrame isNil ifTrue:[
|
---|
1749 | self computeThumbFrame.
|
---|
1750 | thumbFrame isNil ifTrue:[
|
---|
1751 | ^ self.
|
---|
1752 | ]
|
---|
1753 | ].
|
---|
1754 | (orientation == #vertical) ifTrue:[
|
---|
1755 | curr := y.
|
---|
1756 | curr2 := y - (thumbFrame height // 2).
|
---|
1757 | limit1 := height.
|
---|
1758 | limit2 := thumbFrame top
|
---|
1759 | ] ifFalse:[
|
---|
1760 | curr := x.
|
---|
1761 | curr2 := x - (thumbFrame width // 2).
|
---|
1762 | limit1 := width.
|
---|
1763 | limit2 := thumbFrame left
|
---|
1764 | ].
|
---|
1765 |
|
---|
1766 | (curr2 < 0) ifTrue:[ "check against limits"
|
---|
1767 | pos := 0
|
---|
1768 | ] ifFalse:[
|
---|
1769 | (curr2 > limit1) ifTrue:[
|
---|
1770 | pos := limit1
|
---|
1771 | ] ifFalse:[
|
---|
1772 | pos := curr2
|
---|
1773 | ]
|
---|
1774 | ].
|
---|
1775 |
|
---|
1776 | self startMove.
|
---|
1777 |
|
---|
1778 | self thumbOrigin:(self percentFromAbs:pos).
|
---|
1779 | self tellOthers.
|
---|
1780 |
|
---|
1781 | (orientation == #vertical) ifTrue:[
|
---|
1782 | limit2 := thumbFrame top
|
---|
1783 | ] ifFalse:[
|
---|
1784 | limit2 := thumbFrame left
|
---|
1785 | ].
|
---|
1786 | pressOffset := curr - limit2.
|
---|
1787 | scrolling := true.
|
---|
1788 |
|
---|
1789 | self changeCursorFor:(x@y).
|
---|
1790 |
|
---|
1791 |
|
---|
1792 | "Modified: / 19.3.1997 / 11:29:08 / cg"
|
---|
1793 | "Modified: / 2.2.1998 / 23:35:18 / stefan"
|
---|
1794 | !
|
---|
1795 |
|
---|
1796 | changeCursorFor:p
|
---|
1797 | "update the mouse cursor"
|
---|
1798 |
|
---|
1799 | |frm sensor which|
|
---|
1800 |
|
---|
1801 | enabled ifFalse:[
|
---|
1802 | self cursor:Cursor normal.
|
---|
1803 | ^ self
|
---|
1804 | ].
|
---|
1805 | NewCursors ifFalse:[^ self].
|
---|
1806 |
|
---|
1807 | frm := self thumbFrame.
|
---|
1808 | frm isNil ifTrue:[^ self].
|
---|
1809 |
|
---|
1810 | thumbHeight = 100 ifTrue:[
|
---|
1811 | which := #normal.
|
---|
1812 | ] ifFalse:[
|
---|
1813 | sensor := self sensor.
|
---|
1814 |
|
---|
1815 | (((frm containsPoint:p) and:[sensor leftButtonPressed])
|
---|
1816 | "or:[sensor shiftDown]") ifTrue:[
|
---|
1817 | orientation == #horizontal ifTrue:[
|
---|
1818 | which := #xMarker
|
---|
1819 | ] ifFalse:[
|
---|
1820 | which := #marker
|
---|
1821 | ].
|
---|
1822 | ] ifFalse:[
|
---|
1823 | orientation == #horizontal ifTrue:[
|
---|
1824 | p x > frm right ifTrue:[
|
---|
1825 | which := #right
|
---|
1826 | ] ifFalse:[
|
---|
1827 | p x < frm left ifTrue:[
|
---|
1828 | which := #left
|
---|
1829 | ] ifFalse:[
|
---|
1830 | which := #hand
|
---|
1831 | ]
|
---|
1832 | ]
|
---|
1833 | ] ifFalse:[
|
---|
1834 | p y > frm bottom ifTrue:[
|
---|
1835 | which := #down
|
---|
1836 | ] ifFalse:[
|
---|
1837 | p y < frm top ifTrue:[
|
---|
1838 | which := #up
|
---|
1839 | ] ifFalse:[
|
---|
1840 | which := #hand
|
---|
1841 | ]
|
---|
1842 | ]
|
---|
1843 | ]
|
---|
1844 | ]
|
---|
1845 | ].
|
---|
1846 | self cursor:(Cursor perform:which).
|
---|
1847 |
|
---|
1848 | "Created: / 23.10.1997 / 03:55:24 / cg"
|
---|
1849 | "Modified: / 7.5.1998 / 02:06:10 / cg"
|
---|
1850 | !
|
---|
1851 |
|
---|
1852 | highlightThumbForPointerX:x y:y
|
---|
1853 | "if x/y is within the thumb frame, highlight it"
|
---|
1854 |
|
---|
1855 | |frm in|
|
---|
1856 |
|
---|
1857 | in := (frm := self thumbFrame) containsPoint:(x@y).
|
---|
1858 | (in ~~ entered
|
---|
1859 | or:[thumbLevel ~~ thumbActiveLevel]) ifTrue:[
|
---|
1860 | entered := in.
|
---|
1861 | (thumbColor ~~ thumbEnteredColor
|
---|
1862 | or:[thumbLevel ~~ thumbActiveLevel]) ifTrue: [
|
---|
1863 | self drawThumb
|
---|
1864 | ].
|
---|
1865 | ].
|
---|
1866 |
|
---|
1867 | self changeCursorFor:(x@y)
|
---|
1868 |
|
---|
1869 | "Created: 6.3.1996 / 17:35:07 / cg"
|
---|
1870 | "Modified: 23.10.1997 / 03:56:31 / cg"
|
---|
1871 | !
|
---|
1872 |
|
---|
1873 | keyPress:key x:x y:y
|
---|
1874 | "/ stupid - due to delegation, this is never invoked ...
|
---|
1875 | enabled ifFalse:[^ self].
|
---|
1876 |
|
---|
1877 | self changeCursorFor:(x@y).
|
---|
1878 | super keyPress:key x:x y:y
|
---|
1879 |
|
---|
1880 | "Created: 23.10.1997 / 03:57:34 / cg"
|
---|
1881 | !
|
---|
1882 |
|
---|
1883 | keyRelease:key x:x y:y
|
---|
1884 | "/ stupid - due to delegation, this is never invoked ...
|
---|
1885 | self changeCursorFor:(x@y).
|
---|
1886 | super keyRelease:key x:x y:y
|
---|
1887 |
|
---|
1888 | "Created: 23.10.1997 / 03:58:25 / cg"
|
---|
1889 | !
|
---|
1890 |
|
---|
1891 | pointerEnter:state x:x y:y
|
---|
1892 | "mouse-button left view
|
---|
1893 | redraw thumb if enteredColor ~~ thumbColor"
|
---|
1894 |
|
---|
1895 | scrolling ifTrue:[
|
---|
1896 | (state bitAnd:(device anyButtonMotionMask)) == 0 ifTrue: [
|
---|
1897 | self buttonRelease:1 x:x y:y
|
---|
1898 | ].
|
---|
1899 | ].
|
---|
1900 | super pointerEnter:state x:x y:y
|
---|
1901 |
|
---|
1902 | "Modified: / 14.10.1998 / 15:40:51 / cg"
|
---|
1903 | !
|
---|
1904 |
|
---|
1905 | pointerLeave:state
|
---|
1906 | "mouse-button left view
|
---|
1907 | redraw thumb if enteredColor ~~ thumbColor"
|
---|
1908 |
|
---|
1909 | (entered and:[(state bitAnd:(device anyButtonMotionMask)) == 0]) ifTrue: [
|
---|
1910 | entered := false.
|
---|
1911 | thumbEnteredColor ~= thumbColor ifTrue:[
|
---|
1912 | self invalidate.
|
---|
1913 | "/ self drawThumb
|
---|
1914 | ]
|
---|
1915 | ].
|
---|
1916 |
|
---|
1917 | "Created: / 6.3.1996 / 17:31:16 / cg"
|
---|
1918 | "Modified: / 11.9.1998 / 00:13:53 / cg"
|
---|
1919 | !
|
---|
1920 |
|
---|
1921 | redraw
|
---|
1922 | "redraw"
|
---|
1923 |
|
---|
1924 | self redrawX:0 y:0 width:width height:height.
|
---|
1925 | self redrawEdges
|
---|
1926 |
|
---|
1927 | "Modified: / 18-07-2016 / 13:26:45 / svestkap"
|
---|
1928 | !
|
---|
1929 |
|
---|
1930 | redrawX:x y:y width:w height:h
|
---|
1931 | shown ifFalse:[
|
---|
1932 | ^ self.
|
---|
1933 | ].
|
---|
1934 |
|
---|
1935 | thumbFrame isNil ifTrue:[
|
---|
1936 | self computeThumbFrame
|
---|
1937 | ].
|
---|
1938 | self drawThumbBackgroundInX:x y:y width:w height:h.
|
---|
1939 | thumbFrame isNil ifTrue:[
|
---|
1940 | "/ thumb hidden
|
---|
1941 | ^ self
|
---|
1942 | ].
|
---|
1943 |
|
---|
1944 | orientation == #vertical ifTrue:[
|
---|
1945 | (y > thumbFrame bottom) ifTrue:[
|
---|
1946 | ^ self
|
---|
1947 | ].
|
---|
1948 | ((y + h) < thumbFrame top) ifTrue:[
|
---|
1949 | ^ self
|
---|
1950 | ].
|
---|
1951 | ] ifFalse:[
|
---|
1952 | (x > thumbFrame right) ifTrue:[
|
---|
1953 | ^ self
|
---|
1954 | ].
|
---|
1955 | ((x + w) < thumbFrame left) ifTrue:[
|
---|
1956 | ^ self
|
---|
1957 | ].
|
---|
1958 | ].
|
---|
1959 |
|
---|
1960 | self drawThumb
|
---|
1961 |
|
---|
1962 | "Modified: / 29-10-1997 / 15:48:48 / cg"
|
---|
1963 | "Modified: / 18-07-2016 / 13:45:09 / svestkap"
|
---|
1964 | !
|
---|
1965 |
|
---|
1966 | sizeChanged:how
|
---|
1967 | "size of scroller changed - recompute thumbs frame and redraw it"
|
---|
1968 |
|
---|
1969 | |oldThumbFrame oldTop oldBot newTop newBot oldLeft oldRight newLeft newRight|
|
---|
1970 |
|
---|
1971 | super sizeChanged:how.
|
---|
1972 |
|
---|
1973 | oldThumbFrame := thumbFrame.
|
---|
1974 | thumbFrame := nil.
|
---|
1975 | shown ifFalse:[
|
---|
1976 | thumbFrame := nil.
|
---|
1977 | self invalidate.
|
---|
1978 | ^ self.
|
---|
1979 | ].
|
---|
1980 | self computeThumbFrame.
|
---|
1981 |
|
---|
1982 | "/ any change ?
|
---|
1983 | thumbFrame = oldThumbFrame ifTrue:[
|
---|
1984 | ^ self
|
---|
1985 | ].
|
---|
1986 | thumbFrame isNil ifTrue:[
|
---|
1987 | self invalidate.
|
---|
1988 | ^ self
|
---|
1989 | ].
|
---|
1990 | oldThumbFrame isNil ifTrue:[
|
---|
1991 | self invalidate:thumbFrame.
|
---|
1992 | ^ self.
|
---|
1993 | ].
|
---|
1994 |
|
---|
1995 | "/ try to redraw as little as possible
|
---|
1996 |
|
---|
1997 | oldTop := oldThumbFrame top.
|
---|
1998 | oldBot := oldThumbFrame bottom.
|
---|
1999 | newTop := thumbFrame top.
|
---|
2000 | newBot := thumbFrame bottom.
|
---|
2001 | oldLeft := oldThumbFrame left.
|
---|
2002 | oldRight := oldThumbFrame right.
|
---|
2003 | newLeft := thumbFrame left.
|
---|
2004 | newRight := thumbFrame right.
|
---|
2005 |
|
---|
2006 | (orientation == #vertical
|
---|
2007 | and:[oldLeft == newLeft
|
---|
2008 | and:[oldRight == newRight]]) ifTrue:[
|
---|
2009 | (oldTop == newTop) ifTrue:[
|
---|
2010 | oldBot < newBot ifTrue:[
|
---|
2011 | "/ thumb became larger, but origin remains
|
---|
2012 | "/ (view became smaller)
|
---|
2013 | self invalidate:(Rectangle
|
---|
2014 | left:newLeft top:oldBot-thumbLevel
|
---|
2015 | right:newRight bottom:newBot).
|
---|
2016 | ^ self.
|
---|
2017 | ].
|
---|
2018 | oldBot > newBot ifTrue:[
|
---|
2019 | "/ thumb became smaller, but origin remains
|
---|
2020 | "/ (view became larger)
|
---|
2021 | self invalidate:(Rectangle
|
---|
2022 | left:newLeft top:newBot-thumbLevel
|
---|
2023 | right:newRight bottom:oldBot).
|
---|
2024 | ^ self.
|
---|
2025 | ].
|
---|
2026 | ].
|
---|
2027 | (oldBot == newBot) ifTrue:[
|
---|
2028 | newTop < oldTop ifTrue:[
|
---|
2029 | "/ thumb became larger, but corner remains
|
---|
2030 | "/ (view became smaller)
|
---|
2031 | self invalidate:(Rectangle
|
---|
2032 | left:newLeft top:newTop
|
---|
2033 | right:newRight bottom:oldTop+thumbLevel).
|
---|
2034 | ^ self.
|
---|
2035 | ].
|
---|
2036 | newTop > oldTop ifTrue:[
|
---|
2037 | "/ thumb became smaller, but corner remains
|
---|
2038 | "/ (view became larger)
|
---|
2039 | self invalidate:(Rectangle
|
---|
2040 | left:newLeft top:oldTop
|
---|
2041 | right:newRight bottom:newTop+thumbLevel).
|
---|
2042 | ^ self.
|
---|
2043 | ]
|
---|
2044 | ].
|
---|
2045 | ].
|
---|
2046 |
|
---|
2047 | (orientation == #horizontal
|
---|
2048 | and:[oldTop == newTop
|
---|
2049 | and:[oldBot == newBot]]) ifTrue:[
|
---|
2050 | (oldLeft == newLeft) ifTrue:[
|
---|
2051 | oldRight < newRight ifTrue:[
|
---|
2052 | "/ thumb became larger, but origin remains
|
---|
2053 | "/ (view became smaller)
|
---|
2054 | self invalidate:(Rectangle
|
---|
2055 | left:oldRight-thumbLevel top:newTop
|
---|
2056 | right:newRight bottom:newBot).
|
---|
2057 | ^ self.
|
---|
2058 | ].
|
---|
2059 | oldRight > newRight ifTrue:[
|
---|
2060 | "/ thumb became smaller, but origin remains
|
---|
2061 | "/ (view became larger)
|
---|
2062 | self invalidate:(Rectangle
|
---|
2063 | left:newRight-thumbLevel top:newTop
|
---|
2064 | right:oldRight bottom:newBot).
|
---|
2065 | ^ self.
|
---|
2066 | ].
|
---|
2067 | ].
|
---|
2068 | ].
|
---|
2069 |
|
---|
2070 | self invalidate:(oldThumbFrame merge: thumbFrame).
|
---|
2071 |
|
---|
2072 | "Modified: / 23.5.1999 / 13:50:41 / cg"
|
---|
2073 | !
|
---|
2074 |
|
---|
2075 | update:something with:aParameter from:changedObject
|
---|
2076 | "handle update from a model (if any)"
|
---|
2077 |
|
---|
2078 | (changedObject == model
|
---|
2079 | "and:[something == aspectMsg]") ifTrue:[
|
---|
2080 | self thumbOrigin:(model value).
|
---|
2081 | "/ self tellOthers.
|
---|
2082 | ^ self
|
---|
2083 | ].
|
---|
2084 | super update:something with:aParameter from:changedObject
|
---|
2085 |
|
---|
2086 | "Modified: / 30.3.1999 / 14:26:28 / stefan"
|
---|
2087 | ! !
|
---|
2088 |
|
---|
2089 | !Scroller methodsFor:'focus handling'!
|
---|
2090 |
|
---|
2091 | wantsFocusWithButtonPress
|
---|
2092 | "no, do not catch the keyboard focus on button click"
|
---|
2093 |
|
---|
2094 | ^ false
|
---|
2095 |
|
---|
2096 | "Modified: / 18-07-2016 / 13:25:51 / svestkap"
|
---|
2097 | ! !
|
---|
2098 |
|
---|
2099 | !Scroller methodsFor:'forced scroll'!
|
---|
2100 |
|
---|
2101 | moveLeft
|
---|
2102 | rangeStep notNil ifTrue:[
|
---|
2103 | self thumbOrigin:(self modelValueCheck:(model value)
|
---|
2104 | operation:#'-'
|
---|
2105 | secondValue:rangeStep).
|
---|
2106 | self tellOthers.
|
---|
2107 | ] ifFalse:[
|
---|
2108 | self moveStepMissing
|
---|
2109 | ].
|
---|
2110 |
|
---|
2111 | "Created: / 03-01-2017 / 11:24:13 / svestkap"
|
---|
2112 | "Modified (comment): / 05-01-2017 / 14:40:20 / svestkap"
|
---|
2113 | !
|
---|
2114 |
|
---|
2115 | moveRight
|
---|
2116 | rangeStep notNil ifTrue:[
|
---|
2117 | self thumbOrigin:(self modelValueCheck:(model value)
|
---|
2118 | operation:#'+'
|
---|
2119 | secondValue:rangeStep).
|
---|
2120 | self tellOthers.
|
---|
2121 | ] ifFalse:[
|
---|
2122 | self moveStepMissing
|
---|
2123 | ].
|
---|
2124 |
|
---|
2125 | "Created: / 03-01-2017 / 11:24:33 / svestkap"
|
---|
2126 | "Modified: / 05-01-2017 / 14:46:12 / svestkap"
|
---|
2127 | !
|
---|
2128 |
|
---|
2129 | scrollDown:amountToScroll
|
---|
2130 | "compatibility with SimpleView. This allows mouse wheel actions on Scrollers
|
---|
2131 | Note: this is used for horizontal scrollers, too (scrollRight)"
|
---|
2132 |
|
---|
2133 | self scrollStep:amountToScroll
|
---|
2134 | !
|
---|
2135 |
|
---|
2136 | scrollStep:delta
|
---|
2137 | "step by some delta"
|
---|
2138 |
|
---|
2139 | |oldOrg newOrg|
|
---|
2140 |
|
---|
2141 | oldOrg := self thumbOrigin.
|
---|
2142 | newOrg := ((oldOrg + delta) max:rangeStart) min:rangeEnd.
|
---|
2143 | oldOrg ~= newOrg ifTrue:[
|
---|
2144 | self thumbOrigin:newOrg.
|
---|
2145 | self tellOthers.
|
---|
2146 | ]
|
---|
2147 |
|
---|
2148 | "Created: / 21.4.1998 / 20:51:57 / cg"
|
---|
2149 | "Modified: / 21.4.1998 / 20:52:22 / cg"
|
---|
2150 | !
|
---|
2151 |
|
---|
2152 | scrollToBeginning
|
---|
2153 | "scroll to the beginning"
|
---|
2154 |
|
---|
2155 | self thumbOrigin:rangeStart.
|
---|
2156 | self tellOthers
|
---|
2157 |
|
---|
2158 | "Created: 6.3.1996 / 17:55:13 / cg"
|
---|
2159 | !
|
---|
2160 |
|
---|
2161 | scrollToEnd
|
---|
2162 | "scroll to the end"
|
---|
2163 |
|
---|
2164 | self thumbOrigin:rangeEnd.
|
---|
2165 | self tellOthers
|
---|
2166 |
|
---|
2167 | "Created: 6.3.1996 / 17:55:25 / cg"
|
---|
2168 | !
|
---|
2169 |
|
---|
2170 | scrollUp:amountToScroll
|
---|
2171 | "compatibility with SimpleView. This allows mouse wheel actions on Scrollers
|
---|
2172 | Note: this is used for horizontal scrollers, too (scrollLeft)"
|
---|
2173 |
|
---|
2174 | self scrollStep:amountToScroll negated
|
---|
2175 | ! !
|
---|
2176 |
|
---|
2177 | !Scroller methodsFor:'forwarding changed origin'!
|
---|
2178 |
|
---|
2179 | tellOthers
|
---|
2180 | |org|
|
---|
2181 |
|
---|
2182 | org := self thumbOrigin.
|
---|
2183 |
|
---|
2184 | "
|
---|
2185 | the ST-80 way of notifying scrolls
|
---|
2186 | "
|
---|
2187 | self sendChangeMessageWith:org.
|
---|
2188 |
|
---|
2189 | "
|
---|
2190 | the ST/X way of notifying scrolls
|
---|
2191 | "
|
---|
2192 | scrollAction notNil ifTrue:[
|
---|
2193 | scrollAction value:org
|
---|
2194 | ].
|
---|
2195 |
|
---|
2196 | "/
|
---|
2197 | "/ this will vanish - the scroller should share
|
---|
2198 | "/ a valueHolder with the scrolledView.
|
---|
2199 | "/
|
---|
2200 | dependents notNil ifTrue:[ self changed:#scrollerPosition ].
|
---|
2201 |
|
---|
2202 | "Modified: / 21.1.1998 / 19:12:55 / cg"
|
---|
2203 | ! !
|
---|
2204 |
|
---|
2205 | !Scroller methodsFor:'initialization'!
|
---|
2206 |
|
---|
2207 | defaultExtent
|
---|
2208 | "compute my extent from sub-components"
|
---|
2209 |
|
---|
2210 | ^ self preferredExtent
|
---|
2211 |
|
---|
2212 | "Modified: 22.4.1996 / 23:37:53 / cg"
|
---|
2213 | !
|
---|
2214 |
|
---|
2215 | fetchDeviceResources
|
---|
2216 | "fetch device colors, to avoid reallocation at redraw time"
|
---|
2217 |
|
---|
2218 | |graphicsDevice|
|
---|
2219 |
|
---|
2220 | super fetchDeviceResources.
|
---|
2221 | graphicsDevice := device.
|
---|
2222 |
|
---|
2223 | thumbShadowColor notNil ifTrue:[thumbShadowColor := thumbShadowColor onDevice:graphicsDevice].
|
---|
2224 | thumbLightColor notNil ifTrue:[thumbLightColor := thumbLightColor onDevice:graphicsDevice].
|
---|
2225 | thumbHalfShadowColor notNil ifTrue:[thumbHalfShadowColor := thumbHalfShadowColor onDevice:graphicsDevice].
|
---|
2226 | thumbHalfLightColor notNil ifTrue:[thumbHalfLightColor := thumbHalfLightColor onDevice:graphicsDevice].
|
---|
2227 |
|
---|
2228 | thumbEnteredColor notNil ifTrue:[thumbEnteredColor := thumbEnteredColor onDevice:graphicsDevice].
|
---|
2229 | ghostColor notNil ifTrue:[ghostColor := ghostColor onDevice:graphicsDevice].
|
---|
2230 | ghostFrameColor notNil ifTrue:[ghostFrameColor := ghostFrameColor onDevice:graphicsDevice].
|
---|
2231 |
|
---|
2232 | "Modified: 13.1.1997 / 21:56:38 / cg"
|
---|
2233 | !
|
---|
2234 |
|
---|
2235 | initCursor
|
---|
2236 | "set the cursor - a hand"
|
---|
2237 |
|
---|
2238 | cursor := Cursor hand
|
---|
2239 | !
|
---|
2240 |
|
---|
2241 | initStyle
|
---|
2242 | "initialize style dep. stuff"
|
---|
2243 |
|
---|
2244 | <resource: #style (#name
|
---|
2245 | #'scroller.autoRepeat'
|
---|
2246 | #'scroller.initialRepeatDelay'
|
---|
2247 | #'scroller.repeatDelay')>
|
---|
2248 |
|
---|
2249 | |nm graphicsDevice|
|
---|
2250 |
|
---|
2251 | super initStyle.
|
---|
2252 | graphicsDevice := device.
|
---|
2253 |
|
---|
2254 | DefaultViewBackground notNil ifTrue:[
|
---|
2255 | viewBackground := DefaultViewBackground onDevice:graphicsDevice.
|
---|
2256 | ].
|
---|
2257 | DefaultShadowColor notNil ifTrue:[
|
---|
2258 | shadowColor := DefaultShadowColor onDevice:graphicsDevice.
|
---|
2259 | ].
|
---|
2260 | DefaultLightColor notNil ifTrue:[
|
---|
2261 | lightColor := DefaultLightColor onDevice:graphicsDevice.
|
---|
2262 | ].
|
---|
2263 |
|
---|
2264 | tallyMarks := DefaultTallyMarks.
|
---|
2265 | tallyLevel := DefaultTallyLevel.
|
---|
2266 | DefaultLevel ~~ level ifTrue:[
|
---|
2267 | self level:DefaultLevel.
|
---|
2268 | ].
|
---|
2269 | DefaultBorderWidth ~~ self borderWidth ifTrue:[
|
---|
2270 | self borderWidth:DefaultBorderWidth.
|
---|
2271 | ].
|
---|
2272 | thumbLevel := DefaultThumbLevel.
|
---|
2273 | thumbActiveLevel := DefaultThumbActiveLevel.
|
---|
2274 | thumbActiveColor := DefaultThumbActiveColor.
|
---|
2275 | inset := DefaultInset.
|
---|
2276 | fixThumbHeight := DefaultFixThumbHeight.
|
---|
2277 | thumbEdgeStyle := DefaultEdgeStyle.
|
---|
2278 |
|
---|
2279 | DefaultGhostColor notNil ifTrue:[
|
---|
2280 | ghostColor := DefaultGhostColor onDevice:graphicsDevice.
|
---|
2281 | ].
|
---|
2282 | DefaultGhostFrameColor notNil ifTrue:[
|
---|
2283 | ghostFrameColor := DefaultGhostFrameColor onDevice:graphicsDevice.
|
---|
2284 | ].
|
---|
2285 | ghostLevel := DefaultGhostLevel.
|
---|
2286 |
|
---|
2287 | DefaultThumbFrameColor notNil ifTrue:[
|
---|
2288 | thumbFrameColor := DefaultThumbFrameColor onDevice:graphicsDevice.
|
---|
2289 | ].
|
---|
2290 | DefaultThumbShadowColor notNil ifTrue:[
|
---|
2291 | thumbShadowColor := DefaultThumbShadowColor
|
---|
2292 | ] ifFalse:[
|
---|
2293 | thumbShadowColor := shadowColor.
|
---|
2294 | ].
|
---|
2295 | DefaultThumbLightColor notNil ifTrue:[
|
---|
2296 | thumbLightColor := DefaultThumbLightColor
|
---|
2297 | ] ifFalse:[
|
---|
2298 | thumbLightColor := lightColor.
|
---|
2299 | ].
|
---|
2300 |
|
---|
2301 | thumbEdgeStyle notNil ifTrue:[
|
---|
2302 | DefaultThumbHalfShadowColor notNil ifTrue:[
|
---|
2303 | thumbHalfShadowColor := DefaultThumbHalfShadowColor
|
---|
2304 | ].
|
---|
2305 |
|
---|
2306 | DefaultThumbHalfLightColor notNil ifTrue:[
|
---|
2307 | thumbHalfLightColor := DefaultThumbHalfLightColor
|
---|
2308 | ].
|
---|
2309 | ].
|
---|
2310 |
|
---|
2311 | nm := styleSheet name.
|
---|
2312 |
|
---|
2313 | graphicsDevice hasGrayscales ifFalse:[
|
---|
2314 | thumbEdgeStyle notNil ifTrue:[
|
---|
2315 | thumbHalfShadowColor := Color darkGray.
|
---|
2316 | thumbHalfLightColor := self whiteColor
|
---|
2317 | ].
|
---|
2318 |
|
---|
2319 | thumbShadowColor := self blackColor.
|
---|
2320 | "/ thumbLightColor := White.
|
---|
2321 |
|
---|
2322 | nm = #motif ifTrue:[
|
---|
2323 | DefaultThumbColor isNil ifTrue:[
|
---|
2324 | thumbColor := self whiteColor.
|
---|
2325 | ].
|
---|
2326 | ]
|
---|
2327 | ].
|
---|
2328 |
|
---|
2329 | DefaultThumbColor notNil ifTrue:[
|
---|
2330 | thumbColor := DefaultThumbColor onDevice:graphicsDevice
|
---|
2331 | ] ifFalse:[
|
---|
2332 | nm ~= #napkin ifTrue:[
|
---|
2333 | thumbColor := self whiteColor.
|
---|
2334 | nm ~= #normal ifTrue:[
|
---|
2335 | graphicsDevice hasGrayscales ifFalse:[
|
---|
2336 | thumbColor := Color gray
|
---|
2337 | ].
|
---|
2338 | ].
|
---|
2339 | ].
|
---|
2340 | ].
|
---|
2341 | thumbColor notNil ifTrue:[
|
---|
2342 | thumbColor := thumbColor onDevice:graphicsDevice.
|
---|
2343 | ].
|
---|
2344 |
|
---|
2345 | thumbShadowColor notNil ifTrue:[
|
---|
2346 | thumbShadowColor := thumbShadowColor onDevice:graphicsDevice.
|
---|
2347 | ].
|
---|
2348 | thumbLightColor notNil ifTrue:[
|
---|
2349 | thumbLightColor := thumbLightColor onDevice:graphicsDevice.
|
---|
2350 | ].
|
---|
2351 | thumbHalfShadowColor notNil ifTrue:[
|
---|
2352 | thumbHalfShadowColor := thumbHalfShadowColor onDevice:graphicsDevice.
|
---|
2353 | ].
|
---|
2354 | thumbHalfLightColor notNil ifTrue:[
|
---|
2355 | thumbHalfLightColor := thumbHalfLightColor onDevice:graphicsDevice.
|
---|
2356 | ].
|
---|
2357 | thumbEdgeStyle notNil ifTrue:[
|
---|
2358 | thumbHalfShadowColor isNil ifTrue:[
|
---|
2359 | thumbHalfShadowColor := thumbShadowColor lightened onDevice:graphicsDevice
|
---|
2360 | ]
|
---|
2361 | ].
|
---|
2362 |
|
---|
2363 | DefaultThumbEnteredColor notNil ifTrue:[
|
---|
2364 | thumbEnteredColor := DefaultThumbEnteredColor onDevice:graphicsDevice.
|
---|
2365 | ] ifFalse:[
|
---|
2366 | thumbEnteredColor := thumbColor.
|
---|
2367 | ].
|
---|
2368 |
|
---|
2369 | (DefaultThumbEnteredColor notNil or:[NewCursors]) ifTrue:[
|
---|
2370 | self enableMotionEvents.
|
---|
2371 | self enableEnterLeaveEvents.
|
---|
2372 | ].
|
---|
2373 |
|
---|
2374 | DefaultThumbImage notNil ifTrue:[
|
---|
2375 | thumbImage := DefaultThumbImage onDevice:graphicsDevice.
|
---|
2376 | fixThumbHeight := true.
|
---|
2377 | ].
|
---|
2378 |
|
---|
2379 | HandleImage notNil ifTrue:[
|
---|
2380 | shadowForm := HandleImage onDevice:graphicsDevice.
|
---|
2381 | ] ifFalse:[
|
---|
2382 | nm = #next ifTrue:[
|
---|
2383 | shadowForm := self class handleShadowFormOn:graphicsDevice.
|
---|
2384 | lightForm := self class handleLightFormOn:graphicsDevice
|
---|
2385 | ] ifFalse:[
|
---|
2386 | shadowForm := lightForm := nil
|
---|
2387 | ].
|
---|
2388 | ].
|
---|
2389 | self drawableId notNil ifTrue:[
|
---|
2390 | self computeThumbFrame
|
---|
2391 | ].
|
---|
2392 |
|
---|
2393 | autoRepeat := styleSheet at:#'scroller.autoRepeat' default:true.
|
---|
2394 | initialRepeatDelay := styleSheet at:#'scroller.initialRepeatDelay' default:0.3.
|
---|
2395 | repeatDelay := styleSheet at:#'scroller.repeatDelay' default:0.15.
|
---|
2396 |
|
---|
2397 | "Modified: / 5.9.1998 / 20:21:41 / cg"
|
---|
2398 | !
|
---|
2399 |
|
---|
2400 | initialize
|
---|
2401 | "initialize - setup instvars from defaults"
|
---|
2402 |
|
---|
2403 | orientation isNil ifTrue:[orientation := #vertical].
|
---|
2404 |
|
---|
2405 | super initialize.
|
---|
2406 |
|
---|
2407 | scrolling := entered := false.
|
---|
2408 | enabled := synchronousOperation := true.
|
---|
2409 |
|
---|
2410 | thumbOrigin := virtualModelValue := 0.
|
---|
2411 | thumbHeight := 100.
|
---|
2412 | thumbFrameSizeDifference := 0.
|
---|
2413 |
|
---|
2414 | rangeStart := 0.
|
---|
2415 | rangeEnd := 100.
|
---|
2416 | rangeStep := nil."/ meaning: arbitrary precision
|
---|
2417 |
|
---|
2418 | "/ inset := 1.
|
---|
2419 |
|
---|
2420 | "/ self computeThumbFrame
|
---|
2421 |
|
---|
2422 | "Modified: / 07-03-1999 / 00:07:32 / cg"
|
---|
2423 | "Modified: / 06-01-2017 / 09:44:08 / svestkap"
|
---|
2424 | !
|
---|
2425 |
|
---|
2426 | realize
|
---|
2427 | super realize.
|
---|
2428 | model notNil ifTrue:[
|
---|
2429 | self thumbOrigin:(model value).
|
---|
2430 | ].
|
---|
2431 | ! !
|
---|
2432 |
|
---|
2433 | !Scroller methodsFor:'private'!
|
---|
2434 |
|
---|
2435 | absFromPercent:percent
|
---|
2436 | "given a percentage, compute number of pixels"
|
---|
2437 |
|
---|
2438 | |fullSize|
|
---|
2439 |
|
---|
2440 | (orientation == #vertical) ifTrue:[
|
---|
2441 | fullSize := height
|
---|
2442 | ] ifFalse:[
|
---|
2443 | fullSize := width
|
---|
2444 | ].
|
---|
2445 |
|
---|
2446 | "/ avoid hitting the boundary if no frame and no level (i.e. st80 style)
|
---|
2447 | (thumbLevel == 0 and:[thumbFrameColor isNil]) ifTrue:[
|
---|
2448 | fullSize := fullSize - 1
|
---|
2449 | ].
|
---|
2450 |
|
---|
2451 | ^ ((percent * (fullSize - thumbFrameSizeDifference - (margin * 2))) / 100) rounded
|
---|
2452 |
|
---|
2453 | "Modified: 7.3.1997 / 16:05:57 / cg"
|
---|
2454 | !
|
---|
2455 |
|
---|
2456 | computeThumbFrame
|
---|
2457 | "compute the thumbs frame (a rectangle) whenever thumb is moved,
|
---|
2458 | changed height or the scrollers size has changed.
|
---|
2459 | We take care, that the thumb will not become too small (i.e.
|
---|
2460 | invisible or uncatchable).
|
---|
2461 | Also, for mswindows style, its height/width is constant."
|
---|
2462 |
|
---|
2463 | |newPos1 newPos2 newSize1 newSize2 nh nw ny nx
|
---|
2464 | computedSize minSz sz1 sz2 nb nr|
|
---|
2465 |
|
---|
2466 | thumbHeight >= 100 ifTrue:[
|
---|
2467 | self thumbOrigin ~= 0.0 ifTrue:[
|
---|
2468 | self thumbOrigin:0
|
---|
2469 | ].
|
---|
2470 |
|
---|
2471 | thumbFrame := nil.
|
---|
2472 | ^ self
|
---|
2473 | ].
|
---|
2474 |
|
---|
2475 | "compute position & size"
|
---|
2476 | newPos1 := (self absFromPercent:thumbOrigin) + margin.
|
---|
2477 | newSize1 := computedSize := self absFromPercent:thumbHeight.
|
---|
2478 | (orientation == #vertical) ifTrue:[
|
---|
2479 | sz1 := height.
|
---|
2480 | sz2 := width
|
---|
2481 | ] ifFalse:[
|
---|
2482 | sz1 := width.
|
---|
2483 | sz2 := height
|
---|
2484 | ].
|
---|
2485 |
|
---|
2486 | "
|
---|
2487 | do we have to adjust the computed size ?
|
---|
2488 | "
|
---|
2489 | newPos2 := margin + inset.
|
---|
2490 | newSize2 := sz2 - (2 * newPos2).
|
---|
2491 |
|
---|
2492 | "/ (style ~~ #normal) ifTrue:[
|
---|
2493 | thumbLevel ~~ 0 ifTrue:[
|
---|
2494 | "
|
---|
2495 | do not make thumb too small (for handle & to be catchable)
|
---|
2496 | "
|
---|
2497 | minSz := MinThumbSize "10" + (2 * thumbLevel)
|
---|
2498 | ] ifFalse:[
|
---|
2499 | "
|
---|
2500 | do not make thumb too small (uncatchable)
|
---|
2501 | "
|
---|
2502 | minSz := MinThumbSize "4"
|
---|
2503 | ].
|
---|
2504 |
|
---|
2505 | (newSize1 < minSz) ifTrue:[
|
---|
2506 | newSize1 := minSz.
|
---|
2507 | thumbFrameSizeDifference := newSize1 - computedSize
|
---|
2508 | ] ifFalse:[
|
---|
2509 | thumbFrameSizeDifference := 0.
|
---|
2510 | ].
|
---|
2511 |
|
---|
2512 | fixThumbHeight ifTrue:[
|
---|
2513 | "have a fix-size thumb (i.e. mswindows style)"
|
---|
2514 |
|
---|
2515 | newSize1 := sz2 - (2 * inset). "make it square"
|
---|
2516 | thumbImage notNil ifTrue:[
|
---|
2517 | newSize1 := (newSize1 max:(thumbImage height)) max:(thumbImage width)
|
---|
2518 | ].
|
---|
2519 | thumbFrameSizeDifference := newSize1 - computedSize.
|
---|
2520 | ].
|
---|
2521 |
|
---|
2522 | "
|
---|
2523 | oops - if height does not reflect real visibible area, we have to adjust the origin
|
---|
2524 | "
|
---|
2525 | (thumbFrameSizeDifference == 0) ifFalse:[
|
---|
2526 | newPos1 := (self absFromPercent:thumbOrigin) + margin.
|
---|
2527 | "/ newPos1 := ((thumbOrigin * (sz1 - thumbFrameSizeDifference - (margin * 2))) / 100) rounded + margin
|
---|
2528 | ].
|
---|
2529 |
|
---|
2530 | (orientation == #vertical) ifTrue:[
|
---|
2531 | ny := newPos1 max:margin.
|
---|
2532 | nx := newPos2.
|
---|
2533 | nh := newSize1.
|
---|
2534 | nw := newSize2 max:2.
|
---|
2535 | ny + nh >= (height - margin) ifTrue:[
|
---|
2536 | ny := (height - 1 - margin - nh) max:margin.
|
---|
2537 | ].
|
---|
2538 | (nx+nw) >= width ifTrue:[
|
---|
2539 | nx := ((width - nw) // 2) max:0.
|
---|
2540 | ].
|
---|
2541 |
|
---|
2542 | nb := ny + nh - 1.
|
---|
2543 | nb >= (height - margin) ifTrue:[
|
---|
2544 | ny <= margin ifTrue:[
|
---|
2545 | thumbFrame := nil.
|
---|
2546 | ^ self
|
---|
2547 | ]
|
---|
2548 | ].
|
---|
2549 | ] ifFalse:[
|
---|
2550 | nx := newPos1 max:margin.
|
---|
2551 | ny := newPos2.
|
---|
2552 | nw := newSize1.
|
---|
2553 | nh := newSize2 max:2.
|
---|
2554 | nx + nw >= (width - margin) ifTrue:[
|
---|
2555 | nx := (width - 1 - margin - nw) max:margin.
|
---|
2556 | ].
|
---|
2557 | (ny+nh) >= height ifTrue:[
|
---|
2558 | ny := ((height - nh) // 2) max:0.
|
---|
2559 | ].
|
---|
2560 | nr := nx + nw - 1.
|
---|
2561 | nr >= (width - margin) ifTrue:[
|
---|
2562 | nx <= margin ifTrue:[
|
---|
2563 | thumbFrame := nil.
|
---|
2564 | ^ self
|
---|
2565 | ]
|
---|
2566 | ].
|
---|
2567 | ].
|
---|
2568 | (((styleSheet name == #winXP) or:[styleSheet name == #winVista])
|
---|
2569 | and:[self isMiniScroller not]) ifTrue:[
|
---|
2570 | nw := nw + 1.
|
---|
2571 | nh := nh + 1.
|
---|
2572 | ].
|
---|
2573 |
|
---|
2574 | "
|
---|
2575 | do not create a new Rectangle if its the same anyway
|
---|
2576 | "
|
---|
2577 | thumbFrame notNil ifTrue:[
|
---|
2578 | (ny == thumbFrame top) ifTrue:[
|
---|
2579 | (nx == thumbFrame left) ifTrue:[
|
---|
2580 | (nh == thumbFrame height) ifTrue:[
|
---|
2581 | (nw == thumbFrame width) ifTrue:[ ^ self]
|
---|
2582 | ]
|
---|
2583 | ]
|
---|
2584 | ]
|
---|
2585 | ].
|
---|
2586 |
|
---|
2587 | thumbFrame := Rectangle left:nx top:ny width:nw height:nh.
|
---|
2588 |
|
---|
2589 | "Modified: / 12.5.1998 / 20:58:51 / cg"
|
---|
2590 | !
|
---|
2591 |
|
---|
2592 | modelValueCheck:modelValue operation:operator secondValue:secondValue
|
---|
2593 | modelValue isNil ifTrue:[
|
---|
2594 | ^ virtualModelValue := self virtualModelValue perform:operator asSymbol with:secondValue.
|
---|
2595 | ] ifFalse:[
|
---|
2596 | ^ modelValue perform:operator asSymbol with:secondValue
|
---|
2597 | ]
|
---|
2598 |
|
---|
2599 | "Created: / 05-01-2017 / 12:56:35 / svestkap"
|
---|
2600 | "Modified: / 05-01-2017 / 14:42:56 / svestkap"
|
---|
2601 | !
|
---|
2602 |
|
---|
2603 | moveStepMissing
|
---|
2604 | rangeStep isNil ifTrue:[
|
---|
2605 | self error:'No thumb step defined!!' mayProceed:false.
|
---|
2606 | ].
|
---|
2607 |
|
---|
2608 | "Created: / 04-01-2017 / 12:25:42 / svestkap"
|
---|
2609 | !
|
---|
2610 |
|
---|
2611 | percentFromAbs:absValue
|
---|
2612 | "given a number of pixels, compute percentage"
|
---|
2613 |
|
---|
2614 | |fullSize val t|
|
---|
2615 |
|
---|
2616 | (orientation == #vertical) ifTrue:[
|
---|
2617 | fullSize := height
|
---|
2618 | ] ifFalse:[
|
---|
2619 | fullSize := width
|
---|
2620 | ].
|
---|
2621 |
|
---|
2622 | absValue < 0 ifTrue:[^ rangeStart].
|
---|
2623 | absValue > fullSize ifTrue:[^ rangeEnd].
|
---|
2624 |
|
---|
2625 | t := fullSize - thumbFrameSizeDifference - (margin * 2).
|
---|
2626 | t = 0 ifTrue:[
|
---|
2627 | "/ in rare cases, this happens ...
|
---|
2628 | val := 0
|
---|
2629 | ] ifFalse:[
|
---|
2630 | val := absValue / t * (rangeEnd - rangeStart).
|
---|
2631 | ].
|
---|
2632 | val := val + rangeStart.
|
---|
2633 |
|
---|
2634 | rangeStart < rangeEnd ifTrue:[
|
---|
2635 | val < rangeStart ifTrue:[^ rangeStart].
|
---|
2636 | val > rangeEnd ifTrue:[^ rangeEnd].
|
---|
2637 | ] ifFalse:[
|
---|
2638 | val > rangeStart ifTrue:[^ rangeStart].
|
---|
2639 | val < rangeEnd ifTrue:[^ rangeEnd].
|
---|
2640 | ].
|
---|
2641 | ^ val
|
---|
2642 |
|
---|
2643 | "Modified: / 21.1.1998 / 19:31:15 / cg"
|
---|
2644 | !
|
---|
2645 |
|
---|
2646 | startMove
|
---|
2647 | originBeforeMove := self thumbOrigin.
|
---|
2648 |
|
---|
2649 | (ghostColor notNil
|
---|
2650 | or:[ghostFrameColor notNil
|
---|
2651 | or:[ghostLevel ~~ 0]]) ifTrue:[
|
---|
2652 | thumbFrame isNil ifTrue:[
|
---|
2653 | self computeThumbFrame.
|
---|
2654 | ].
|
---|
2655 | frameBeforeMove := thumbFrame insetBy:1@1
|
---|
2656 | ].
|
---|
2657 |
|
---|
2658 | !
|
---|
2659 |
|
---|
2660 | updateBackground
|
---|
2661 | "make my background grey, whenever either readOnly or disable"
|
---|
2662 |
|
---|
2663 | |bg|
|
---|
2664 |
|
---|
2665 | enabled ifTrue:[
|
---|
2666 | bg := DefaultViewBackground.
|
---|
2667 | ].
|
---|
2668 | bg isNil ifTrue:[
|
---|
2669 | bg := View defaultViewBackgroundColor.
|
---|
2670 | ].
|
---|
2671 |
|
---|
2672 | bg ~= viewBackground ifTrue:[
|
---|
2673 | self backgroundColor:bg.
|
---|
2674 | self invalidate
|
---|
2675 | ]
|
---|
2676 |
|
---|
2677 | ! !
|
---|
2678 |
|
---|
2679 | !Scroller methodsFor:'private-scrollbar & scrollview interface'!
|
---|
2680 |
|
---|
2681 | setThumbFor:aView
|
---|
2682 | "get contents and size info from aView and adjust thumb"
|
---|
2683 |
|
---|
2684 | |percentSize percentOrigin contentsSize contentsPosition viewsSize t|
|
---|
2685 |
|
---|
2686 | scrolling ifTrue:[self invalidate].
|
---|
2687 |
|
---|
2688 | "
|
---|
2689 | get the content's size
|
---|
2690 | "
|
---|
2691 | aView isNil ifTrue:[
|
---|
2692 | contentsSize := 0
|
---|
2693 | ] ifFalse:[
|
---|
2694 | orientation == #vertical ifTrue:[
|
---|
2695 | contentsSize := aView heightOfContents.
|
---|
2696 | (t := aView transformation) notNil ifTrue:[
|
---|
2697 | contentsSize := t applyScaleY:contentsSize.
|
---|
2698 | ].
|
---|
2699 | ] ifFalse:[
|
---|
2700 | contentsSize := aView widthOfContents.
|
---|
2701 | (t := aView transformation) notNil ifTrue:[
|
---|
2702 | contentsSize := t applyScaleX:contentsSize.
|
---|
2703 | ].
|
---|
2704 | ]
|
---|
2705 | ].
|
---|
2706 |
|
---|
2707 | (contentsSize = 0) ifTrue:[
|
---|
2708 | percentSize := 100.
|
---|
2709 | percentOrigin := 100
|
---|
2710 | ] ifFalse:[
|
---|
2711 | (orientation == #vertical) ifTrue:[
|
---|
2712 | viewsSize := aView innerHeight.
|
---|
2713 | contentsPosition := aView yOriginOfContents.
|
---|
2714 | ] ifFalse:[
|
---|
2715 | viewsSize := aView innerWidth.
|
---|
2716 | contentsPosition := aView xOriginOfContents
|
---|
2717 | ].
|
---|
2718 |
|
---|
2719 | percentSize := viewsSize * 100.0 / contentsSize.
|
---|
2720 | percentOrigin := contentsPosition * 100.0 / contentsSize.
|
---|
2721 | percentOrigin + percentSize > 100.0 ifTrue:[
|
---|
2722 | "actually showing stuff below contents of view"
|
---|
2723 | "
|
---|
2724 | contentsSize := contentsPosition + aView innerHeight.
|
---|
2725 | percentSize := viewsSize * 100.0 / contentsSize.
|
---|
2726 | percentOrigin := contentsPosition * 100.0 / contentsSize
|
---|
2727 | "
|
---|
2728 | ]
|
---|
2729 | ].
|
---|
2730 | (percentSize = thumbHeight) ifTrue:[
|
---|
2731 | self thumbOrigin:percentOrigin
|
---|
2732 | ] ifFalse:[
|
---|
2733 | (percentOrigin = thumbOrigin) ifTrue:[
|
---|
2734 | self thumbHeight:percentSize
|
---|
2735 | ] ifFalse:[
|
---|
2736 | self thumbOrigin:percentOrigin thumbHeight:percentSize
|
---|
2737 | ]
|
---|
2738 | ].
|
---|
2739 | !
|
---|
2740 |
|
---|
2741 | setThumbHeightFor:aView
|
---|
2742 | "get contents and size info from aView and adjust thumb height"
|
---|
2743 |
|
---|
2744 | |percent total viewsSize|
|
---|
2745 |
|
---|
2746 | scrolling ifTrue:[self invalidate].
|
---|
2747 |
|
---|
2748 | (orientation == #vertical) ifTrue:[
|
---|
2749 | total := aView heightOfContents.
|
---|
2750 | aView transformation notNil ifTrue:[
|
---|
2751 | total := aView transformation applyScaleY:total.
|
---|
2752 | ].
|
---|
2753 | ] ifFalse:[
|
---|
2754 | total := aView widthOfContents.
|
---|
2755 | aView transformation notNil ifTrue:[
|
---|
2756 | total := aView transformation applyScaleX:total.
|
---|
2757 | ].
|
---|
2758 | ].
|
---|
2759 | (total = 0) ifTrue:[
|
---|
2760 | percent := 100
|
---|
2761 | ] ifFalse:[
|
---|
2762 | viewsSize := (orientation == #vertical) ifTrue:[aView innerHeight]
|
---|
2763 | ifFalse:[aView innerWidth].
|
---|
2764 | percent := viewsSize * 100.0 / total
|
---|
2765 | ].
|
---|
2766 | self thumbHeight:percent
|
---|
2767 | !
|
---|
2768 |
|
---|
2769 | setThumbOriginFor:aView
|
---|
2770 | "get contents and size info from aView and adjust thumb origin"
|
---|
2771 |
|
---|
2772 | |percent total contentsPosition|
|
---|
2773 |
|
---|
2774 | scrolling ifTrue:[self invalidate].
|
---|
2775 |
|
---|
2776 | (orientation == #vertical) ifTrue:[
|
---|
2777 | total := aView heightOfContents.
|
---|
2778 | aView transformation notNil ifTrue:[
|
---|
2779 | total := aView transformation applyScaleY:total.
|
---|
2780 | ].
|
---|
2781 | ] ifFalse:[
|
---|
2782 | total := aView widthOfContents.
|
---|
2783 | aView transformation notNil ifTrue:[
|
---|
2784 | total := aView transformation applyScaleX:total.
|
---|
2785 | ].
|
---|
2786 | ].
|
---|
2787 | (total = 0) ifTrue:[
|
---|
2788 | percent := 100
|
---|
2789 | ] ifFalse:[
|
---|
2790 | contentsPosition := (orientation == #vertical) ifTrue:[aView yOriginOfContents]
|
---|
2791 | ifFalse:[aView xOriginOfContents].
|
---|
2792 | percent := contentsPosition * 100.0 / total
|
---|
2793 | ].
|
---|
2794 | self thumbOrigin:percent.
|
---|
2795 | ! !
|
---|
2796 |
|
---|
2797 | !Scroller methodsFor:'queries'!
|
---|
2798 |
|
---|
2799 | isMiniScroller
|
---|
2800 | ^ false
|
---|
2801 | !
|
---|
2802 |
|
---|
2803 | isScrolling
|
---|
2804 | "true, if thumb is being moved (by user)"
|
---|
2805 |
|
---|
2806 | ^ scrolling
|
---|
2807 | !
|
---|
2808 |
|
---|
2809 | preferredExtent
|
---|
2810 | "return my preferredExtent"
|
---|
2811 |
|
---|
2812 | |defExt w h|
|
---|
2813 |
|
---|
2814 | "/ If I have an explicit preferredExtent..
|
---|
2815 | explicitExtent notNil ifTrue:[
|
---|
2816 | ^ explicitExtent
|
---|
2817 | ].
|
---|
2818 |
|
---|
2819 | "/ If I have a cached preferredExtent value..
|
---|
2820 | preferredExtent notNil ifTrue:[
|
---|
2821 | ^ preferredExtent
|
---|
2822 | ].
|
---|
2823 |
|
---|
2824 | defExt := self class defaultExtent.
|
---|
2825 |
|
---|
2826 | orientation == #vertical ifTrue:[
|
---|
2827 | h := defExt y.
|
---|
2828 | (w := DefaultVScrollerWidth) isNil ifTrue:[
|
---|
2829 | w := (device horizontalPixelPerMillimeter asFloat * 5) rounded
|
---|
2830 | ]
|
---|
2831 | ] ifFalse:[
|
---|
2832 | w := defExt x.
|
---|
2833 | (h := DefaultHScrollerHeight) isNil ifTrue:[
|
---|
2834 | h := (device verticalPixelPerMillimeter asFloat * 5) rounded
|
---|
2835 | ]
|
---|
2836 | ].
|
---|
2837 |
|
---|
2838 | preferredExtent := w @ h.
|
---|
2839 | ^ preferredExtent.
|
---|
2840 |
|
---|
2841 | "Modified: / 28.4.1999 / 18:28:19 / cg"
|
---|
2842 | !
|
---|
2843 |
|
---|
2844 | thumbVisible
|
---|
2845 | "return true, if the thumb is usable i.e. its visible & movable.
|
---|
2846 | Can be used by the scrollBar to decide if it should hide the scroller."
|
---|
2847 |
|
---|
2848 | |m2|
|
---|
2849 |
|
---|
2850 | (thumbHeight >= 100) ifTrue:[^ false].
|
---|
2851 | self computeThumbFrame.
|
---|
2852 | thumbFrame isNil ifTrue:[^ false].
|
---|
2853 |
|
---|
2854 | m2 := margin * 2.
|
---|
2855 | orientation == #vertical ifTrue:[
|
---|
2856 | thumbFrame height >= (height - m2) ifTrue:[^ false].
|
---|
2857 | ] ifFalse:[
|
---|
2858 | thumbFrame width >= (width - m2) ifTrue:[^ false].
|
---|
2859 | ].
|
---|
2860 | ^ true
|
---|
2861 |
|
---|
2862 | "Created: / 7.3.1997 / 21:10:23 / cg"
|
---|
2863 | "Modified: / 12.5.1998 / 20:21:00 / cg"
|
---|
2864 | !
|
---|
2865 |
|
---|
2866 | verticalScrollStep
|
---|
2867 | "mouse wheel: scroll by keyboardStep or a quarter of a page
|
---|
2868 | Note: this is used for horizontal scrollers, too"
|
---|
2869 |
|
---|
2870 | ^ (keyboardStep ? (thumbHeight / 4)) max:1
|
---|
2871 | ! !
|
---|
2872 |
|
---|
2873 | !Scroller class methodsFor:'documentation'!
|
---|
2874 |
|
---|
2875 | version
|
---|
2876 | ^ '$Header$'
|
---|
2877 | !
|
---|
2878 |
|
---|
2879 | version_CVS
|
---|
2880 | ^ '$Header$'
|
---|
2881 | !
|
---|
2882 |
|
---|
2883 | version_HG
|
---|
2884 |
|
---|
2885 | ^ '$Changeset: <not expanded> $'
|
---|
2886 | ! !
|
---|
2887 |
|
---|