From VisualWorks, Release 3.0 of 25. Februar 1998 on 13. September 2000 at 11:58:23'!
AutoScrollingView subclass: #RODAutoScrollingTestView
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'ROD_TestModel'!
RODAutoScrollingTestView class
instanceVariableNames: ''!
RODAutoScrollingTestView comment: 'This is an example class. We visualize the effects of #preferredBounds and the #extraSpace of our ScrollValueHolder. Therefore we display a Rectangle with center 0@0 and extent ''self bounds extent'' and allow changes of the extraSpace. As #preferredBounds we add some space to our bounds.
The class methods in the protocol ''examples'' are commented with the expected results.'!
!RODAutoScrollingTestView methodsFor: 'accessing'!
extraSpace: aBlockOrValueModel
scrollOffset extraSpace: aBlockOrValueModel!
preferredBounds
"^"
| extent center |
extent := self bounds extent + (self preferredExtraSpaceExtent * 2).
center := 0 @ 0.
^Rectangle origin: center - extent corner: center + extent!
preferredExtraSpaceExtent
"^"
^self bounds extent / 2!
rectangle
| extent center |
extent := self bounds extent / 2.
center := 0 @ 0.
^Rectangle origin: center - extent corner: center + extent!
scrollGrid: aBlockOrPoint
scrollOffset grid: aBlockOrPoint! !
!RODAutoScrollingTestView methodsFor: 'displaying'!
displayOn: aGraphicsContext
"Display the receiver on aGraphicsContext. The receiver may alter
aGraphicsContext in any way it chooses."
aGraphicsContext displayRectangle: self rectangle.
(Circle center: 0 @ 0 radius: 10) displayFilledOn: (aGraphicsContext copy
paint: ColorValue yellow).
super displayOn: aGraphicsContext! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
!RODAutoScrollingTestView class methodsFor: 'example'!
example
"^ Opens an example window showing the returned view.
The #preferredBounds are greater then the bounds and centered in 0 @ 0. The size of
the Rectangle is equal to the size of the view bounds. The center of the rectangle is 0@0.
If we scroll to the origin of the rectangle we expect the scrollbars to be centered."
"self example."
| win comp extent asv |
extent := 600 @ 301.
asv := RODAutoScrollingTestView new.
comp := (LookPreferences edgeDecorator on: asv) useHorizontalScrollBar; useVerticalScrollBar; yourself.
win := ScheduledWindow
model: nil
label: 'TEST'
minimumSize: extent.
win component: comp; open.
asv scrollGrid: 20 asPoint.
asv
scrollTo: asv rectangle origin negated;
invalidate.
^asv!
exampleExtraSpace
"^ Opens an example window showing the returned view.
The scrollbars should allow more scrolling then in #example as if we had expanded the
#preferredBounds by an amount of 'bounds extent'."
"self exampleExtraSpace."
| asv |
asv := self example.
asv
extraSpace:
[| pt |
pt := asv bounds extent.
Rectangle origin: pt corner: pt].
^asv!
exampleScrolling
"Opens and closes an example window. First we expect the horizontal scrollbar moving in steps
from center + a fixed amount to center - the same amount. The non moving vertival scrollbar
should stay in the middle. Afterwards the vertical scrollbar should move and the other one stay
centered."
"self exampleScrolling."
| container asv delayMillisec maxX maxY center |
delayMillisec := 10.
asv := self exampleExtraSpace.
center := asv rectangle origin negated.
maxX := 2/3 * asv preferredBounds extent x.
maxY := 2/3 * asv preferredBounds extent y.
maxX * -1
to: maxX
by: 10
do:
[:x |
asv scrollTo: (x + center x) @ center y; invalidate.
(Delay forMilliseconds: delayMillisec) wait].
maxY * -1
to: maxY
by: 10
do:
[:y |
asv scrollTo: center x @ (y + center y) ; invalidate.
(Delay forMilliseconds: delayMillisec) wait].
container := asv.
[container isKindOf: Window]
whileFalse: [container := container container].
container controller closeAndUnschedule! !