--- a/HScrBar.st Sun Aug 07 15:22:53 1994 +0200
+++ b/HScrBar.st Sun Aug 07 15:23:42 1994 +0200
@@ -12,147 +12,88 @@
ScrollBar subclass:#HorizontalScrollBar
instanceVariableNames:''
- classVariableNames:'DefaultScrollRightForm
- DefaultScrollLeftForm'
+ classVariableNames:''
poolDictionaries:''
category:'Views-Interactors'
!
HorizontalScrollBar comment:'
-
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-this class implements horizontal scrollbars with scroller and
-2 step-scroll buttons. when moved or stepped, it perform a
-predefined action.
-
-$Header: /cvs/stx/stx/libwidg/Attic/HScrBar.st,v 1.5 1994-01-08 17:27:18 claus Exp $
-
-written spring/summer 89 by claus
+$Header: /cvs/stx/stx/libwidg/Attic/HScrBar.st,v 1.6 1994-08-07 13:22:35 claus Exp $
'!
-!HorizontalScrollBar class methodsFor:'defaults'!
+!HorizontalScrollBar class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1989 by Claus Gittinger
+ All Rights Reserved
-scrollLeftButtonForm:style
- DefaultScrollLeftForm isNil ifTrue:[
- DefaultScrollLeftForm := Form fromFile:(self classResources at:'SCROLL_LEFT_BUTTON_FORM_FILE'
- default:(style == #mswindows
- ifTrue:['ScrollLt_win.xbm']
- ifFalse:['ScrollLt.xbm']))
- resolution:100
- ].
- DefaultScrollLeftForm isNil ifTrue:[
- DefaultScrollLeftForm :=
- Form width:16 height:16 fromArray:#(2r00000000 2r00000000
- 2r00000001 2r10000000
- 2r00000010 2r10000000
- 2r00000100 2r10000000
- 2r00001000 2r11111110
- 2r00010000 2r00000010
- 2r00100000 2r00000010
- 2r01000000 2r00000010
- 2r01000000 2r00000010
- 2r00100000 2r00000010
- 2r00010000 2r00000010
- 2r00001000 2r11111110
- 2r00000100 2r10000000
- 2r00000010 2r10000000
- 2r00000001 2r10000000
- 2r00000000 2r00000000)
- ].
- ^ DefaultScrollLeftForm
+ 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.
+"
!
-scrollRightButtonForm:style
- DefaultScrollRightForm isNil ifTrue:[
- DefaultScrollRightForm := Form fromFile:(self classResources at:'SCROLL_RIGHT_BUTTON_FORM_FILE'
- default:(style == #mswindows
- ifTrue:['ScrollRt_win.xbm']
- ifFalse:['ScrollRt.xbm']))
- resolution:100
- ].
- DefaultScrollRightForm isNil ifTrue:[
- DefaultScrollRightForm :=
- Form width:16 height:16 fromArray:#(2r00000000 2r00000000
- 2r00000001 2r10000000
- 2r00000001 2r01000000
- 2r00000001 2r00100000
- 2r01111111 2r00010000
- 2r01000000 2r00001000
- 2r01000000 2r00000100
- 2r01000000 2r00000010
- 2r01000000 2r00000010
- 2r01000000 2r00000100
- 2r01000000 2r00001000
- 2r01111111 2r00010000
- 2r00000001 2r00100000
- 2r00000001 2r01000000
- 2r00000001 2r10000000
- 2r00000000 2r00000000)
- ].
- ^ DefaultScrollRightForm
+version
+"
+$Header: /cvs/stx/stx/libwidg/Attic/HScrBar.st,v 1.6 1994-08-07 13:22:35 claus Exp $
+"
+!
+
+documentation
+"
+ this class implements horizontal scrollbars with scroller and
+ 2 step-scroll buttons. when moved or stepped, it perform a
+ predefined action.
+"
! !
!HorizontalScrollBar methodsFor:'initialization'!
-initialize
- |bwn sep h w leftForm rightForm c|
+createElements
+ button1 := ArrowButton leftIn:self.
+ button1 name:'LeftButton'.
+ button2 := ArrowButton rightIn:self.
+ button2 name:'RightButton'.
+ thumb := HorizontalScroller in:self.
+!
- super initialize.
-
+computeInitialExtent
"compute my extent from sub-components"
- leftForm := self class scrollLeftButtonForm:style.
- rightForm := self class scrollRightButtonForm:style.
- w := leftForm width + rightForm width
- + (1 "self defaultBorderWidth" * 2)
- + (HorizontalScroller defaultExtent x).
- h := (leftForm height) max:(rightForm height).
- self is3D ifTrue:[
- h := h + 4.
- w := w + 4
+
+ |w h leftForm rightForm|
+
+ "need fix - this is a kludge;
+ the if should not be needed ..."
+ style == #mswindows ifTrue:[
+ h := button1 height max:button2 height.
+ w := button1 width + button2 width + (Scroller defaultExtent x).
+ ] ifFalse:[
+ leftForm := ArrowButton leftArrowButtonForm:style on:device.
+ rightForm := ArrowButton rightArrowButtonForm:style on:device.
+ w := leftForm width + rightForm width + (1 * 2) + (HorizontalScroller defaultExtent x).
+ h := (leftForm height) max:(rightForm height).
+ (style ~~ #normal) ifTrue:[
+ h := h + 4.
+ w := w + 4
+ ].
].
self extent:w @ h.
+!
+
+setElementPositions
+ "position sub-components"
+
+ |bwn sep|
bwn := borderWidth negated + margin.
- self is3D ifTrue:[
- sep := 1
- ] ifFalse:[
- sep := 0
- ].
-
- "poor design - destroy and re-create thumgs"
- button1 destroy.
- button2 destroy.
- thumb destroy.
-
- button1 := ArrowButton leftIn:self.
- button1 name:'LeftButton'.
- button1 borderWidth:borderWidth.
- button1 autoRepeat.
-
- thumb := HorizontalScroller in:self.
- style ~~ #next ifTrue:[
- thumb borderWidth:borderWidth.
- ].
-
- button2 := ArrowButton rightIn:self.
- button2 name:'RightButton'.
- button2 borderWidth:borderWidth.
- button2 autoRepeat.
-
- ((style == #iris) and:[Display hasGreyscales])ifTrue:[
- "have to change some of Buttons defaults"
- c := (Color grey:25) on:device.
- button1 offLevel:2.
- button2 offLevel:2.
- button1 foregroundColor:c.
- button1 activeForegroundColor:c.
- button1 enteredForegroundColor:c.
- button2 foregroundColor:c.
- button2 activeForegroundColor:c.
- button2 enteredForegroundColor:c.
- ].
+ sep := self spaceBetweenElements.
(layout == #bottom) ifTrue:[
"buttons at left"
@@ -161,30 +102,40 @@
button2 origin:(button1 width @ bwn).
button2 viewGravity:#West.
thumb origin:((button1 width + borderWidth + button2 width + sep + sep) @ bwn).
+ thumb viewGravity:#West.
+ ^ self
+ ].
+
+ (layout == #top) ifTrue:[
+ "buttons at right"
+ button1 viewGravity:#West.
+ button2 viewGravity:#West.
+ thumb origin:(bwn @ bwn).
thumb viewGravity:#West
- ] ifFalse:[
- (layout == #top) ifTrue:[
- "buttons at right"
- button1 viewGravity:#West.
- button2 viewGravity:#West.
- thumb origin:(bwn @ bwn).
- thumb viewGravity:#West
- ] ifFalse:[
- button1 origin:(bwn @ bwn).
- button1 viewGravity:#West.
- button2 viewGravity:#West.
- thumb origin:((button1 width + sep) @ bwn).
- thumb viewGravity:#West
- ]
- ]
+ ].
+
+ "layout == #around "
+ button1 origin:(bwn @ bwn).
+ button1 viewGravity:#West.
+ button2 viewGravity:#West.
+ thumb origin:((button1 width + sep) @ bwn).
+ thumb viewGravity:#West
! !
!HorizontalScrollBar methodsFor:'accessing'!
+scrollLeftAction
+ ^ button1 action
+!
+
scrollLeftAction:aBlock
button1 action:aBlock
!
+scrollRightAction
+ ^ button2 action
+!
+
scrollRightAction:aBlock
button2 action:aBlock
! !
@@ -203,11 +154,7 @@
rightWidth := button2 width + borderWidth.
leftAndRightWidth := leftWidth + rightWidth.
bwn := borderWidth negated + margin.
- self is3D ifTrue:[
- sep := 1
- ] ifFalse:[
- sep := 0
- ].
+ sep := self spaceBetweenElements.
thumbWidth := width - leftAndRightWidth - borderWidth - (sep * 3).
"
@@ -254,8 +201,8 @@
h := height - (margin * 2).
(h ~~ button1 height) ifTrue:[
- button1 height:height.
- button2 height:height
+ button1 height:h.
+ button2 height:h
].
thumbHeight := h.
@@ -265,6 +212,14 @@
].
+ "
+ a kludge: views with width or height of 0 are illegal
+ avoid error from view-creation (it will be hidden anyway)
+ "
+ thumbWidth <= 0 ifTrue:[
+ thumbWidth := 1
+ ].
+
(layout == #bottom) ifTrue:[
"buttons at left"
thumb extent:(thumbWidth @ thumbHeight).
@@ -274,6 +229,7 @@
sep2 := sep * 2.
(layout == #top) ifTrue:[
"buttons at right"
+ thumbWidth := thumbWidth + borderWidth.
(how == #smaller) ifTrue:[
thumb extent:(thumbWidth @ thumbHeight).
button1 origin:((thumbWidth + sep2) @ bwn).
@@ -288,7 +244,7 @@
"button around thumb"
button1 origin:(bwn @ bwn).
- button2 origin:((leftWidth + thumbWidth + sep2) @ bwn).
- thumb extent:((thumbWidth + margin) @ thumbHeight).
+ button2 origin:((leftWidth + thumbWidth + sep2 - (margin // 2)) @ bwn).
+ thumb extent:((thumbWidth + margin - (margin // 2)) @ thumbHeight).
thumb origin:((leftWidth - borderWidth + sep) @ bwn)
! !