--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/HScrBar.st Fri Jul 16 11:44:44 1993 +0200
@@ -0,0 +1,268 @@
+"
+ COPYRIGHT (c) 1989-93 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.
+"
+
+ScrollBar subclass:#HorizontalScrollBar
+ instanceVariableNames:''
+ classVariableNames:'defaultScrollRightForm
+ defaultScrollLeftForm'
+ poolDictionaries:''
+ category:'Views-Interactors'
+!
+
+HorizontalScrollBar comment:'
+
+COPYRIGHT (c) 1989-93 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.
+
+%W% %E%
+
+written spring/summer 89 by claus
+'!
+
+!HorizontalScrollBar class methodsFor:'defaults'!
+
+scrollLeftButtonForm:style
+ defaultScrollLeftForm isNil ifTrue:[
+ defaultScrollLeftForm := Form fromFile:(Resources at:'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
+!
+
+scrollRightButtonForm:style
+ defaultScrollRightForm isNil ifTrue:[
+ defaultScrollRightForm := Form fromFile:(Resources at:'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
+! !
+
+!HorizontalScrollBar methodsFor:'initialization'!
+
+initialize
+ |bwn sep h w leftForm rightForm|
+
+ super initialize.
+
+ "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
+ ].
+ self extent:w @ h.
+
+ style == #mswindows ifTrue:[
+ layout := #around
+ ] ifFalse:[
+ layout := defaultLayout
+ ].
+
+ bwn := borderWidth negated.
+ self is3D ifTrue:[
+ sep := 1
+ ] ifFalse:[
+ sep := 0
+ ].
+
+ button1 form:(self class scrollLeftButtonForm:style).
+ button1 name:'LeftButton'.
+ button1 borderWidth:borderWidth.
+ button1 autoRepeat.
+
+ button2 form:(self class scrollRightButtonForm:style).
+ button2 name:'RightButton'.
+ button2 borderWidth:borderWidth.
+ button2 autoRepeat.
+
+ "poor design - destroy thumb and re-create a HScroller for it"
+
+ thumb destroy.
+ thumb := HorizontalScroller in:self.
+ thumb borderWidth:borderWidth.
+
+ (layout == #bottom) ifTrue:[
+ "buttons at left"
+ button1 origin:(bwn @ bwn).
+ button1 viewGravity:#West.
+ button2 origin:(button1 width @ bwn).
+ button2 viewGravity:#West.
+ thumb origin:((button1 width + borderWidth + button2 width + sep + sep) @ 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
+ ]
+ ]
+! !
+
+!HorizontalScrollBar methodsFor:'accessing'!
+
+scrollLeftAction:aBlock
+ button1 action:aBlock
+!
+
+scrollRightAction:aBlock
+ button2 action:aBlock
+! !
+
+!HorizontalScrollBar methodsFor:'events'!
+
+sizeChanged:how
+ |leftWidth rightWidth thumbWidth leftAndRightWidth bwn sep sep2|
+
+ button1 isNil ifTrue:[^ self].
+ button2 isNil ifTrue:[^ self].
+ thumb isNil ifTrue:[^ self].
+
+ leftWidth := button1 width + borderWidth.
+ rightWidth := button2 width + borderWidth.
+ leftAndRightWidth := leftWidth + rightWidth.
+ bwn := borderWidth negated.
+ self is3D ifTrue:[
+ sep := 1
+ ] ifFalse:[
+ sep := 0
+ ].
+
+ thumbWidth := width - leftAndRightWidth - borderWidth - (sep * 3).
+ ((layout ~~ #top) and:[layout ~~ #bottom]) ifTrue:[
+ thumbWidth := thumbWidth - borderWidth
+ ].
+
+ "if I become too small, hide buttons"
+
+ (width < leftAndRightWidth) ifTrue:[
+ button1 shown ifTrue:[
+ button1 hidden.
+ button2 hidden.
+ thumb hidden
+ ]
+ ] ifFalse:[
+ shown ifTrue:[
+ button1 shown ifFalse:[
+ button1 show.
+ button2 show.
+ thumb show
+ ]
+ ]
+ ].
+
+ (thumbWidth < 10) ifTrue:[
+ thumb shown ifTrue:[
+ thumb hidden
+ ]
+ ] ifFalse:[
+ thumb shown ifFalse:[
+ button1 shown ifTrue:[
+ thumb show
+ ]
+ ]
+ ].
+
+ "height of buttons is always my width"
+
+ (height ~~ button1 height) ifTrue:[
+ button1 height:height.
+ button2 height:height
+ ].
+
+ "thumb height:height. "
+
+ (layout == #bottom) ifTrue:[
+ "buttons at left"
+ thumb extent:(thumbWidth @ height).
+ ^ self
+ ].
+ sep2 := sep * 2.
+ (layout == #top) ifTrue:[
+ "buttons at right"
+ (how == #smaller) ifTrue:[
+ thumb extent:(thumbWidth @ height).
+ button1 origin:((thumbWidth + sep2) @ bwn).
+ button2 origin:((thumbWidth + sep2 + leftWidth) @ bwn)
+ ] ifFalse:[
+ button1 origin:((thumbWidth + sep2) @ bwn).
+ button2 origin:((thumbWidth + sep2 + leftWidth) @ bwn).
+ thumb extent:(thumbWidth @ height)
+ ].
+ ^ self
+ ].
+ "button around thumb"
+
+ button2 origin:((leftWidth + thumbWidth + sep2) @ bwn).
+ thumb extent:(thumbWidth @ height).
+ thumb origin:((leftWidth - borderWidth + sep) @ bwn)
+! !