--- a/Scroller.st Fri Mar 01 19:44:55 1996 +0100
+++ b/Scroller.st Fri Mar 01 19:48:00 1996 +0100
@@ -54,11 +54,6 @@
When moved, either a predefined action is performed (scrollAction),
or a model is informed via the changeMsg (which is #value: by default).
- Beside the obvious 3D rectangle, a scroller may draw a know-form
- (as in NeXT) or little tally marks (as on SGI) in itself.
- These are controlled by the shadowForm, lightForm, tallyLevel and tallyMarks
- instance variables.
-
The scroller can work synchronous (i.e. every move leads to an immediate evaluation
of the action, or asynchronous (i.e. perform action on end-of move).
By default, scrollers are synchronous. Asynchronous operation makes sense,
@@ -68,6 +63,20 @@
and as an abstract superclass for horizontalScrollers, sliders and
miniScrollers.
+ range:
+ the value passed to the model or via the action blocks is scaled according
+ to the min/maxRange instance variables.
+ These default to 0..100 for percentage values.
+ It does not make sense to change the range for scrollbar-scrollers,
+ but may be useful with Sliders or in special applications.
+
+ style stuff:
+
+ Beside the obvious 3D rectangle, a scroller may draw a know-form
+ (as in NeXT) or little tally marks (as on SGI) in itself.
+ These are controlled by the shadowForm, lightForm, tallyLevel and tallyMarks
+ instance variables.
+
Instance variables:
thumbOrigin <Number> origin of thumb (in percent)
@@ -75,14 +84,14 @@
thumbColor <Color> color of thumb
thumbFrameColor <Color> color of the frame around the thumb
scrollAction <Block> 1 arg block to be evaluated when scrolled
- (arg is position in percent)
+ (arg is position in percent)
orientation <Symbol> #horizontal or #vertical
thumbFrame <Rectangle> frame of thumb in pixels (cached)
thumbLevel <Number> level of thumb if 3d
scrolling <Boolean> true during scroll
pressOffset <Number> temporary (offset into frame when move started)
synchronousOperation <Boolean> true if synchronous (i.e. dont wait till release
- to perform action)
+ to perform action)
shadowForm <Form> bitmap of knob if any (shadow part)
lightForm <Form> bitmap of knob if any (light part)
inset <Integer> number of pixels to inset thumb from view borders
@@ -92,10 +101,10 @@
thumbHalfShadowColor <Color> used to draw smooth edges
thumbHalfLightColor <Color> used to draw smooth edges
thumbFrameSizeDifference <Integer> number of pixels the thumb is larger than
- it should be (can be negative for mswin-style)
+ it should be (can be negative for mswin-style)
tallyLevel <Integer> if not zero, specifies if tally-marks should
- go into or out of the display (actually only <0/>0 is checked)
- I dont know of a better word for these ...
+ go into or out of the display (actually only <0/>0 is checked)
+ I dont know of a better word for these ...
tallyMarks <Integer> number of tally marks
fixThumbHeight <Boolean> perform 'wrong' height computation a la mswindows
rangeStart <Number> the range of the scroller
@@ -137,102 +146,116 @@
"
basic scroller setup:
- |top s|
+ |top s|
- top := StandardSystemView new extent:200@200.
- s := Scroller in:top.
- s origin:(0.0@0.0) corner:(20@1.0).
- s thumbHeight:10. 'percent'.
- top open
+ top := StandardSystemView new extent:200@200.
+ s := Scroller in:top.
+ s origin:(0.0@0.0) corner:(20@1.0).
+ s thumbHeight:10. 'percent'.
+ top open
setting its thumb-height:
- |top s|
+ |top s|
- top := StandardSystemView new extent:200@200.
- s := Scroller in:top.
- s origin:(0.0@0.0) corner:(20@1.0).
- s thumbHeight:50. 'percent'.
- top open
+ top := StandardSystemView new extent:200@200.
+ s := Scroller in:top.
+ s origin:(0.0@0.0) corner:(20@1.0).
+ s thumbHeight:50. 'percent'.
+ top open
setting its thumb-origin:
- |top s|
+ |top s|
- top := StandardSystemView new extent:200@200.
- s := Scroller in:top.
- s origin:(0.0@0.0) corner:(20@1.0).
- s thumbHeight:10. 'percent'.
- s thumbOrigin:30. 'percent'.
- top open
+ top := StandardSystemView new extent:200@200.
+ s := Scroller in:top.
+ s origin:(0.0@0.0) corner:(20@1.0).
+ s thumbHeight:10. 'percent'.
+ s thumbOrigin:30. 'percent'.
+ top open
a scroller with action block (ST/X style):
- |top s|
+ |top s|
+
+ top := StandardSystemView new extent:200@200.
+ s := Scroller in:top.
+ s origin:(0.0@0.0) corner:(20@1.0).
+ s thumbHeight:10. 'percent'.
+ s scrollAction:[:percent | Transcript show:'moved to: '; showCr:percent asFloat].
+ top open
+
- top := StandardSystemView new extent:200@200.
- s := Scroller in:top.
- s origin:(0.0@0.0) corner:(20@1.0).
- s thumbHeight:10. 'percent'.
- s scrollAction:[:percent | Transcript show:'moved to: '; showCr:percent asFloat].
- top open
+ setting its range:
+
+ |top s|
+
+ top := StandardSystemView new extent:200@200.
+ s := Scroller in:top.
+ s origin:(0.0@0.0) corner:(20@1.0).
+ s thumbHeight:10. 'percent'.
+ s scrollAction:[:percent | Transcript show:'moved to: '; showCr:percent asFloat].
+ s start:0 stop:1.
+ top open
create a scroller in its default extent and have it positioned
- at the right; beside another view:
+ at the side; beside another view:
- |top s v|
+ |top s v|
- top := StandardSystemView new extent:200@200.
- s := Scroller in:top.
- s origin:(0.0@0.0) corner:(0.0@1.0).
- s rightInset:(s preferredExtent x negated).
- s thumbHeight:10.
- s level:1.
+ top := StandardSystemView new extent:200@200.
+ s := Scroller in:top.
+ s origin:(0.0@0.0) corner:(0.0@1.0).
+ s rightInset:(s preferredExtent x negated).
+ s thumbHeight:10.
+ s level:1.
- v := View in:top.
- v origin:0.0@0.0 corner:1.0@1.0.
- v leftInset:(s preferredExtent x).
- v viewBackground:Color red.
- v level:2.
+ v := View in:top.
+ v origin:0.0@0.0 corner:1.0@1.0.
+ v leftInset:(s preferredExtent x).
+ v viewBackground:Color red.
+ v level:2.
- top open
+ top open
using a model (ST-80 style):
- |top s m|
+ |top s m|
+
+ m := 0 asValue.
+ InspectorView openOn:m monitor:'value'. 'look at value'.
- m := 0 asValue.
- m inspect. 'look at value'.
- top := StandardSystemView new extent:200@200.
- s := Scroller in:top.
- s origin:(0.0@0.0) corner:(20@1.0).
- s thumbHeight:10. 'percent'.
- s model:m.
- top open
+ top := StandardSystemView new extent:200@200.
+ s := Scroller in:top.
+ s origin:(0.0@0.0) corner:(20@1.0).
+ s thumbHeight:10. 'percent'.
+ s model:m.
+ top open
using a different changeSelector:
- |top s1 s2 m|
+ |top s1 s2 m|
- m := Plug new.
- m respondTo:#value1: with:[:v | Transcript show:'scroller 1 moved to: '; showCr:v].
- m respondTo:#value2: with:[:v | Transcript show:'scroller 2 moved to: '; showCr:v].
+ m := Plug new.
+ m respondTo:#value1: with:[:v | Transcript show:'scroller 1 moved to: '; showCr:v].
+ m respondTo:#value2: with:[:v | Transcript show:'scroller 2 moved to: '; showCr:v].
- top := StandardSystemView new extent:200@200.
- s1 := Scroller in:top.
- s1 origin:(0.0@0.0) corner:(20@1.0).
- s1 thumbHeight:10. 'percent'.
- s1 model:m; change:#value1:.
+ top := StandardSystemView new extent:200@200.
+ s1 := Scroller in:top.
+ s1 origin:(0.0@0.0) corner:(20@1.0).
+ s1 thumbHeight:10. 'percent'.
+ s1 model:m; change:#value1:.
- s2 := Scroller in:top.
- s2 origin:(30@0.0) corner:(50@1.0).
- s2 thumbHeight:10. 'percent'.
- s2 model:m; change:#value2:.
- top open
+ s2 := Scroller in:top.
+ s2 origin:(30@0.0) corner:(50@1.0).
+ s2 thumbHeight:10. 'percent'.
+ s2 model:m; change:#value2:.
+ top open
"
! !
@@ -352,17 +375,180 @@
"Modified: 1.3.1996 / 19:12:10 / cg"
!
-start:start
- "set the scrollers range start"
+or may be not available for the copy
+ "
+ (orientation == #vertical) ifTrue:[
+ self drawThumbBackgroundInX:thumbLeft y:oldTop
+ width:tW height:(height - oldTop).
+ ] ifFalse:[
+ self drawThumbBackgroundInX:oldLeft y:thumbTop
+ width:(width - oldLeft) height:tH.
+ ].
+ self drawThumb.
+ ^ self
+ ].
+
+ self catchExpose.
+ "
+ copy the thumbs pixels
+ "
+ (orientation == #vertical) ifTrue:[
+ self copyFrom:self x:thumbLeft y:oldTop
+ toX:thumbLeft y:thumbTop
+ width:tW height:tH.
+ ] ifFalse:[
+ self copyFrom:self x:oldLeft y:thumbTop
+ toX:thumbLeft y:thumbTop
+ width:tW height:tH.
+ ].
- rangeStart := start.
+ "
+ clear some of the previous thumbs area to background
+ "
+ (orientation == #vertical) ifTrue:[
+ bgLeft := thumbLeft.
+ bgWidth := tW.
+ oldTop > thumbTop ifTrue:[
+ delta := oldTop - thumbTop.
+ oldTop > thumbBot ifTrue:[
+ bgTop := oldTop.
+ bgHeight := tH + 1
+ ] ifFalse:[
+ bgTop := thumbBot.
+ bgHeight := delta
+ ]
+ ] ifFalse:[
+ delta := thumbTop - oldTop.
+ oldBot < thumbTop ifTrue:[
+ bgTop := oldTop.
+ bgHeight := tH + 1
+ ] ifFalse:[
+ bgTop := oldTop.
+ bgHeight := delta
+ ]
+ ].
+ ] ifFalse:[
+ bgTop := thumbTop.
+ bgHeight := tH.
+ oldLeft > thumbLeft ifTrue:[
+ delta := oldLeft - thumbLeft.
+ oldLeft > thumbRight ifTrue:[
+ bgLeft := oldLeft.
+ bgWidth := tW + 1.
+ ] ifFalse:[
+ bgLeft := thumbRight.
+ bgWidth := delta.
+ ]
+ ] ifFalse:[
+ delta := thumbLeft - oldLeft.
+ oldRight < thumbLeft ifTrue:[
+ bgLeft := oldLeft.
+ bgWidth := tW + 1.
+ ] ifFalse:[
+ bgLeft := oldLeft.
+ bgWidth := delta.
+ ]
+ ].
+ ].
+ self drawThumbBackgroundInX:bgLeft y:bgTop width:bgWidth height:bgHeight.
+ self waitForExpose
+ ]
+ ] ifFalse:[
+ thumbFrame := nil
+ ]
+ ]
!
-start:start stop:stop
+ifTrue:[
+ self drawThumbBackgroundInX:thumbLeft y:oldTop
+ width:tW height:(height - oldTop).
+ ] ifFalse:[
+ self drawThumbBackgroundInX:oldLeft y:thumbTop
+ width:(width - oldLeft) height:tH.
+ ].
+ self drawThumb.
+ ^ self
+ ].
+
+ self catchExpose.
+ "
+ copy the thumbs pixels
+ "
+ (orientation == #vertical) ifTrue:[
+ self copyFrom:self x:thumbLeft y:oldTop
+ toX:thumbLeft y:thumbTop
+ width:tW height:tH.
+ ] ifFalse:[
+ self copyFrom:self x:oldLeft y:thumbTop
+ toX:thumbLeft y:thumbTop
+ width:tW height:tH.
+ ].
+
+ "
+ clear some of the previous thumbs area to background
+ "
+ (orientation == #vertical) ifTrue:[
+ bgLeft := thumbLeft.
+ bgWidth := tW.
+ oldTop > thumbTop ifTrue:[
+ delta := oldTop - thumbTop.
+ oldTop > thumbBot ifTrue:[
+ bgTop := oldTop.
+ bgHeight := tH + 1
+ ] ifFalse:[
+ bgTop := thumbBot.
+ bgHeight := delta
+ ]
+ ] ifFalse:[
+ delta := thumbTop - oldTop.
+ oldBot < thumbTop ifTrue:[
+ bgTop := oldTop.
+ bgHeight := tH + 1
+ ] ifFalse:[
+ bgTop := oldTop.
+ bgHeight := delta
+ ]
+ ].
+ ] ifFalse:[
+ bgTop := thumbTop.
+ bgHeight := tH.
+ oldLeft > thumbLeft ifTrue:[
+ delta := oldLeft - thumbLeft.
+ oldLeft > thumbRight ifTrue:[
+ bgLeft := oldLeft.
+ bgWidth := tW + 1.
+ ] ifFalse:[
+ bgLeft := thumbRight.
+ bgWidth := delta.
+ ]
+ ] ifFalse:[
+ delta := thumbLeft - oldLeft.
+ oldRight < thumbLeft ifTrue:[
+ bgLeft := oldLeft.
+ bgWidth := tW + 1.
+ ] ifFalse:[
+ bgLeft := oldLeft.
+ bgWidth := delta.
+ ]
+ ].
+ ].
+ self drawThumbBackgroundInX:bgLeft y:bgTop width:bgWidth height:bgHeight.
+ self waitForExpose
+ ]
+ ] ifFalse:[
+ thumbFrame := nil
+ ]
+ ]
+!
+
+start:start stop:stop step:step
"set the scrollers range"
rangeStart := start.
- rangeEnd := stop
+ rangeEnd := stop.
+ rangeStep := step.
+
+ "Created: 1.3.1996 / 19:39:18 / cg"
!
step
@@ -373,10 +559,82 @@
"Modified: 1.3.1996 / 19:12:16 / cg"
!
-step:step
- "set the scrollers range step"
+:thumbTop
+ width:(width - oldLeft) height:tH.
+ ].
+ self drawThumb.
+ ^ self
+ ].
+
+ self catchExpose.
+ "
+ copy the thumbs pixels
+ "
+ (orientation == #vertical) ifTrue:[
+ self copyFrom:self x:thumbLeft y:oldTop
+ toX:thumbLeft y:thumbTop
+ width:tW height:tH.
+ ] ifFalse:[
+ self copyFrom:self x:oldLeft y:thumbTop
+ toX:thumbLeft y:thumbTop
+ width:tW height:tH.
+ ].
- rangeStep := step
+ "
+ clear some of the previous thumbs area to background
+ "
+ (orientation == #vertical) ifTrue:[
+ bgLeft := thumbLeft.
+ bgWidth := tW.
+ oldTop > thumbTop ifTrue:[
+ delta := oldTop - thumbTop.
+ oldTop > thumbBot ifTrue:[
+ bgTop := oldTop.
+ bgHeight := tH + 1
+ ] ifFalse:[
+ bgTop := thumbBot.
+ bgHeight := delta
+ ]
+ ] ifFalse:[
+ delta := thumbTop - oldTop.
+ oldBot < thumbTop ifTrue:[
+ bgTop := oldTop.
+ bgHeight := tH + 1
+ ] ifFalse:[
+ bgTop := oldTop.
+ bgHeight := delta
+ ]
+ ].
+ ] ifFalse:[
+ bgTop := thumbTop.
+ bgHeight := tH.
+ oldLeft > thumbLeft ifTrue:[
+ delta := oldLeft - thumbLeft.
+ oldLeft > thumbRight ifTrue:[
+ bgLeft := oldLeft.
+ bgWidth := tW + 1.
+ ] ifFalse:[
+ bgLeft := thumbRight.
+ bgWidth := delta.
+ ]
+ ] ifFalse:[
+ delta := thumbLeft - oldLeft.
+ oldRight < thumbLeft ifTrue:[
+ bgLeft := oldLeft.
+ bgWidth := tW + 1.
+ ] ifFalse:[
+ bgLeft := oldLeft.
+ bgWidth := delta.
+ ]
+ ].
+ ].
+ self drawThumbBackgroundInX:bgLeft y:bgTop width:bgWidth height:bgHeight.
+ self waitForExpose
+ ]
+ ] ifFalse:[
+ thumbFrame := nil
+ ]
+ ]
!
stop
@@ -387,19 +645,114 @@
"Modified: 1.3.1996 / 19:12:20 / cg"
!
-stop:stop
- "set the scrollers range stop"
+copy the thumbs pixels
+ "
+ (orientation == #vertical) ifTrue:[
+ self copyFrom:self x:thumbLeft y:oldTop
+ toX:thumbLeft y:thumbTop
+ width:tW height:tH.
+ ] ifFalse:[
+ self copyFrom:self x:oldLeft y:thumbTop
+ toX:thumbLeft y:thumbTop
+ width:tW height:tH.
+ ].
- rangeEnd := stop
+ "
+ clear some of the previous thumbs area to background
+ "
+ (orientation == #vertical) ifTrue:[
+ bgLeft := thumbLeft.
+ bgWidth := tW.
+ oldTop > thumbTop ifTrue:[
+ delta := oldTop - thumbTop.
+ oldTop > thumbBot ifTrue:[
+ bgTop := oldTop.
+ bgHeight := tH + 1
+ ] ifFalse:[
+ bgTop := thumbBot.
+ bgHeight := delta
+ ]
+ ] ifFalse:[
+ delta := thumbTop - oldTop.
+ oldBot < thumbTop ifTrue:[
+ bgTop := oldTop.
+ bgHeight := tH + 1
+ ] ifFalse:[
+ bgTop := oldTop.
+ bgHeight := delta
+ ]
+ ].
+ ] ifFalse:[
+ bgTop := thumbTop.
+ bgHeight := tH.
+ oldLeft > thumbLeft ifTrue:[
+ delta := oldLeft - thumbLeft.
+ oldLeft > thumbRight ifTrue:[
+ bgLeft := oldLeft.
+ bgWidth := tW + 1.
+ ] ifFalse:[
+ bgLeft := thumbRight.
+ bgWidth := delta.
+ ]
+ ] ifFalse:[
+ delta := thumbLeft - oldLeft.
+ oldRight < thumbLeft ifTrue:[
+ bgLeft := oldLeft.
+ bgWidth := tW + 1.
+ ] ifFalse:[
+ bgLeft := oldLeft.
+ bgWidth := delta.
+ ]
+ ].
+ ].
+ self drawThumbBackgroundInX:bgLeft y:bgTop width:bgWidth height:bgHeight.
+ self waitForExpose
+ ]
+ ] ifFalse:[
+ thumbFrame := nil
+ ]
+ ]
!
-thumbFrame
- "return the area used by the thumbFrame (in device coordinates).
- Allows access to the thumbs physical screen position, for
- example to position a label below (see Slider-Examples)"
-
- thumbFrame isNil ifTrue:[ self computeThumbFrame].
- ^ thumbFrame
+umbTop - oldTop.
+ oldBot < thumbTop ifTrue:[
+ bgTop := oldTop.
+ bgHeight := tH + 1
+ ] ifFalse:[
+ bgTop := oldTop.
+ bgHeight := delta
+ ]
+ ].
+ ] ifFalse:[
+ bgTop := thumbTop.
+ bgHeight := tH.
+ oldLeft > thumbLeft ifTrue:[
+ delta := oldLeft - thumbLeft.
+ oldLeft > thumbRight ifTrue:[
+ bgLeft := oldLeft.
+ bgWidth := tW + 1.
+ ] ifFalse:[
+ bgLeft := thumbRight.
+ bgWidth := delta.
+ ]
+ ] ifFalse:[
+ delta := thumbLeft - oldLeft.
+ oldRight < thumbLeft ifTrue:[
+ bgLeft := oldLeft.
+ bgWidth := tW + 1.
+ ] ifFalse:[
+ bgLeft := oldLeft.
+ bgWidth := delta.
+ ]
+ ].
+ ].
+ self drawThumbBackgroundInX:bgLeft y:bgTop width:bgWidth height:bgHeight.
+ self waitForExpose
+ ]
+ ] ifFalse:[
+ thumbFrame := nil
+ ]
+ ]
!
thumbHeight
@@ -410,47 +763,23 @@
"Modified: 1.3.1996 / 19:12:28 / cg"
!
-thumbHeight:aNumber
- "set the thumbs height (in percent by default)"
-
- |newHeight realNewHeight oldFrame nBg|
-
- newHeight := aNumber / (rangeEnd - rangeStart / 100).
-
- (newHeight > 100) ifTrue:[
- realNewHeight := 100
- ] ifFalse:[
- realNewHeight := newHeight
- ].
- ((realNewHeight ~= thumbHeight) or:[thumbFrame isNil]) ifTrue:[
- thumbHeight := realNewHeight.
-
- (DefaultFullViewBackground notNil
- and:[DefaultViewBackground notNil
- and:[DefaultFullViewBackground ~~ DefaultViewBackground]]) ifTrue:[
- realNewHeight >= 100 ifTrue:[
- nBg := DefaultFullViewBackground.
- ] ifFalse:[
- nBg := DefaultViewBackground
- ].
- nBg := nBg on:device.
- nBg ~~ viewBackground ifTrue:[
- self viewBackground:nBg.
- shown ifTrue:[self clear].
- ]
- ].
-
- shown ifTrue:[
- oldFrame := thumbFrame.
- self computeThumbFrame.
- (fixThumbHeight or:[oldFrame ~~ thumbFrame]) ifTrue:[
- oldFrame notNil ifTrue:[
- self drawThumbBackgroundInX:(oldFrame left)
- y:(oldFrame top)
- width:(oldFrame width)
- height:(oldFrame height).
+[
+ bgLeft := thumbRight.
+ bgWidth := delta.
+ ]
+ ] ifFalse:[
+ delta := thumbLeft - oldLeft.
+ oldRight < thumbLeft ifTrue:[
+ bgLeft := oldLeft.
+ bgWidth := tW + 1.
+ ] ifFalse:[
+ bgLeft := oldLeft.
+ bgWidth := delta.
+ ]
+ ].
].
- self drawThumb
+ self drawThumbBackgroundInX:bgLeft y:bgTop width:bgWidth height:bgHeight.
+ self waitForExpose
]
] ifFalse:[
thumbFrame := nil
@@ -466,10 +795,1155 @@
"Modified: 1.3.1996 / 19:12:37 / cg"
!
-thumbOrigin:aNumber
- "set the thumbs origin (in percent by default)"
+old ~~ new.
+ changed ifFalse:[
+ old := self absFromPercent:thumbHeight.
+ new := self absFromPercent:realNewHeight.
+ changed := (old ~~ new)
+ ].
+ (changed or:[thumbFrame isNil]) ifTrue:[
+ thumbOrigin := realNewOrigin.
+ thumbHeight := realNewHeight.
+
+ (DefaultFullViewBackground notNil
+ and:[DefaultViewBackground notNil
+ and:[DefaultFullViewBackground ~~ DefaultViewBackground]]) ifTrue:[
+ realNewHeight >= 100 ifTrue:[
+ nBg := DefaultFullViewBackground.
+ ] ifFalse:[
+ nBg := DefaultViewBackground
+ ].
+ nBg := nBg on:device.
+ nBg ~~ viewBackground ifTrue:[
+ self viewBackground:nBg.
+ shown ifTrue:[self clear].
+ ]
+ ].
+
+ shown ifTrue:[
+ thumbFrame notNil ifTrue:[
+ self drawThumbBackgroundInX:(thumbFrame left)
+ y:(thumbFrame top)
+ width:(thumbFrame width)
+ height:(thumbFrame height).
+ ].
+ self computeThumbFrame.
+ self drawThumb
+ ] ifFalse:[
+ thumbFrame := nil
+ ]
+ ]
+ ]
+!
+
+humbColor.
+ self fillRectangleX:l y:t width:w-1 height:h.
+
+ thumbLevel == 0 ifTrue:[
+ thumbFrameColor notNil ifTrue:[
+ self paint:thumbFrameColor.
+ self displayRectangle:thumbFrame.
+ ].
+ ^ self
+ ].
+
+ "what a kludge - must be a parameter to drawEdge..."
+ self drawEdgesForX:l y:t width:w height:h level:thumbLevel
+ shadow:thumbShadowColor light:thumbLightColor
+ halfShadow:thumbHalfShadowColor halfLight:thumbHalfLightColor
+ style:thumbEdgeStyle.
+
+ thumbFrameColor notNil ifTrue:[
+ self paint:thumbFrameColor.
+ orientation == #vertical ifTrue:[
+ self displayRectangleX:l y:t width:w"-1" height:h.
+ ] ifFalse:[
+ self displayRectangleX:l y:t width:w height:h"-1".
+ ]
+ ].
+
+ (tallyLevel == 0 or:[tallyMarks == 0]) ifTrue:[
+ shadowForm notNil ifTrue:[
+ handleX := l + ((w - 8) // 2).
+ handleY := t + ((h - 8) // 2).
+ self drawHandleFormAtX:handleX y:handleY
+ ].
+ ^ self
+ ].
+
+ "iris style - draw tallys"
+
+ tallyLevel > 0 ifTrue:[
+ color1 := thumbLightColor.
+ color2 := thumbShadowColor.
+ ] ifFalse:[
+ color1 := thumbShadowColor.
+ color2 := thumbLightColor.
+ ].
+
+ "draw tally marks"
+
+ (orientation == #vertical) ifTrue:[
+ self paint:color1.
+ y := t + (h // 2) - 1.
+ xL := l + thumbLevel - 1.
+ xR := l + w - thumbLevel "+ 1".
+ self displayLineFromX:xL y:y toX:xR y:y.
+ y := y + 1.
+ self paint:color2.
+ self displayLineFromX:xL y:y toX:xR y:y.
+
+ tallyMarks > 1 ifTrue:[
+ "dont draw other marks if there is not enough space"
+
+ mm := device verticalPixelPerMillimeter rounded.
+ h > (mm * (tallyMarks * 2)) ifTrue:[
+ y := y - 1 - mm.
+ self paint:color1.
+ self displayLineFromX:xL y:y toX:xR y:y.
+ y := y + 1.
+ self paint:color2.
+ self displayLineFromX:xL y:y toX:xR y:y.
+
+ y := y - 1 + mm + mm.
+ self paint:color1.
+ self displayLineFromX:xL y:y toX:xR y:y.
+ y := y + 1.
+ self paint:color2.
+ self displayLineFromX:xL y:y toX:xR y:y
+ ]
+ ]
+ ] ifFalse:[
+ x := l + (w // 2) - 1.
+ yT := t + thumbLevel - 1.
+ yB := t + h - thumbLevel "+ 1".
+ self paint:color1.
+ self displayLineFromX:x y:yT toX:x y:yB.
+ self paint:color2.
+ x := x + 1.
+ self displayLineFromX:x y:yT toX:x y:yB.
+
+ tallyMarks > 1 ifTrue:[
+ "dont draw other marks if there is not enough space"
+
+ mm := device horizontalPixelPerMillimeter rounded.
+ w > (mm * (tallyMarks * 2)) ifTrue:[
+ x := x - 1 - mm.
+ self paint:color1.
+ self displayLineFromX:x y:yT toX:x y:yB.
+ x := x + 1.
+ self paint:color2.
+ self displayLineFromX:x y:yT toX:x y:yB.
+
+ x := x - 1 + mm + mm.
+ self paint:color1.
+ self displayLineFromX:x y:yT toX:x y:yB.
+ x := x + 1.
+ self paint:color2.
+ self displayLineFromX:x y:yT toX:x y:yB
+ ]
+ ]
+ ]
+! !
+
+!Scroller methodsFor:'accessing-behavior'!
+
+start
+ "return the scrollers range min"
+
+ ^ rangeStart
+
+ "Modified: 1.3.1996 / 19:12:10 / cg"
+!
+
+g"
+!
+
+return the scrollers range max"
+
+ ^ rangeEnd
+
+ "Modified: 1.3.1996 / 19:12:20 / cg"
+!
+
+/ 19:12:20 / cg"
+!
+
+a used by the thumbFrame (in device coordinates).
+ Allows access to the thumbs physical screen position, for
+ example to position a label below (see Slider-Examples)"
+
+ thumbFrame isNil ifTrue:[ self computeThumbFrame].
+ ^ thumbFrame
+!
+
+example to position a label below (see Slider-Examples)"
+
+ thumbFrame isNil ifTrue:[ self computeThumbFrame].
+ ^ thumbFrame
+!
+
+self copyFrom:self x:thumbLeft y:oldTop
+ toX:thumbLeft y:thumbTop
+ width:tW height:tH.
+ ] ifFalse:[
+ self copyFrom:self x:oldLeft y:thumbTop
+ toX:thumbLeft y:thumbTop
+ width:tW height:tH.
+ ].
+
+ "
+ clear some of the previous thumbs area to background
+ "
+ (orientation == #vertical) ifTrue:[
+ bgLeft := thumbLeft.
+ bgWidth := tW.
+ oldTop > thumbTop ifTrue:[
+ delta := oldTop - thumbTop.
+ oldTop > thumbBot ifTrue:[
+ bgTop := oldTop.
+ bgHeight := tH + 1
+ ] ifFalse:[
+ bgTop := thumbBot.
+ bgHeight := delta
+ ]
+ ] ifFalse:[
+ delta := thumbTop - oldTop.
+ oldBot < thumbTop ifTrue:[
+ bgTop := oldTop.
+ bgHeight := tH + 1
+ ] ifFalse:[
+ bgTop := oldTop.
+ bgHeight := delta
+ ]
+ ].
+ ] ifFalse:[
+ bgTop := thumbTop.
+ bgHeight := tH.
+ oldLeft > thumbLeft ifTrue:[
+ delta := oldLeft - thumbLeft.
+ oldLeft > thumbRight ifTrue:[
+ bgLeft := oldLeft.
+ bgWidth := tW + 1.
+ ] ifFalse:[
+ bgLeft := thumbRight.
+ bgWidth := delta.
+ ]
+ ] ifFalse:[
+ delta := thumbLeft - oldLeft.
+ oldRight < thumbLeft ifTrue:[
+ bgLeft := oldLeft.
+ bgWidth := tW + 1.
+ ] ifFalse:[
+ bgLeft := oldLeft.
+ bgWidth := delta.
+ ]
+ ].
+ ].
+ self drawThumbBackgroundInX:bgLeft y:bgTop width:bgWidth height:bgHeight.
+ self waitForExpose
+ ]
+ ] ifFalse:[
+ thumbFrame := nil
+ ]
+ ]
+! !
+
+!Scroller methodsFor:'accessing-look'!
+
+return the scrollers range step"
+
+ ^ rangeStep
+
+ "Modified: 1.3.1996 / 19:12:16 / cg"
+!
+
+/ 19:12:16 / cg"
+!
+
+toX:thumbLeft y:thumbTop
+ width:tW height:tH.
+ ].
+
+ "
+ clear some of the previous thumbs area to background
+ "
+ (orientation == #vertical) ifTrue:[
+ bgLeft := thumbLeft.
+ bgWidth := tW.
+ oldTop > thumbTop ifTrue:[
+ delta := oldTop - thumbTop.
+ oldTop > thumbBot ifTrue:[
+ bgTop := oldTop.
+ bgHeight := tH + 1
+ ] ifFalse:[
+ bgTop := thumbBot.
+ bgHeight := delta
+ ]
+ ] ifFalse:[
+ delta := thumbTop - oldTop.
+ oldBot < thumbTop ifTrue:[
+ bgTop := oldTop.
+ bgHeight := tH + 1
+ ] ifFalse:[
+ bgTop := oldTop.
+ bgHeight := delta
+ ]
+ ].
+ ] ifFalse:[
+ bgTop := thumbTop.
+ bgHeight := tH.
+ oldLeft > thumbLeft ifTrue:[
+ delta := oldLeft - thumbLeft.
+ oldLeft > thumbRight ifTrue:[
+ bgLeft := oldLeft.
+ bgWidth := tW + 1.
+ ] ifFalse:[
+ bgLeft := thumbRight.
+ bgWidth := delta.
+ ]
+ ] ifFalse:[
+ delta := thumbLeft - oldLeft.
+ oldRight < thumbLeft ifTrue:[
+ bgLeft := oldLeft.
+ bgWidth := tW + 1.
+ ] ifFalse:[
+ bgLeft := oldLeft.
+ bgWidth := delta.
+ ]
+ ].
+ ].
+ self drawThumbBackgroundInX:bgLeft y:bgTop width:bgWidth height:bgHeight.
+ self waitForExpose
+ ]
+ ] ifFalse:[
+ thumbFrame := nil
+ ]
+ ]
+!
+
+.
+
+ "
+ clear some of the previous thumbs area to background
+ "
+ (orientation == #vertical) ifTrue:[
+ bgLeft := thumbLeft.
+ bgWidth := tW.
+ oldTop > thumbTop ifTrue:[
+ delta := oldTop - thumbTop.
+ oldTop > thumbBot ifTrue:[
+ bgTop := oldTop.
+ bgHeight := tH + 1
+ ] ifFalse:[
+ bgTop := thumbBot.
+ bgHeight := delta
+ ]
+ ] ifFalse:[
+ delta := thumbTop - oldTop.
+ oldBot < thumbTop ifTrue:[
+ bgTop := oldTop.
+ bgHeight := tH + 1
+ ] ifFalse:[
+ bgTop := oldTop.
+ bgHeight := delta
+ ]
+ ].
+ ] ifFalse:[
+ bgTop := thumbTop.
+ bgHeight := tH.
+ oldLeft > thumbLeft ifTrue:[
+ delta := oldLeft - thumbLeft.
+ oldLeft > thumbRight ifTrue:[
+ bgLeft := oldLeft.
+ bgWidth := tW + 1.
+ ] ifFalse:[
+ bgLeft := thumbRight.
+ bgWidth := delta.
+ ]
+ ] ifFalse:[
+ delta := thumbLeft - oldLeft.
+ oldRight < thumbLeft ifTrue:[
+ bgLeft := oldLeft.
+ bgWidth := tW + 1.
+ ] ifFalse:[
+ bgLeft := oldLeft.
+ bgWidth := delta.
+ ]
+ ].
+ ].
+ self drawThumbBackgroundInX:bgLeft y:bgTop width:bgWidth height:bgHeight.
+ self waitForExpose
+ ]
+ ] ifFalse:[
+ thumbFrame := nil
+ ]
+ ]
+! !
+
+!Scroller methodsFor:'drawing'!
+
+self displayLineFromX:xL y:y toX:xR y:y
+ ]
+ ]
+ ] ifFalse:[
+ x := l + (w // 2) - 1.
+ yT := t + thumbLevel - 1.
+ yB := t + h - thumbLevel "+ 1".
+ self paint:color1.
+ self displayLineFromX:x y:yT toX:x y:yB.
+ self paint:color2.
+ x := x + 1.
+ self displayLineFromX:x y:yT toX:x y:yB.
+
+ tallyMarks > 1 ifTrue:[
+ "dont draw other marks if there is not enough space"
+
+ mm := device horizontalPixelPerMillimeter rounded.
+ w > (mm * (tallyMarks * 2)) ifTrue:[
+ x := x - 1 - mm.
+ self paint:color1.
+ self displayLineFromX:x y:yT toX:x y:yB.
+ x := x + 1.
+ self paint:color2.
+ self displayLineFromX:x y:yT toX:x y:yB.
+
+ x := x - 1 + mm + mm.
+ self paint:color1.
+ self displayLineFromX:x y:yT toX:x y:yB.
+ x := x + 1.
+ self paint:color2.
+ self displayLineFromX:x y:yT toX:x y:yB
+ ]
+ ]
+ ]
+!
+
+T toX:x y:yB.
+
+ tallyMarks > 1 ifTrue:[
+ "dont draw other marks if there is not enough space"
+
+ mm := device horizontalPixelPerMillimeter rounded.
+ w > (mm * (tallyMarks * 2)) ifTrue:[
+ x := x - 1 - mm.
+ self paint:color1.
+ self displayLineFromX:x y:yT toX:x y:yB.
+ x := x + 1.
+ self paint:color2.
+ self displayLineFromX:x y:yT toX:x y:yB.
+
+ x := x - 1 + mm + mm.
+ self paint:color1.
+ self displayLineFromX:x y:yT toX:x y:yB.
+ x := x + 1.
+ self paint:color2.
+ self displayLineFromX:x y:yT toX:x y:yB
+ ]
+ ]
+ ]
+!
+
+roll
+ action is now performed"
+
+ |rect|
+
+ scrolling ifTrue:[
+ thumbFrame notNil ifTrue:[
+ frameBeforeMove notNil ifTrue:[
+ rect := frameBeforeMove.
+ frameBeforeMove := nil.
+ self drawThumbBackgroundInX:rect left
+ y:rect top
+ width:rect width
+ height:rect height.
+ (rect intersects:thumbFrame) ifTrue:[
+ self drawThumb
+ ]
+ ].
+
+ scrolling := false.
+ synchronousOperation ifFalse: [
+ self tellOthers.
+ ]
+ ]
+ ]
+
+ "Modified: 23.12.1995 / 12:42:25 / cg"
+! !
+
+!Scroller methodsFor:'event handling'!
+
+l) ifTrue:[
+ curr := y.
+ curr2 := y - (thumbFrame height // 2).
+ limit1 := height.
+ limit2 := thumbFrame top
+ ] ifFalse:[
+ curr := x.
+ curr2 := x - (thumbFrame width // 2).
+ limit1 := width.
+ limit2 := thumbFrame left
+ ].
+
+ (curr2 < 0) ifTrue:[ "check against limits"
+ pos := 0
+ ] ifFalse:[
+ (curr2 > limit1) ifTrue:[
+ pos := limit1
+ ] ifFalse:[
+ pos := curr2
+ ]
+ ].
+
+ frameBeforeMove := thumbFrame insetBy:1@1.
+
+ self thumbOrigin:(self percentFromAbs:pos).
+ self tellOthers.
+
+ (orientation == #vertical) ifTrue:[
+ limit2 := thumbFrame top
+ ] ifFalse:[
+ limit2 := thumbFrame left
+ ].
+ pressOffset := curr - limit2.
+ scrolling := true
+!
+
+self
+ ].
+ ((y + h) < thumbFrame top) ifTrue:[
+ ^ self
+ ].
+ self drawThumb
+ ]
+!
+
+humb
+ ]
+!
+
+ght"
+
+ self thumbOrigin:(thumbOrigin + thumbHeight).
+ self tellOthers
+!
+
+].
+ DefaultShadowColor notNil ifTrue:[
+ shadowColor := DefaultShadowColor on:device.
+ ].
+ DefaultLightColor notNil ifTrue:[
+ lightColor := DefaultLightColor on:device.
+ ].
+
+ tallyMarks := DefaultTallyMarks.
+ tallyLevel := DefaultTallyLevel.
+ DefaultLevel ~~ level ifTrue:[
+ self level:DefaultLevel.
+ ].
+ DefaultBorderWidth ~~ borderWidth ifTrue:[
+ self borderWidth:DefaultBorderWidth.
+ ].
+ thumbLevel := DefaultThumbLevel.
+ inset := DefaultInset.
+ fixThumbHeight := DefaultFixThumbHeight.
+ thumbEdgeStyle := DefaultEdgeStyle.
+
+ DefaultGhostColor notNil ifTrue:[
+ ghostColor := DefaultGhostColor on:device.
+ ].
+ DefaultGhostFrameColor notNil ifTrue:[
+ ghostFrameColor := DefaultGhostFrameColor on:device.
+ ].
+ ghostLevel := DefaultGhostLevel.
- |newOrigin realNewOrigin
+ DefaultThumbFrameColor notNil ifTrue:[
+ thumbFrameColor := DefaultThumbFrameColor on:device.
+ ].
+ DefaultThumbShadowColor notNil ifTrue:[
+ thumbShadowColor := DefaultThumbShadowColor
+ ] ifFalse:[
+ thumbShadowColor := shadowColor.
+ ].
+ DefaultThumbLightColor notNil ifTrue:[
+ thumbLightColor := DefaultThumbLightColor
+ ] ifFalse:[
+ thumbLightColor := lightColor.
+ ].
+
+ thumbEdgeStyle notNil ifTrue:[
+ DefaultThumbHalfShadowColor notNil ifTrue:[
+ thumbHalfShadowColor := DefaultThumbHalfShadowColor
+ ].
+ DefaultThumbHalfLightColor notNil ifTrue:[
+ thumbHalfLightColor := DefaultThumbHalfLightColor
+ ].
+ ].
+
+ device hasGreyscales ifFalse:[
+ thumbEdgeStyle notNil ifTrue:[
+ thumbHalfShadowColor := Color darkGrey.
+ thumbHalfLightColor := White
+ ].
+
+ thumbShadowColor := Black.
+"/ thumbLightColor := White.
+
+ styleSheet name = #motif ifTrue:[
+ DefaultThumbColor isNil ifTrue:[
+ thumbColor := White .
+ ].
+ ]
+ ].
+
+ DefaultThumbColor notNil ifTrue:[
+ thumbColor := DefaultThumbColor on:device
+ ] ifFalse:[
+ thumbColor := White.
+ styleSheet name ~= #normal ifTrue:[
+ device hasGreyscales ifFalse:[
+ thumbColor := Color grey
+ ].
+ ].
+ ].
+
+ thumbColor := thumbColor on:device.
+ thumbShadowColor notNil ifTrue:[
+ thumbShadowColor := thumbShadowColor on:device.
+ ].
+ thumbLightColor notNil ifTrue:[
+ thumbLightColor := thumbLightColor on:device.
+ ].
+ thumbHalfShadowColor notNil ifTrue:[
+ thumbHalfShadowColor := thumbHalfShadowColor on:device.
+ ].
+ thumbHalfLightColor notNil ifTrue:[
+ thumbHalfLightColor := thumbHalfLightColor on:device.
+ ].
+ thumbEdgeStyle notNil ifTrue:[
+ thumbHalfShadowColor isNil ifTrue:[
+ thumbHalfShadowColor := thumbShadowColor lightened on:device
+ ]
+ ].
+
+ styleSheet name = #next ifTrue:[
+ shadowForm := self class handleShadowFormOn:device.
+ lightForm := self class handleLightFormOn:device
+ ] ifFalse:[
+ shadowForm := lightForm := nil
+ ].
+
+ drawableId notNil ifTrue:[
+ self computeThumbFrame
+ ]
+!
+
+mbFrameColor := DefaultThumbFrameColor on:device.
+ ].
+ DefaultThumbShadowColor notNil ifTrue:[
+ thumbShadowColor := DefaultThumbShadowColor
+ ] ifFalse:[
+ thumbShadowColor := shadowColor.
+ ].
+ DefaultThumbLightColor notNil ifTrue:[
+ thumbLightColor := DefaultThumbLightColor
+ ] ifFalse:[
+ thumbLightColor := lightColor.
+ ].
+
+ thumbEdgeStyle notNil ifTrue:[
+ DefaultThumbHalfShadowColor notNil ifTrue:[
+ thumbHalfShadowColor := DefaultThumbHalfShadowColor
+ ].
+ DefaultThumbHalfLightColor notNil ifTrue:[
+ thumbHalfLightColor := DefaultThumbHalfLightColor
+ ].
+ ].
+
+ device hasGreyscales ifFalse:[
+ thumbEdgeStyle notNil ifTrue:[
+ thumbHalfShadowColor := Color darkGrey.
+ thumbHalfLightColor := White
+ ].
+
+ thumbShadowColor := Black.
+"/ thumbLightColor := White.
+
+ styleSheet name = #motif ifTrue:[
+ DefaultThumbColor isNil ifTrue:[
+ thumbColor := White .
+ ].
+ ]
+ ].
+
+ DefaultThumbColor notNil ifTrue:[
+ thumbColor := DefaultThumbColor on:device
+ ] ifFalse:[
+ thumbColor := White.
+ styleSheet name ~= #normal ifTrue:[
+ device hasGreyscales ifFalse:[
+ thumbColor := Color grey
+ ].
+ ].
+ ].
+
+ thumbColor := thumbColor on:device.
+ thumbShadowColor notNil ifTrue:[
+ thumbShadowColor := thumbShadowColor on:device.
+ ].
+ thumbLightColor notNil ifTrue:[
+ thumbLightColor := thumbLightColor on:device.
+ ].
+ thumbHalfShadowColor notNil ifTrue:[
+ thumbHalfShadowColor := thumbHalfShadowColor on:device.
+ ].
+ thumbHalfLightColor notNil ifTrue:[
+ thumbHalfLightColor := thumbHalfLightColor on:device.
+ ].
+ thumbEdgeStyle notNil ifTrue:[
+ thumbHalfShadowColor isNil ifTrue:[
+ thumbHalfShadowColor := thumbShadowColor lightened on:device
+ ]
+ ].
+
+ styleSheet name = #next ifTrue:[
+ shadowForm := self class handleShadowFormOn:device.
+ lightForm := self class handleLightFormOn:device
+ ] ifFalse:[
+ shadowForm := lightForm := nil
+ ].
+
+ drawableId notNil ifTrue:[
+ self computeThumbFrame
+ ]
+!
+
+rue:[
+ thumbShadowColor := DefaultThumbShadowColor
+ ] ifFalse:[
+ thumbShadowColor := shadowColor.
+ ].
+ DefaultThumbLightColor notNil ifTrue:[
+ thumbLightColor := DefaultThumbLightColor
+ ] ifFalse:[
+ thumbLightColor := lightColor.
+ ].
+
+ thumbEdgeStyle notNil ifTrue:[
+ DefaultThumbHalfShadowColor notNil ifTrue:[
+ thumbHalfShadowColor := DefaultThumbHalfShadowColor
+ ].
+ DefaultThumbHalfLightColor notNil ifTrue:[
+ thumbHalfLightColor := DefaultThumbHalfLightColor
+ ].
+ ].
+
+ device hasGreyscales ifFalse:[
+ thumbEdgeStyle notNil ifTrue:[
+ thumbHalfShadowColor := Color darkGrey.
+ thumbHalfLightColor := White
+ ].
+
+ thumbShadowColor := Black.
+"/ thumbLightColor := White.
+
+ styleSheet name = #motif ifTrue:[
+ DefaultThumbColor isNil ifTrue:[
+ thumbColor := White .
+ ].
+ ]
+ ].
+
+ DefaultThumbColor notNil ifTrue:[
+ thumbColor := DefaultThumbColor on:device
+ ] ifFalse:[
+ thumbColor := White.
+ styleSheet name ~= #normal ifTrue:[
+ device hasGreyscales ifFalse:[
+ thumbColor := Color grey
+ ].
+ ].
+ ].
+
+ thumbColor := thumbColor on:device.
+ thumbShadowColor notNil ifTrue:[
+ thumbShadowColor := thumbShadowColor on:device.
+ ].
+ thumbLightColor notNil ifTrue:[
+ thumbLightColor := thumbLightColor on:device.
+ ].
+ thumbHalfShadowColor notNil ifTrue:[
+ thumbHalfShadowColor := thumbHalfShadowColor on:device.
+ ].
+ thumbHalfLightColor notNil ifTrue:[
+ thumbHalfLightColor := thumbHalfLightColor on:device.
+ ].
+ thumbEdgeStyle notNil ifTrue:[
+ thumbHalfShadowColor isNil ifTrue:[
+ thumbHalfShadowColor := thumbShadowColor lightened on:device
+ ]
+ ].
+
+ styleSheet name = #next ifTrue:[
+ shadowForm := self class handleShadowFormOn:device.
+ lightForm := self class handleLightFormOn:device
+ ] ifFalse:[
+ shadowForm := lightForm := nil
+ ].
+
+ drawableId notNil ifTrue:[
+ self computeThumbFrame
+ ]
+!
+
+:[
+ DefaultThumbHalfShadowColor notNil ifTrue:[
+ thumbHalfShadowColor := DefaultThumbHalfShadowColor
+ ].
+ DefaultThumbHalfLightColor notNil ifTrue:[
+ thumbHalfLightColor := DefaultThumbHalfLightColor
+ ].
+ ].
+
+ device hasGreyscales ifFalse:[
+ thumbEdgeStyle notNil ifTrue:[
+ thumbHalfShadowColor := Color darkGrey.
+ thumbHalfLightColor := White
+ ].
+
+ thumbShadowColor := Black.
+"/ thumbLightColor := White.
+
+ styleSheet name = #motif ifTrue:[
+ DefaultThumbColor isNil ifTrue:[
+ thumbColor := White .
+ ].
+ ]
+ ].
+
+ DefaultThumbColor notNil ifTrue:[
+ thumbColor := DefaultThumbColor on:device
+ ] ifFalse:[
+ thumbColor := White.
+ styleSheet name ~= #normal ifTrue:[
+ device hasGreyscales ifFalse:[
+ thumbColor := Color grey
+ ].
+ ].
+ ].
+
+ thumbColor := thumbColor on:device.
+ thumbShadowColor notNil ifTrue:[
+ thumbShadowColor := thumbShadowColor on:device.
+ ].
+ thumbLightColor notNil ifTrue:[
+ thumbLightColor := thumbLightColor on:device.
+ ].
+ thumbHalfShadowColor notNil ifTrue:[
+ thumbHalfShadowColor := thumbHalfShadowColor on:device.
+ ].
+ thumbHalfLightColor notNil ifTrue:[
+ thumbHalfLightColor := thumbHalfLightColor on:device.
+ ].
+ thumbEdgeStyle notNil ifTrue:[
+ thumbHalfShadowColor isNil ifTrue:[
+ thumbHalfShadowColor := thumbShadowColor lightened on:device
+ ]
+ ].
+
+ styleSheet name = #next ifTrue:[
+ shadowForm := self class handleShadowFormOn:device.
+ lightForm := self class handleLightFormOn:device
+ ] ifFalse:[
+ shadowForm := lightForm := nil
+ ].
+
+ drawableId notNil ifTrue:[
+ self computeThumbFrame
+ ]
+!
+
+thumbEdgeStyle notNil ifTrue:[
+ thumbHalfShadowColor := Color darkGrey.
+ thumbHalfLightColor := White
+ ].
+
+ thumbShadowColor := Black.
+"/ thumbLightColor := White.
+
+ styleSheet name = #motif ifTrue:[
+ DefaultThumbColor isNil ifTrue:[
+ thumbColor := White .
+ ].
+ ]
+ ].
+
+ DefaultThumbColor notNil ifTrue:[
+ thumbColor := DefaultThumbColor on:device
+ ] ifFalse:[
+ thumbColor := White.
+ styleSheet name ~= #normal ifTrue:[
+ device hasGreyscales ifFalse:[
+ thumbColor := Color grey
+ ].
+ ].
+ ].
+
+ thumbColor := thumbColor on:device.
+ thumbShadowColor notNil ifTrue:[
+ thumbShadowColor := thumbShadowColor on:device.
+ ].
+ thumbLightColor notNil ifTrue:[
+ thumbLightColor := thumbLightColor on:device.
+ ].
+ thumbHalfShadowColor notNil ifTrue:[
+ thumbHalfShadowColor := thumbHalfShadowColor on:device.
+ ].
+ thumbHalfLightColor notNil ifTrue:[
+ thumbHalfLightColor := thumbHalfLightColor on:device.
+ ].
+ thumbEdgeStyle notNil ifTrue:[
+ thumbHalfShadowColor isNil ifTrue:[
+ thumbHalfShadowColor := thumbShadowColor lightened on:device
+ ]
+ ].
+
+ styleSheet name = #next ifTrue:[
+ shadowForm := self class handleShadowFormOn:device.
+ lightForm := self class handleLightFormOn:device
+ ] ifFalse:[
+ shadowForm := lightForm := nil
+ ].
+
+ drawableId notNil ifTrue:[
+ self computeThumbFrame
+ ]
+! !
+
+!Scroller methodsFor:'forced scroll'!
+
+il ifTrue:[
+ thumbColor := DefaultThumbColor on:device
+ ] ifFalse:[
+ thumbColor := White.
+ styleSheet name ~= #normal ifTrue:[
+ device hasGreyscales ifFalse:[
+ thumbColor := Color grey
+ ].
+ ].
+ ].
+
+ thumbColor := thumbColor on:device.
+ thumbShadowColor notNil ifTrue:[
+ thumbShadowColor := thumbShadowColor on:device.
+ ].
+ thumbLightColor notNil ifTrue:[
+ thumbLightColor := thumbLightColor on:device.
+ ].
+ thumbHalfShadowColor notNil ifTrue:[
+ thumbHalfShadowColor := thumbHalfShadowColor on:device.
+ ].
+ thumbHalfLightColor notNil ifTrue:[
+ thumbHalfLightColor := thumbHalfLightColor on:device.
+ ].
+ thumbEdgeStyle notNil ifTrue:[
+ thumbHalfShadowColor isNil ifTrue:[
+ thumbHalfShadowColor := thumbShadowColor lightened on:device
+ ]
+ ].
+
+ styleSheet name = #next ifTrue:[
+ shadowForm := self class handleShadowFormOn:device.
+ lightForm := self class handleLightFormOn:device
+ ] ifFalse:[
+ shadowForm := lightForm := nil
+ ].
+
+ drawableId notNil ifTrue:[
+ self computeThumbFrame
+ ]
+!
+
+name ~= #normal ifTrue:[
+ device hasGreyscales ifFalse:[
+ thumbColor := Color grey
+ ].
+ ].
+ ].
+
+ thumbColor := thumbColor on:device.
+ thumbShadowColor notNil ifTrue:[
+ thumbShadowColor := thumbShadowColor on:device.
+ ].
+ thumbLightColor notNil ifTrue:[
+ thumbLightColor := thumbLightColor on:device.
+ ].
+ thumbHalfShadowColor notNil ifTrue:[
+ thumbHalfShadowColor := thumbHalfShadowColor on:device.
+ ].
+ thumbHalfLightColor notNil ifTrue:[
+ thumbHalfLightColor := thumbHalfLightColor on:device.
+ ].
+ thumbEdgeStyle notNil ifTrue:[
+ thumbHalfShadowColor isNil ifTrue:[
+ thumbHalfShadowColor := thumbShadowColor lightened on:device
+ ]
+ ].
+
+ styleSheet name = #next ifTrue:[
+ shadowForm := self class handleShadowFormOn:device.
+ lightForm := self class handleLightFormOn:device
+ ] ifFalse:[
+ shadowForm := lightForm := nil
+ ].
+
+ drawableId notNil ifTrue:[
+ self computeThumbFrame
+ ]
+! !
+
+!Scroller methodsFor:'forwarding changed origin'!
+
+humbShadowColor notNil ifTrue:[
+ thumbShadowColor := thumbShadowColor on:device.
+ ].
+ thumbLightColor notNil ifTrue:[
+ thumbLightColor := thumbLightColor on:device.
+ ].
+ thumbHalfShadowColor notNil ifTrue:[
+ thumbHalfShadowColor := thumbHalfShadowColor on:device.
+ ].
+ thumbHalfLightColor notNil ifTrue:[
+ thumbHalfLightColor := thumbHalfLightColor on:device.
+ ].
+ thumbEdgeStyle notNil ifTrue:[
+ thumbHalfShadowColor isNil ifTrue:[
+ thumbHalfShadowColor := thumbShadowColor lightened on:device
+ ]
+ ].
+
+ styleSheet name = #next ifTrue:[
+ shadowForm := self class handleShadowFormOn:device.
+ lightForm := self class handleLightFormOn:device
+ ] ifFalse:[
+ shadowForm := lightForm := nil
+ ].
+
+ drawableId notNil ifTrue:[
+ self computeThumbFrame
+ ]
+! !
+
+!Scroller methodsFor:'initialization'!
+
+defaultExtent
+ "compute my extent from sub-components"
+
+ ^ self preferredExtent
+
+ "Created: 1.3.1996 / 19:22:21 / cg"
+!
+
+eStyle notNil ifTrue:[
+ thumbHalfShadowColor isNil ifTrue:[
+ thumbHalfShadowColor := thumbShadowColor lightened on:device
+ ]
+ ].
+
+ styleSheet name = #next ifTrue:[
+ shadowForm := self class handleShadowFormOn:device.
+ lightForm := self class handleLightFormOn:device
+ ] ifFalse:[
+ shadowForm := lightForm := nil
+ ].
+
+ drawableId notNil ifTrue:[
+ self computeThumbFrame
+ ]
+!
+
+alfShadowColor := thumbShadowColor lightened on:device
+ ]
+ ].
+
+ styleSheet name = #next ifTrue:[
+ shadowForm := self class handleShadowFormOn:device.
+ lightForm := self class handleLightFormOn:device
+ ] ifFalse:[
+ shadowForm := lightForm := nil
+ ].
+
+ drawableId notNil ifTrue:[
+ self computeThumbFrame
+ ]
+!
+
+initialize
+ "initialize - setup instvars from defaults"
+
+ super initialize.
+ orientation := #vertical.
+
+ scrolling := false.
+ synchronousOperation := true.
+
+ thumbOrigin := 0.
+ thumbHeight := 100.
+ thumbFrameSizeDifference := 0.
+
+ rangeStart := 0.
+ rangeEnd := 100.
+ rangeStep := nil. "/ meaning: arbitrary precision
+"/ inset := 1.
+
+"/ self computeThumbFrame
+
+ "Modified: 1.3.1996 / 19:22:51 / cg"
+!
+
+ame left) ifTrue:[
+ (nh == thumbFrame height) ifTrue:[
+ (nw == thumbFrame width) ifTrue:[ ^ self]
+ ]
+ ]
+ ]
+ ].
+ thumbFrame := Rectangle left:nx top:ny width:nw height:nh
+! !
+
+!Scroller methodsFor:'private'!
+
+thumbFrame := Rectangle left:nx top:ny width:nw height:nh
+!
+
+ases, this happens ...
+ val := 0
+ ] ifFalse:[
+ val := absValue / t * (rangeEnd - rangeStart).
+ ].
+ val := val + rangeStart.
+
+ val < rangeStart ifTrue:[^ rangeStart].
+ val > rangeEnd ifTrue:[^ rangeEnd].
+ ^ val
+
+!
+
+(orientation == #vertical) ifTrue:[aView innerHeight]
+ ifFalse:[aView innerWidth].
+ percent := viewsSize * 100.0 / total
+ ].
+ self thumbHeight:percent
+! !
+
+!Scroller methodsFor:'private-scrollView interface'!
+
+^ thumbFrame
+!
+
+wOrigin realNewOrigin
oldFrame oldTop oldBot oldLeft oldRight
thumbTop thumbBot thumbLeft thumbRight
tH "{ Class: SmallInteger }"
@@ -611,957 +2085,126 @@
]
!
-thumbOrigin:originNumber thumbHeight:heightNumber
- "set both thumbs height and origin (in percent by default)"
-
- |newHeight newOrigin realNewOrigin realNewHeight old new changed nBg|
-
- newOrigin := originNumber - rangeStart / (rangeEnd - rangeStart / 100).
- newHeight := heightNumber / (rangeEnd - rangeStart / 100).
-
- (newHeight > 100) ifTrue:[
- realNewHeight := 100
- ] ifFalse:[
- realNewHeight := newHeight
- ].
- ((newOrigin + realNewHeight) > 100) ifTrue:[
- realNewOrigin := 100 - realNewHeight
- ] ifFalse: [
- realNewOrigin := newOrigin
- ].
- (realNewOrigin < 0) ifTrue: [
- realNewOrigin := 0
- ].
-
- changed := (realNewHeight ~= thumbHeight) or:[realNewOrigin ~= thumbOrigin].
- (changed or:[thumbFrame isNil]) ifTrue:[
- old := self absFromPercent:thumbOrigin.
- new := self absFromPercent:realNewOrigin.
- changed := old ~~ new.
- changed ifFalse:[
- old := self absFromPercent:thumbHeight.
- new := self absFromPercent:realNewHeight.
- changed := (old ~~ new)
- ].
- (changed or:[thumbFrame isNil]) ifTrue:[
- thumbOrigin := realNewOrigin.
- thumbHeight := realNewHeight.
-
- (DefaultFullViewBackground notNil
- and:[DefaultViewBackground notNil
- and:[DefaultFullViewBackground ~~ DefaultViewBackground]]) ifTrue:[
- realNewHeight >= 100 ifTrue:[
- nBg := DefaultFullViewBackground.
- ] ifFalse:[
- nBg := DefaultViewBackground
- ].
- nBg := nBg on:device.
- nBg ~~ viewBackground ifTrue:[
- self viewBackground:nBg.
- shown ifTrue:[self clear].
- ]
+e:[
+ oldFrame := thumbFrame.
+ self computeThumbFrame.
+ (thumbHeight = 100) ifTrue:[
+ "/ full: don't draw
+ ^ self
].
- shown ifTrue:[
- thumbFrame notNil ifTrue:[
- self drawThumbBackgroundInX:(thumbFrame left)
- y:(thumbFrame top)
- width:(thumbFrame width)
- height:(thumbFrame height).
+ (thumbFrame ~~ oldFrame) ifTrue:[
+ oldFrame isNil ifTrue:[
+ self drawThumb.
+ ^ self
].
- self computeThumbFrame.
- self drawThumb
- ] ifFalse:[
- thumbFrame := nil
- ]
- ]
- ]
-! !
-
-!Scroller methodsFor:'accessing-behavior'!
-
-action:aBlock
- "for protocol compatibility; same as scrollAction:"
-
- self scrollAction:aBlock
-!
-
-asynchronousOperation
- "set scroll-mode to be asynchronous - scroll action is performed after
- scrolling, when mouse-button is finally released"
-
- synchronousOperation := false
-!
+ tH := thumbFrame height.
+ tW := thumbFrame width.
-scrollAction
- "answer the scroll action block"
-
- ^ scrollAction
-!
-
-scrollAction:aBlock
- "set the scroll action, aBlock which is evaluated when scrolled"
-
- scrollAction := aBlock
-!
+ oldTop := oldFrame top.
+ oldBot := oldTop + tH.
+ oldLeft := oldFrame left.
+ oldRight := oldLeft + tW.
-scrollDownAction:aBlock
- "ignored -
- but implemented, so that scroller can be used in place of a scrollbar"
-!
+ thumbTop := thumbFrame top.
+ thumbBot := thumbTop + tH.
+ thumbLeft := thumbFrame left.
+ thumbRight := thumbLeft + tW.
-scrollUpAction:aBlock
- "ignored -
- but implemented, so that scroller can be used in place of a scrollbar"
-!
-
-synchronousOperation
- "set scroll-mode to be synchronous - scroll action is performed for
- every movement of thumb"
-
- synchronousOperation := true
-! !
-
-!Scroller methodsFor:'accessing-look'!
+ needFullDraw := self exposeEventPending
+ or:[((orientation == #vertical) and:[oldBot >= height])
+ or:[((orientation ~~ #vertical) and:[oldRight >= width])]].
-is3D
- styleSheet name = #mswindows ifTrue:[^ true].
- ^ super is3D
-!
-
-orientation
- "return the scrollers orientation (#vertical or #horizontal)"
-
- ^ orientation
-!
-
-thumbColor
- "return the thumbs color"
-
- ^ thumbColor
-!
-
-thumbColor:aColor
- "change the color of the thumb"
-
- thumbColor := aColor on:device.
- (styleSheet name ~~ #normal) ifTrue:[
- thumbShadowColor := aColor darkened on:device.
- thumbLightColor := aColor lightened on:device.
- thumbHalfShadowColor := thumbShadowColor darkened on:device.
- thumbHalfLightColor := thumbLightColor lightened on:device.
- ].
- shown ifTrue:[
- self redraw
- ]
-! !
-
-!Scroller methodsFor:'drawing'!
+ needFullDraw ifTrue:[
+ "
+ cannot copy since thumb was below the end
+ or may be not available for the copy
+ "
+ (orientation == #vertical) ifTrue:[
+ self drawThumbBackgroundInX:thumbLeft y:oldTop
+ width:tW height:(height - oldTop).
+ ] ifFalse:[
+ self drawThumbBackgroundInX:oldLeft y:thumbTop
+ width:(width - oldLeft) height:tH.
+ ].
+ self drawThumb.
+ ^ self
+ ].
-drawHandleFormAtX:x y:y
- thumbShadowColor := thumbShadowColor on:device.
- thumbLightColor := thumbLightColor on:device.
-
- self paint:thumbShadowColor.
- self displayForm:shadowForm x:x y:y.
- self paint:thumbLightColor.
- self displayForm:lightForm x:x y:y.
-!
-
-drawThumb
- "draw the thumb"
-
- |handleX handleY l t
- w "{ Class: SmallInteger }"
- h "{ Class: SmallInteger }"
- x "{ Class: SmallInteger }"
- y "{ Class: SmallInteger }"
- mm xL xR yT yB color1 color2|
-
- (thumbHeight >= 100) ifTrue:[^ self].
- orientation == #vertical ifTrue:[
- thumbFrame height >= height ifTrue:[^ self].
- ] ifFalse:[
- thumbFrame width >= width ifTrue:[^ self].
- ].
-
- l := thumbFrame left.
- t := thumbFrame top.
- w := thumbFrame width.
- h := thumbFrame height.
- self paint:thumbColor.
- self fillRectangleX:l y:t width:w-1 height:h.
+ self catchExpose.
+ "
+ copy the thumbs pixels
+ "
+ (orientation == #vertical) ifTrue:[
+ self copyFrom:self x:thumbLeft y:oldTop
+ toX:thumbLeft y:thumbTop
+ width:tW height:tH.
+ ] ifFalse:[
+ self copyFrom:self x:oldLeft y:thumbTop
+ toX:thumbLeft y:thumbTop
+ width:tW height:tH.
+ ].
- thumbLevel == 0 ifTrue:[
- thumbFrameColor notNil ifTrue:[
- self paint:thumbFrameColor.
- self displayRectangle:thumbFrame.
- ].
- ^ self
- ].
-
- "what a kludge - must be a parameter to drawEdge..."
- self drawEdgesForX:l y:t width:w height:h level:thumbLevel
- shadow:thumbShadowColor light:thumbLightColor
- halfShadow:thumbHalfShadowColor halfLight:thumbHalfLightColor
- style:thumbEdgeStyle.
-
- thumbFrameColor notNil ifTrue:[
- self paint:thumbFrameColor.
- orientation == #vertical ifTrue:[
- self displayRectangleX:l y:t width:w"-1" height:h.
+ "
+ clear some of the previous thumbs area to background
+ "
+ (orientation == #vertical) ifTrue:[
+ bgLeft := thumbLeft.
+ bgWidth := tW.
+ oldTop > thumbTop ifTrue:[
+ delta := oldTop - thumbTop.
+ oldTop > thumbBot ifTrue:[
+ bgTop := oldTop.
+ bgHeight := tH + 1
+ ] ifFalse:[
+ bgTop := thumbBot.
+ bgHeight := delta
+ ]
+ ] ifFalse:[
+ delta := thumbTop - oldTop.
+ oldBot < thumbTop ifTrue:[
+ bgTop := oldTop.
+ bgHeight := tH + 1
+ ] ifFalse:[
+ bgTop := oldTop.
+ bgHeight := delta
+ ]
+ ].
+ ] ifFalse:[
+ bgTop := thumbTop.
+ bgHeight := tH.
+ oldLeft > thumbLeft ifTrue:[
+ delta := oldLeft - thumbLeft.
+ oldLeft > thumbRight ifTrue:[
+ bgLeft := oldLeft.
+ bgWidth := tW + 1.
+ ] ifFalse:[
+ bgLeft := thumbRight.
+ bgWidth := delta.
+ ]
+ ] ifFalse:[
+ delta := thumbLeft - oldLeft.
+ oldRight < thumbLeft ifTrue:[
+ bgLeft := oldLeft.
+ bgWidth := tW + 1.
+ ] ifFalse:[
+ bgLeft := oldLeft.
+ bgWidth := delta.
+ ]
+ ].
+ ].
+ self drawThumbBackgroundInX:bgLeft y:bgTop width:bgWidth height:bgHeight.
+ self waitForExpose
+ ]
] ifFalse:[
- self displayRectangleX:l y:t width:w height:h"-1".
- ]
- ].
-
- (tallyLevel == 0 or:[tallyMarks == 0]) ifTrue:[
- shadowForm notNil ifTrue:[
- handleX := l + ((w - 8) // 2).
- handleY := t + ((h - 8) // 2).
- self drawHandleFormAtX:handleX y:handleY
- ].
- ^ self
- ].
-
- "iris style - draw tallys"
-
- tallyLevel > 0 ifTrue:[
- color1 := thumbLightColor.
- color2 := thumbShadowColor.
- ] ifFalse:[
- color1 := thumbShadowColor.
- color2 := thumbLightColor.
- ].
-
- "draw tally marks"
-
- (orientation == #vertical) ifTrue:[
- self paint:color1.
- y := t + (h // 2) - 1.
- xL := l + thumbLevel - 1.
- xR := l + w - thumbLevel "+ 1".
- self displayLineFromX:xL y:y toX:xR y:y.
- y := y + 1.
- self paint:color2.
- self displayLineFromX:xL y:y toX:xR y:y.
-
- tallyMarks > 1 ifTrue:[
- "dont draw other marks if there is not enough space"
-
- mm := device verticalPixelPerMillimeter rounded.
- h > (mm * (tallyMarks * 2)) ifTrue:[
- y := y - 1 - mm.
- self paint:color1.
- self displayLineFromX:xL y:y toX:xR y:y.
- y := y + 1.
- self paint:color2.
- self displayLineFromX:xL y:y toX:xR y:y.
-
- y := y - 1 + mm + mm.
- self paint:color1.
- self displayLineFromX:xL y:y toX:xR y:y.
- y := y + 1.
- self paint:color2.
- self displayLineFromX:xL y:y toX:xR y:y
- ]
- ]
- ] ifFalse:[
- x := l + (w // 2) - 1.
- yT := t + thumbLevel - 1.
- yB := t + h - thumbLevel "+ 1".
- self paint:color1.
- self displayLineFromX:x y:yT toX:x y:yB.
- self paint:color2.
- x := x + 1.
- self displayLineFromX:x y:yT toX:x y:yB.
-
- tallyMarks > 1 ifTrue:[
- "dont draw other marks if there is not enough space"
-
- mm := device horizontalPixelPerMillimeter rounded.
- w > (mm * (tallyMarks * 2)) ifTrue:[
- x := x - 1 - mm.
- self paint:color1.
- self displayLineFromX:x y:yT toX:x y:yB.
- x := x + 1.
- self paint:color2.
- self displayLineFromX:x y:yT toX:x y:yB.
-
- x := x - 1 + mm + mm.
- self paint:color1.
- self displayLineFromX:x y:yT toX:x y:yB.
- x := x + 1.
- self paint:color2.
- self displayLineFromX:x y:yT toX:x y:yB
- ]
- ]
- ]
-!
-
-drawThumbBackgroundInX:x y:y width:w height:h
- "draw part of the thumbs background; defined as a separate
- method, to allow drawing of arbitrary patterns under thumb
- (see ColorSlider)."
-
- shown ifTrue:[
- self clearRectangleX:x y:y width:w height:h.
- frameBeforeMove notNil ifTrue:[
- self clippedTo:(Rectangle left:x top:y width:w height:h) do:[
- |gX gY gW gH|
-
- gX := frameBeforeMove left.
- gY := frameBeforeMove top.
- gW := frameBeforeMove width.
- gH := frameBeforeMove height.
-
- ghostColor notNil ifTrue:[
- self fillRectangle:frameBeforeMove with:ghostColor.
- ].
- (ghostLevel ~~ 0) ifTrue:[
- self drawEdgesForX:gX y:gY width:gW height:gH level:ghostLevel
- ].
- ghostFrameColor notNil ifTrue:[
- self paint:ghostFrameColor.
- self displayRectangleX:gX y:gY width:gW height:gH
- ]
- ]
+ thumbFrame := nil
]
]
! !
-!Scroller methodsFor:'event handling'!
-
-buttonMotion:state x:x y:y
- "mouse-button was moved while pressed;
- redraw thumb at its new position and, if scroll-mode is asynchronous,
- the scroll action is performed"
-
- |pos curr limit prevOrigin newOrigin|
-
- scrolling ifFalse: [^ self]. "should not happen"
-
- frameBeforeMove isNil ifTrue:[
- (ghostColor notNil
- or:[ghostFrameColor notNil
- or:[ghostLevel ~~ 0]]) ifTrue:[
- frameBeforeMove := thumbFrame insetBy:1@1
- ]
- ].
-
- (orientation == #vertical) ifTrue:[
- curr := y.
- limit := height
- ] ifFalse:[
- curr := x.
- limit := width
- ].
-
- (curr < 0) ifTrue:[ "check against limits"
- pos := 0
- ] ifFalse:[
- (curr > limit) ifTrue:[
- pos := limit
- ] ifFalse:[
- pos := curr
- ]
- ].
-
- prevOrigin := self thumbOrigin.
- newOrigin := self percentFromAbs:(pos - pressOffset).
- prevOrigin ~= newOrigin ifTrue:[
- self thumbOrigin:newOrigin.
-
- synchronousOperation ifTrue: [
- self tellOthers.
- ]
- ]
-!
-
-buttonMultiPress:button x:x y:y
- ^ self buttonPress:button x:x y:y
-!
-
-buttonPress:button x:x y:y
- "button was pressed - if above thumb, page up; if below thumb, page down;
- otherwise start scrolling"
-
- |curr limit1 limit2|
-
- shown ifFalse:[^ self].
-
- (orientation == #vertical) ifTrue:[
- curr := y.
- limit1 := thumbFrame top.
- limit2 := thumbFrame bottom
- ] ifFalse:[
- curr := x.
- limit1 := thumbFrame left.
- limit2 := thumbFrame right
- ].
-
- (curr < limit1) ifTrue:[
- "page up/left"
- self pageUp
- ] ifFalse:[
- (curr > limit2) ifTrue:[
- "page down/right"
- self pageDown
- ] ifFalse:[
- pressOffset := curr - limit1.
- scrolling := true
- ]
- ]
-!
-
-buttonRelease:button x:x y:y
- "mouse-button was released - if scroll-mode is asynchronous, the scroll
- action is now performed"
-
- |rect|
-
- scrolling ifTrue:[
- thumbFrame notNil ifTrue:[
- frameBeforeMove notNil ifTrue:[
- rect := frameBeforeMove.
- frameBeforeMove := nil.
- self drawThumbBackgroundInX:rect left
- y:rect top
- width:rect width
- height:rect height.
- (rect intersects:thumbFrame) ifTrue:[
- self drawThumb
- ]
- ].
-
- scrolling := false.
- synchronousOperation ifFalse: [
- self tellOthers.
- ]
- ]
- ]
-
- "Modified: 23.12.1995 / 12:42:25 / cg"
-!
-
-buttonShiftPress:button x:x y:y
- "mouse-click with shift - jump to position"
-
- |pos curr curr2 limit1 limit2|
-
- (orientation == #vertical) ifTrue:[
- curr := y.
- curr2 := y - (thumbFrame height // 2).
- limit1 := height.
- limit2 := thumbFrame top
- ] ifFalse:[
- curr := x.
- curr2 := x - (thumbFrame width // 2).
- limit1 := width.
- limit2 := thumbFrame left
- ].
-
- (curr2 < 0) ifTrue:[ "check against limits"
- pos := 0
- ] ifFalse:[
- (curr2 > limit1) ifTrue:[
- pos := limit1
- ] ifFalse:[
- pos := curr2
- ]
- ].
-
- frameBeforeMove := thumbFrame insetBy:1@1.
-
- self thumbOrigin:(self percentFromAbs:pos).
- self tellOthers.
-
- (orientation == #vertical) ifTrue:[
- limit2 := thumbFrame top
- ] ifFalse:[
- limit2 := thumbFrame left
- ].
- pressOffset := curr - limit2.
- scrolling := true
-!
-
-redraw
- "redraw"
-
- self redrawX:0 y:0 width:width height:height.
- self redrawEdges
-!
-
-redrawX:x y:y width:w height:h
- shown ifTrue:[
- thumbFrame isNil ifTrue:[self computeThumbFrame].
- self drawThumbBackgroundInX:x y:y width:w height:h.
- (y > thumbFrame bottom) ifTrue:[
- ^ self
- ].
- ((y + h) < thumbFrame top) ifTrue:[
- ^ self
- ].
- self drawThumb
- ]
-!
-
-sizeChanged:how
- "size of scroller changed - recompute thumbs frame and redraw it"
-
- |sensor|
-
- shown ifTrue:[
- self computeThumbFrame.
- (sensor := self sensor) notNil ifTrue:[
- self redraw.
- sensor flushExposeEventsFor:self
- ]
- ]
-!
-
-update:something with:aParameter from:changedObject
- "handle update from a model (if any)"
-
- (changedObject == model
- "and:[something == aspectMsg]") ifTrue:[
- self thumbOrigin:(model value).
- ^ self
- ].
- super update:something with:aParameter from:changedObject
-! !
-
-!Scroller methodsFor:'forced scroll'!
-
-pageDown
- "page down/right"
-
- self thumbOrigin:(thumbOrigin + thumbHeight).
- self tellOthers
-!
-
-pageUp
- "page up/left"
-
- self thumbOrigin:(thumbOrigin - thumbHeight).
- self tellOthers
-! !
-
-!Scroller methodsFor:'forwarding changed origin'!
-
-tellOthers
- |org|
-
- org := self thumbOrigin.
- "
- the ST/X way of notifying scrolls
- "
- scrollAction notNil ifTrue:[
- scrollAction value:org
- ].
- "
- the ST-80 way of notifying scrolls
- "
- self sendChangeMessageWith:org.
- self changed:#scrollerPosition.
-! !
-
-!Scroller methodsFor:'initialization'!
-
-computeInitialExtent
- self extent:self preferredExtent
-!
-
-initCursor
- "set the cursor - a hand"
-
- cursor := Cursor hand
-!
-
-initStyle
- "initialize style dep. stuff"
-
- super initStyle.
-
- DefaultViewBackground notNil ifTrue:[
- viewBackground := DefaultViewBackground on:device.
- ].
- DefaultShadowColor notNil ifTrue:[
- shadowColor := DefaultShadowColor on:device.
- ].
- DefaultLightColor notNil ifTrue:[
- lightColor := DefaultLightColor on:device.
- ].
-
- tallyMarks := DefaultTallyMarks.
- tallyLevel := DefaultTallyLevel.
- DefaultLevel ~~ level ifTrue:[
- self level:DefaultLevel.
- ].
- DefaultBorderWidth ~~ borderWidth ifTrue:[
- self borderWidth:DefaultBorderWidth.
- ].
- thumbLevel := DefaultThumbLevel.
- inset := DefaultInset.
- fixThumbHeight := DefaultFixThumbHeight.
- thumbEdgeStyle := DefaultEdgeStyle.
-
- DefaultGhostColor notNil ifTrue:[
- ghostColor := DefaultGhostColor on:device.
- ].
- DefaultGhostFrameColor notNil ifTrue:[
- ghostFrameColor := DefaultGhostFrameColor on:device.
- ].
- ghostLevel := DefaultGhostLevel.
-
- DefaultThumbFrameColor notNil ifTrue:[
- thumbFrameColor := DefaultThumbFrameColor on:device.
- ].
- DefaultThumbShadowColor notNil ifTrue:[
- thumbShadowColor := DefaultThumbShadowColor
- ] ifFalse:[
- thumbShadowColor := shadowColor.
- ].
- DefaultThumbLightColor notNil ifTrue:[
- thumbLightColor := DefaultThumbLightColor
- ] ifFalse:[
- thumbLightColor := lightColor.
- ].
-
- thumbEdgeStyle notNil ifTrue:[
- DefaultThumbHalfShadowColor notNil ifTrue:[
- thumbHalfShadowColor := DefaultThumbHalfShadowColor
- ].
- DefaultThumbHalfLightColor notNil ifTrue:[
- thumbHalfLightColor := DefaultThumbHalfLightColor
- ].
- ].
-
- device hasGreyscales ifFalse:[
- thumbEdgeStyle notNil ifTrue:[
- thumbHalfShadowColor := Color darkGrey.
- thumbHalfLightColor := White
- ].
-
- thumbShadowColor := Black.
-"/ thumbLightColor := White.
+!Scroller methodsFor:'queries'!
- styleSheet name = #motif ifTrue:[
- DefaultThumbColor isNil ifTrue:[
- thumbColor := White .
- ].
- ]
- ].
-
- DefaultThumbColor notNil ifTrue:[
- thumbColor := DefaultThumbColor on:device
- ] ifFalse:[
- thumbColor := White.
- styleSheet name ~= #normal ifTrue:[
- device hasGreyscales ifFalse:[
- thumbColor := Color grey
- ].
- ].
- ].
-
- thumbColor := thumbColor on:device.
- thumbShadowColor notNil ifTrue:[
- thumbShadowColor := thumbShadowColor on:device.
- ].
- thumbLightColor notNil ifTrue:[
- thumbLightColor := thumbLightColor on:device.
- ].
- thumbHalfShadowColor notNil ifTrue:[
- thumbHalfShadowColor := thumbHalfShadowColor on:device.
- ].
- thumbHalfLightColor notNil ifTrue:[
- thumbHalfLightColor := thumbHalfLightColor on:device.
- ].
- thumbEdgeStyle notNil ifTrue:[
- thumbHalfShadowColor isNil ifTrue:[
- thumbHalfShadowColor := thumbShadowColor lightened on:device
- ]
- ].
-
- styleSheet name = #next ifTrue:[
- shadowForm := self class handleShadowFormOn:device.
- lightForm := self class handleLightFormOn:device
- ] ifFalse:[
- shadowForm := lightForm := nil
- ].
-
- drawableId notNil ifTrue:[
- self computeThumbFrame
- ]
-!
-
-initialize
- "initialize - setup instvars from defaults"
-
- super initialize.
- self computeInitialExtent.
- orientation := #vertical.
-
- scrolling := false.
- synchronousOperation := true.
-
- thumbOrigin := 0.
- thumbHeight := 100.
- thumbFrameSizeDifference := 0.
-
- rangeStart := 0.
- rangeEnd := 100.
- rangeStep := nil. "/ meaning: arbitrary precision
-"/ inset := 1.
-
-"/ self computeThumbFrame
-!
-
-realize
- super realize.
- model notNil ifTrue:[
- self thumbOrigin:(model value).
- ].
-! !
-
-!Scroller methodsFor:'private'!
-
-absFromPercent:percent
- "given a percentage, compute number of pixels"
-
- |fullSize|
-
- (orientation == #vertical) ifTrue:[
- fullSize := height
- ] ifFalse:[
- fullSize := width
- ].
-"/ ^ ((percent * (fullSize - (margin * 2))) / 100) rounded
-"/ 20-apr-94
-
- ^ ((percent * (fullSize - thumbFrameSizeDifference- (margin * 2))) / 100) rounded
-!
-
-computeThumbFrame
- "compute the thumbs frame (a rectangle) whenever thumb is moved,
- changed height or the scrollers size has changed.
- We take care, that the thumb will not become too small (i.e.
- invisible or uncatchable).
- Also, for mswindows style, its height/width is constant."
-
- |newPos1 newPos2 newSize1 newSize2 nh nw ny nx
- computedSize minSz sz1 sz2|
-
- "compute position & size"
- newPos1 := (self absFromPercent:thumbOrigin) + margin.
- newSize1 := computedSize := self absFromPercent:thumbHeight.
- (orientation == #vertical) ifTrue:[
- sz1 := height.
- sz2 := width
- ] ifFalse:[
- sz1 := width.
- sz2 := height
- ].
-
- "
- do we have to adjust the computed size ?
- "
- newPos2 := margin + inset.
- newSize2 := sz2 - (2 * newPos2).
-"/ (style ~~ #normal) ifTrue:[
- thumbLevel ~~ 0 ifTrue:[
- "
- do not make thumb too small (for handle & to be catchable)
- "
- minSz := 10 + (2 * thumbLevel)
- ] ifFalse:[
- "
- do not make thumb too small (uncatchable)
- "
- minSz := 4
- ].
-
- (newSize1 < minSz) ifTrue:[
- newSize1 := minSz.
- thumbFrameSizeDifference := newSize1 - computedSize
- ] ifFalse:[
- thumbFrameSizeDifference := 0.
- ].
-
- fixThumbHeight ifTrue:[
- "have a fix-size thumb (i.e. mswindows style)"
-
- newSize1 := sz2 - (2 * inset). "make it square"
- thumbFrameSizeDifference := newSize1 - computedSize.
- ].
-
- "
- oops - if height does not relect real visibible area, we have to adjust the origin
- "
- (thumbFrameSizeDifference == 0) ifFalse:[
- newPos1 := (self absFromPercent:thumbOrigin) + margin.
-"/ newPos1 := ((thumbOrigin * (sz1 - thumbFrameSizeDifference - (margin * 2))) / 100) rounded + margin
- ].
-
- (orientation == #vertical) ifTrue:[
- ny := newPos1.
- nx := newPos2.
- nh := newSize1.
- nw := newSize2.
- ny + nh + margin > height ifTrue:[
- ny := height - margin - nh
- ]
- ] ifFalse:[
- nx := newPos1.
- ny := newPos2.
- nw := newSize1.
- nh := newSize2.
- nx + nw + margin > width ifTrue:[
- nx := width - margin - nw
- ]
- ].
-
- "
- do not create new Rectangle if its the same anyway
- "
- thumbFrame notNil ifTrue:[
- (ny == thumbFrame top) ifTrue:[
- (nx == thumbFrame left) ifTrue:[
- (nh == thumbFrame height) ifTrue:[
- (nw == thumbFrame width) ifTrue:[ ^ self]
- ]
- ]
- ]
- ].
- thumbFrame := Rectangle left:nx top:ny width:nw height:nh
-!
-
-percentFromAbs:absValue
- "given a number of pixels, compute percentage"
-
- |fullSize val t|
-
- (orientation == #vertical) ifTrue:[
- fullSize := height
- ] ifFalse:[
- fullSize := width
- ].
-
- t := fullSize - thumbFrameSizeDifference - (margin * 2).
- t = 0 ifTrue:[
- "/ in rare cases, this happens ...
- val := 0
- ] ifFalse:[
- val := absValue / t * (rangeEnd - rangeStart).
- ].
- val := val + rangeStart.
-
- val < rangeStart ifTrue:[^ rangeStart].
- val > rangeEnd ifTrue:[^ rangeEnd].
- ^ val
-
-! !
-
-!Scroller methodsFor:'private-scrollView interface'!
-
-setThumbFor:aView
- "get contents and size info from aView and adjust thumb"
-
- |percentSize percentOrigin contentsSize contentsPosition viewsSize|
-
- "
- get the content's size
- "
- aView isNil ifTrue:[
- contentsSize := 0
- ] ifFalse:[
- orientation == #vertical ifTrue:[
- contentsSize := aView heightOfContents.
- aView transformation notNil ifTrue:[
- contentsSize := aView transformation applyScaleY:contentsSize.
- ].
- ] ifFalse:[
- contentsSize := aView widthOfContents.
- aView transformation notNil ifTrue:[
- contentsSize := aView transformation applyScaleX:contentsSize.
- ].
- ]
- ].
-
- (contentsSize = 0) ifTrue:[
- percentSize := 100.
- percentOrigin := 100
- ] ifFalse:[
- (orientation == #vertical) ifTrue:[
- viewsSize := aView innerHeight.
- contentsPosition := aView yOriginOfContents.
- ] ifFalse:[
- viewsSize := aView innerWidth.
- contentsPosition := aView xOriginOfContents
- ].
-
- percentSize := viewsSize * 100.0 / contentsSize.
- percentOrigin := contentsPosition * 100.0 / contentsSize.
- percentOrigin + percentSize > 100.0 ifTrue:[
- "actually showing stuff below contents of view"
-"
- contentsSize := contentsPosition + aView innerHeight.
- percentSize := viewsSize * 100.0 / contentsSize.
- percentOrigin := contentsPosition * 100.0 / contentsSize
-"
- ]
- ].
- (percentSize = thumbHeight) ifTrue:[
- self thumbOrigin:percentOrigin
- ] ifFalse:[
- (percentOrigin = thumbOrigin) ifTrue:[
- self thumbHeight:percentSize
- ] ifFalse:[
- self thumbOrigin:percentOrigin thumbHeight:percentSize
- ]
- ]
-!
-
-setThumbHeightFor:aView
- "get contents and size info from aView and adjust thumb height"
-
- |percent total viewsSize|
-
- (orientation == #vertical) ifTrue:[
- total := aView heightOfContents.
- aView transformation notNil ifTrue:[
- total := aView transformation applyScaleY:total.
- ].
- ] ifFalse:[
- total := aView widthOfContents.
- aView transformation notNil ifTrue:[
- total := aView transformation applyScaleX:total.
- ].
- ].
- (total = 0) ifTrue:[
- percent := 100
- ] ifFalse:[
- viewsSize := (orientation == #vertical) ifTrue:[aView innerHeight]
- ifFalse:[aView innerWidth].
- percent := viewsSize * 100.0 / total
- ].
- self thumbHeight:percent
-!
-
-setThumbOriginFor:aView
- "get contents and size info from aView and adjust thumb origin"
-
- |percent total contentsPosition|
-
- (orientation == #vertical) ifTrue:[
- total := aView heightOfContents.
- aView transformation notNil ifTrue:[
- total := aView transformation applyScaleY:total.
- ].
- ] ifFalse:[
- total := aView widthOfContents.
- aView transformation notNil ifTrue:[
- total := aView transformation applyScaleX:total.
+otal := aView transformation applyScaleX:total.
].
].
(total = 0) ifTrue:[
@@ -1574,18 +2217,8 @@
self thumbOrigin:percent
! !
-!Scroller methodsFor:'queries'!
-
-preferredExtent
- |w h|
-
- h := self class defaultExtent y.
- w := (device horizontalPixelPerMillimeter asFloat * 6) rounded.
- ^ w @ h.
-! !
-
!Scroller class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.36 1996-03-01 18:16:46 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.37 1996-03-01 18:48:00 cg Exp $'
! !