Ticket #85: Scroller_mouse_event_fixed.st

File Scroller_mouse_event_fixed.st, 87.8 KB (added by patrik.svestka@…, 7 years ago)

Fixing thumb movement in the class Scroller

Line 
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
18View 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
50copyright
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
64documentation
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
171examples
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
293handleLightFormOn: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
324handleShadowFormOn: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
355updateStyleCache
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
440keyboardStep
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
448keyboardStep: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
456start
457 "return the scrollers range min.
458 (not used with Scrollers, but provided for subclasses)"
459
460 ^ rangeStart
461!
462
463start: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
472start: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
500start: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
511step
512 "return the scrollers range step.
513 (not used with Scrollers, but provided for subclasses)"
514
515 ^ rangeStep
516!
517
518step:step
519 "set the scrollers range step.
520 (not used with Scrollers, but provided for subclasses)"
521
522 rangeStep := step
523!
524
525stop
526 "return the scrollers range max.
527 (not used with Scrollers, but provided for subclasses)"
528
529 ^ rangeEnd
530!
531
532stop: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
541thumbFrame
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
550thumbHeight
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
558thumbHeight: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
603thumbOrigin
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
620thumbOrigin: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
777thumbOrigin: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
838virtualModelValue
839 ^ virtualModelValue
840
841 "Modified (format): / 05-01-2017 / 13:48:27 / svestkap"
842!
843
844virtualModelValue:aNumber
845 virtualModelValue := aNumber.
846
847 "Modified (format): / 05-01-2017 / 13:48:32 / svestkap"
848! !
849
850!Scroller methodsFor:'accessing-behavior'!
851
852action:aBlock
853 "for protocol compatibility; same as scrollAction:"
854
855 self scrollAction:aBlock
856!
857
858asynchronousOperation
859 <resource:#obsolete>
860 self obsoleteMethodWarning:'use #beAsynchronous'.
861 self beAsynchronous
862!
863
864beAsynchronous
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
873beSynchronous
874 "set scroll-mode to be synchronous - scroll action is performed for
875 every movement of thumb (tracking)."
876
877 synchronousOperation := true
878!
879
880enabled
881 "return enable/disable state of the scoller"
882
883 ^ enabled
884
885 "Created: / 30.3.1999 / 15:24:50 / stefan"
886!
887
888enabled: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
902isSynchronous
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
910scrollAction
911 "answer the scroll action block"
912
913 ^ scrollAction
914!
915
916scrollAction:aBlock
917 "set the scroll action, aBlock which is evaluated when scrolled"
918
919 scrollAction := aBlock
920!
921
922scrollDownAction:aBlock
923 "ignored -
924 but implemented, so that scroller can be used in place of a scrollbar"
925!
926
927scrollLeftAction:aBlock
928 "ignored -
929 but implemented, so that scroller can be used in place of a scrollbar"
930!
931
932scrollRightAction:aBlock
933 "ignored -
934 but implemented, so that scroller can be used in place of a scrollbar"
935!
936
937scrollUpAction:aBlock
938 "ignored -
939 but implemented, so that scroller can be used in place of a scrollbar"
940!
941
942synchronousOperation
943 <resource:#obsolete>
944 self obsoleteMethodWarning:'use #beSynchronous'.
945 self beSynchronous
946! !
947
948!Scroller methodsFor:'accessing-bg & border'!
949
950allViewBackground: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
958is3D
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
969orientation
970 "return the scrollers orientation (#vertical or #horizontal)"
971
972 ^ orientation
973!
974
975orientation: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
996thumb
997 "for compatibility with scrollBars, return the receiver"
998
999 ^ self
1000
1001 "Created: 26.5.1996 / 12:21:12 / cg"
1002!
1003
1004thumbColor
1005 "return the thumbs color"
1006
1007 ^ thumbColor
1008!
1009
1010thumbColor: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
1033installRepeat
1034 self installRepeat:repeatDelay.
1035!
1036
1037installRepeat: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
1048pagedAbovePointer
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
1059pagedBelowPointer
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
1074repeatPageDown
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
1084repeatPageUp
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
1096drawEdgedLineFrom: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
1127drawHandleFormAtX: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
1143drawTallyMarks
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
1241drawThumb
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
1446drawThumbBackgroundInX: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
1501buttonControlPress: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
1535buttonMotion: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
1605buttonPress: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
1683buttonRelease: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
1743buttonShiftPress: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
1796changeCursorFor: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
1852highlightThumbForPointerX: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
1873keyPress: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
1883keyRelease: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
1891pointerEnter: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
1905pointerLeave: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
1921redraw
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
1930redrawX: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
1966sizeChanged: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
2075update: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
2091wantsFocusWithButtonPress
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
2101moveLeft
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
2115moveRight
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
2129scrollDown: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
2136scrollStep: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
2152scrollToBeginning
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
2161scrollToEnd
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
2170scrollUp: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
2179tellOthers
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
2207defaultExtent
2208 "compute my extent from sub-components"
2209
2210 ^ self preferredExtent
2211
2212 "Modified: 22.4.1996 / 23:37:53 / cg"
2213!
2214
2215fetchDeviceResources
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
2235initCursor
2236 "set the cursor - a hand"
2237
2238 cursor := Cursor hand
2239!
2240
2241initStyle
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
2400initialize
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
2426realize
2427 super realize.
2428 model notNil ifTrue:[
2429 self thumbOrigin:(model value).
2430 ].
2431! !
2432
2433!Scroller methodsFor:'private'!
2434
2435absFromPercent: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
2456computeThumbFrame
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
2592modelValueCheck: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
2603moveStepMissing
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
2611percentFromAbs: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
2646startMove
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
2660updateBackground
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
2681setThumbFor: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
2741setThumbHeightFor: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
2769setThumbOriginFor: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
2799isMiniScroller
2800 ^ false
2801!
2802
2803isScrolling
2804 "true, if thumb is being moved (by user)"
2805
2806 ^ scrolling
2807!
2808
2809preferredExtent
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
2844thumbVisible
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
2866verticalScrollStep
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
2875version
2876 ^ '$Header$'
2877!
2878
2879version_CVS
2880 ^ '$Header$'
2881!
2882
2883version_HG
2884
2885 ^ '$Changeset: <not expanded> $'
2886! !
2887