"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:18:14 am'!
View subclass:#Scroller
instanceVariableNames:'thumbOrigin thumbHeight thumbColor thumbFrameColor scrollAction
moveDirection thumbFrame thumbLevel scrolling pressOffset
synchronousOperation shadowForm lightForm inset thumbShadowColor
thumbLightColor thumbEdgeStyle thumbHalfShadowColor
thumbHalfLightColor thumbFrameSizeDifference tallyLevel
tallyMarks fixThumbHeight frameBeforeMove ghostColor
ghostFrameColor ghostLevel'
classVariableNames:'HandleShadowForm HandleLightForm DefaultViewBackground
DefaultShadowColor DefaultLightColor DefaultThumbColor
DefaultThumbShadowColor DefaultThumbLightColor
DefaultThumbHalfShadowColor DefaultThumbHalfLightColor
DefaultHalfShadowColor DefaultHalfLightColor DefaultTallyMarks
DefaultTallyLevel DefaultLevel DefaultBorderWidth
DefaultThumbLevel DefaultInset DefaultThumbFrameColor
DefaultGhostColor DefaultGhostFrameColor DefaultGhostLevel
DefaultFixThumbHeight DefaultEdgeStyle'
poolDictionaries:''
category:'Views-Interactors'
!
Scroller comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.17 1995-03-18 05:16:01 claus Exp $
'!
!Scroller class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
version
"
$Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.17 1995-03-18 05:16:01 claus Exp $
"
!
documentation
"
this class implements the scroller for scrollbars.
it can also be used by itself for scrollbars without step-buttons.
When moved, either a predefined action is performed (scrollAction),
or a model is informed via the changeSymbol.
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,
if the scroll operation (redraw) is expensive and takes a long time.
Instance variables:
thumbOrigin <Number> origin of thumb (in percent)
thumbHeight <Number> height of thumb (in percent)
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)
moveDirection <Symbol> #x or #y
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)
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
thumbShadowColor <Color> color do draw dark parts of thumb
thumblightColor <Color> color to draw light parts of thumb
thumbEdgeStyle <SymbolOrNil> #soft or nil
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)
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 ...
tallyMarks <Integer> number of tally marks
fixThumbHeight <Boolean> perform 'wrong' height computation a la mswindows
style settings:
scrollerLevel <Integer> the level of the scroller w.r.t. its enclosing view
scrollerBorderWidth <Integer> the borderWidth (ignored for 3D styles)
scrollerViewBackground <Color> the viewBackground (color or image)
scrollerShadowColor <Color> the color of 3D shadowed edges (ignored in 2D styles)
scrollerLightColor <Color> the color of 3D lighted edges (ignored in 2D styles)
scrollerThumbColor <Color> the thumbs color (color or image)
scrollerThumbShadowColor <Color> the color of the thumbs shadowed edges (ignored in 2D styles)
scrollerThumbLightColor <Color> the color of the thumbs shadowed edges (ignored in 2D styles)
scrollerThumbEdgeStyle <Symbol> the edge style for the thumb (#soft or nil)
scrollerThumbLevel <Integer> the 3D height of the thumb
scrollerThumbHalfShadowColor<Color> the halfShadow for soft edged thumbs
scrollerThumbHalfLightColor <Color> the halfLight for soft edged thumbs
scrollerThumbFrameColor <Color> if non-nil, a rectangle is drawn around the thumb is this color
scrollerThumbInset <Integer> inset of thumb from the scrollers boundary
scrollerThumbFixHeight <Boolean> if true, use a fix thumb height (as in mswindows)
scrollerGhostColor <Color> the color in which a ghost-rectangle is drawn
scrollerGhostFrameColor <Color> if non-nil, a rectangle is drawn around the ghost is this color
scrollerGhostLevel <Color> the 3D level of the ghost rectangle
scrollerNTallyMarks <Integer> number of tally-marks to draw on the thumb
scrollerTallyLevel. <Integer> the 3D level of any tally marks
notice: for mswindows style, we force a WRONG thumb-frame
computation, to make the thumb have constant size;
if you dont like that (I do not :-), set scrollerThumbFixHeight to false (in the StyleSheet).
"
! !
!Scroller class methodsFor:'defaults'!
updateStyleCache
DefaultViewBackground := StyleSheet colorAt:'scrollerViewBackground'.
DefaultThumbColor := StyleSheet colorAt:'scrollerThumbColor'.
DefaultShadowColor := StyleSheet colorAt:'scrollerShadowColor'.
DefaultLightColor := StyleSheet colorAt:'scrollerLightColor'.
DefaultThumbShadowColor := StyleSheet colorAt:'scrollerThumbShadowColor'.
DefaultThumbLightColor := StyleSheet colorAt:'scrollerThumbLightColor'.
DefaultThumbHalfShadowColor := StyleSheet colorAt:'scrollerThumbHalfShadowColor'.
DefaultThumbHalfLightColor := StyleSheet colorAt:'scrollerThumbHalfLightColor'.
DefaultThumbFrameColor := StyleSheet colorAt:'scrollerThumbFrameColor'.
DefaultGhostColor := StyleSheet colorAt:'scrollerGhostColor' default:nil.
DefaultGhostFrameColor := StyleSheet colorAt:'scrollerGhostFrameColor' default:nil.
DefaultGhostLevel := StyleSheet at:'scrollerGhostLevel' default:0.
DefaultTallyMarks := StyleSheet at:'scrollerNTallyMarks' default:0.
DefaultTallyLevel := 0.
DefaultTallyMarks ~~ 0 ifTrue:[
DefaultTallyLevel := StyleSheet at:'scrollerTallyLevel' default:1.
].
DefaultLevel := StyleSheet at:'scrollerLevel' default:0.
DefaultBorderWidth := StyleSheet at:'scrollerBorderWidth' default:(StyleSheet at:'borderWidth').
DefaultThumbLevel := StyleSheet at:'scrollerThumbLevel' default:0.
DefaultInset := StyleSheet at:'scrollerThumbInset' default:0.
DefaultFixThumbHeight := StyleSheet at:'scrollerThumbFixHeight' default:false.
DefaultEdgeStyle := StyleSheet at:'scrollerThumbEdgeStyle'.
!
handleShadowFormOn:aDisplay
"answer the form used for the handles shadow area;
cache the one for Display for the next round"
|f|
((aDisplay == Display) and:[HandleShadowForm notNil]) ifTrue:[
^ HandleShadowForm
].
f := Form fromFile:'HandleShadow.xbm' resolution:100 on:aDisplay.
f isNil ifTrue:[
f := Form width:8 height:8 fromArray:#[2r00111100
2r01100000
2r11000000
2r11000000
2r11000000
2r11000000
2r01000000
2r00000000]
on:aDisplay
].
(aDisplay == Display) ifTrue:[
HandleShadowForm := f
].
^ f
!
handleLightFormOn:aDisplay
"answer the form used for the handles light area;
cache the one for Display for the next round"
|f|
((aDisplay == Display) and:[HandleLightForm notNil]) ifTrue:[
^ HandleLightForm
].
f := Form fromFile:'HandleLight.xbm' resolution:100 on:aDisplay.
f isNil ifTrue:[
f := Form width:8 height:8 fromArray:#[2r00000000
2r00000010
2r00000011
2r00000011
2r00000011
2r00000011
2r00000110
2r00111100]
on:aDisplay
].
(aDisplay == Display) ifTrue:[
HandleLightForm := f
].
^ f
! !
!Scroller methodsFor:'drawing'!
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].
moveDirection == #y 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.
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.
moveDirection == #y 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"
(moveDirection == #y) 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.
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
]
]
]
]
!
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.
! !
!Scroller methodsFor:'accessing'!
thumbOrigin:newOrigin
"set the thumbs origin (in percent)"
|realNewOrigin oldFrame oldTop oldBot thumbTop thumbBot
tH "{ Class: SmallInteger }"
tW delta left|
((newOrigin + thumbHeight) > 100) ifTrue:[
realNewOrigin := 100 - thumbHeight
] ifFalse: [
realNewOrigin := newOrigin
].
(realNewOrigin > 100) ifTrue:[
realNewOrigin := 100
] ifFalse: [
(realNewOrigin < 0) ifTrue:[
realNewOrigin := 0
]
].
((realNewOrigin ~= thumbOrigin) or:[thumbFrame isNil]) ifTrue:[
thumbOrigin := realNewOrigin.
shown ifTrue:[
oldFrame := thumbFrame.
self computeThumbFrame.
(thumbHeight = 100) ifTrue:[^ self].
(thumbFrame ~~ oldFrame) ifTrue:[
oldFrame isNil ifTrue:[
self drawThumb.
^ self
].
tH := thumbFrame height.
tW := thumbFrame width.
oldTop := oldFrame top.
oldBot := oldTop + tH.
thumbTop := thumbFrame top.
thumbBot := thumbTop + tH.
left := thumbFrame left.
(self exposeEventPending
or:[oldBot >= height]) ifTrue:[
"cannot copy - thumb was below end or may be not available
for the copy"
self drawThumbBackgroundInX:left y:oldTop
width:tW height:(height - oldTop).
self drawThumb.
^ self
].
self catchExpose.
self copyFrom:self x:left y:oldTop
toX:left y:thumbTop
width:tW height:tH.
oldTop > thumbTop ifTrue:[
delta := oldTop - thumbTop.
oldTop > thumbBot ifTrue:[
self drawThumbBackgroundInX:left y:oldTop
width:tW height:(tH + 1)
] ifFalse:[
self drawThumbBackgroundInX:left y:thumbBot
width:tW height:delta
]
] ifFalse:[
delta := thumbTop - oldTop.
oldBot < thumbTop ifTrue:[
self drawThumbBackgroundInX:left y:oldTop
width:tW height:(tH + 1)
] ifFalse:[
self drawThumbBackgroundInX:left y:oldTop
width:tW height:delta
]
].
self waitForExpose
]
] ifFalse:[
thumbFrame := nil
]
]
!
thumbHeight:newHeight
"set the thumbs height (in percent)"
|realNewHeight oldFrame|
(newHeight > 100) ifTrue:[
realNewHeight := 100
] ifFalse:[
realNewHeight := newHeight
].
((realNewHeight ~= thumbHeight) or:[thumbFrame isNil]) ifTrue:[
thumbHeight := realNewHeight.
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).
].
self drawThumb
]
] ifFalse:[
thumbFrame := nil
]
]
!
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:[
moveDirection == #y 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:[
(moveDirection == #y) 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
]
]
!
thumbOrigin:newOrigin thumbHeight:newHeight
"set both thumbs height and origin (in percent)"
|realNewOrigin realNewHeight old new changed|
(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.
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
]
]
]
!
setThumbOriginFor:aView
"get contents and size info from aView and adjust thumb origin"
|percent total contentsPosition|
(moveDirection == #y) 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:[
contentsPosition := (moveDirection == #y) ifTrue:[aView yOriginOfContents]
ifFalse:[aView xOriginOfContents].
percent := contentsPosition * 100.0 / total
].
self thumbOrigin:percent
!
is3D
StyleSheet name = #mswindows ifTrue:[^ true].
^ super is3D
!
scrollAction:aBlock
"set the scroll action, aBlock which is evaluated when scrolled"
scrollAction := aBlock
!
asynchronousOperation
"set scroll-mode to be asynchronous - scroll action is performed after
scrolling, when mouse-button is finally released"
synchronousOperation := false
!
synchronousOperation
"set scroll-mode to be synchronous - scroll action is performed for
every movement of thumb"
synchronousOperation := true
!
scrollAction
"answer the scroll action block"
^ scrollAction
!
scrollDownAction:aBlock
"ignored -
but implemented, so that scroller can be used in place of a scrollbar"
!
scrollUpAction:aBlock
"ignored -
but implemented, so that scroller can be used in place of a scrollbar"
!
thumbOrigin
"answer the thumbs origin (in percent)"
^ thumbOrigin
!
thumbHeight
"answer the thumbs height (in percent)"
^ thumbHeight
!
setThumbHeightFor:aView
"get contents and size info from aView and adjust thumb height"
|percent total viewsSize|
(moveDirection == #y) 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 := (moveDirection == #y) ifTrue:[aView innerHeight]
ifFalse:[aView innerWidth].
percent := viewsSize * 100.0 / total
].
self thumbHeight:percent
!
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
]
!
thumbColor
"return the thumbs color"
^ thumbColor
!
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
! !
!Scroller methodsFor:'private'!
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.
(moveDirection == #y) 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
].
(moveDirection == #y) 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
!
absFromPercent:percent
"given a percentage, compute number of pixels"
|fullSize|
(moveDirection == #y) ifTrue:[
fullSize := height
] ifFalse:[
fullSize := width
].
"/ ^ ((percent * (fullSize - (margin * 2))) / 100) rounded
"/ 20-apr-94
^ ((percent * (fullSize - thumbFrameSizeDifference- (margin * 2))) / 100) rounded
!
percentFromAbs:absValue
"given a number of pixels, compute percentage"
|fullSize val|
(moveDirection == #y) ifTrue:[
fullSize := height
] ifFalse:[
fullSize := width
].
val := absValue / (fullSize - thumbFrameSizeDifference - (margin * 2)) * 100.
val < 0 ifTrue:[^ 0].
val > 100 ifTrue:[^ 100].
^ val
! !
!Scroller methodsFor:'initialization'!
initialize
"initialize - setup instvars from defaults"
super initialize.
self computeInitialExtent.
moveDirection := #y.
scrolling := false.
synchronousOperation := true.
thumbOrigin := 0.
thumbHeight := 100.
thumbFrameSizeDifference := 0.
"/ inset := 1.
"/ self computeThumbFrame
!
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.
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
]
!
computeInitialExtent
^ self
!
initCursor
"set the cursor - a hand"
cursor := Cursor hand
! !
!Scroller methodsFor:'event handling'!
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
]
!
buttonRelease:button x:x y:y
"mouse-button was released - if scroll-mode is asynchronous, the scroll
action is now performed"
|rect|
scrolling 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.
]
]
!
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|
(moveDirection == #y) 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
]
]
!
sizeChanged:how
"size of scroller changed - recompute thumbs frame and redraw it"
shown ifTrue:[
self computeThumbFrame.
self redraw
]
!
buttonMotion:button 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|
scrolling ifFalse: [^ self]. "should not happen"
frameBeforeMove isNil ifTrue:[
ghostColor notNil ifTrue:[
frameBeforeMove := thumbFrame insetBy:1@1
]
].
(moveDirection == #y) 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
]
].
self thumbOrigin:(self percentFromAbs:(pos - pressOffset)).
synchronousOperation ifTrue: [
self tellOthers.
]
!
redraw
"redraw"
shown ifTrue:[
thumbFrame isNil ifTrue:[self computeThumbFrame].
self drawThumbBackgroundInX:0 y:0 width:width height:height.
self drawThumb
]
!
buttonShiftPress:button x:x y:y
"mouse-click with shift - jump to position"
|pos curr limit1 limit2 org|
(moveDirection == #y) ifTrue:[
curr := y.
limit1 := height.
limit2 := thumbFrame top
] ifFalse:[
curr := x.
limit1 := width.
limit2 := thumbFrame left
].
(curr < 0) ifTrue:[ "check against limits"
pos := 0
] ifFalse:[
(curr > limit1) ifTrue:[
pos := limit1
] ifFalse:[
pos := curr
]
].
frameBeforeMove := thumbFrame insetBy:1@1.
self thumbOrigin:(self percentFromAbs:pos).
self tellOthers.
(moveDirection == #y) ifTrue:[
limit2 := thumbFrame top
] ifFalse:[
limit2 := thumbFrame left
].
pressOffset := curr - limit2.
scrolling := true
!
buttonMultiPress:button x:x y:y
^ self buttonPress:button x:x y:y
! !
!Scroller methodsFor:'forwarding changed origin'!
tellOthers
"
the ST/X way of notifying scrolls
"
scrollAction notNil ifTrue:[
scrollAction value:thumbOrigin
].
"
the ST-80 way of notifying scrolls
"
self sendChangeMessageWith:thumbOrigin.
self changed:#scrollerPosition.
! !
!Scroller methodsFor:'forced scroll'!
pageUp
"page up/left"
self thumbOrigin:(thumbOrigin - thumbHeight).
self tellOthers
!
pageDown
"page down/right"
self thumbOrigin:(thumbOrigin + thumbHeight).
self tellOthers
! !