Faculty of Information Technology
Software Engineering Group

Ticket #85: Scroller_mouse_event_fixed.st

File Scroller_mouse_event_fixed.st, 87.8 KB (added by Patrik Svestka, 5 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