"

 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.

"

View subclass:#ScrollBar

       instanceVariableNames:'thumb button1 button2 layout'

       classVariableNames:'defaultScrollUpForm 

                           defaultScrollDownForm

                           defaultLayout'

       poolDictionaries:''

       category:'Views-Interactors'

!

ScrollBar comment:'

COPYRIGHT (c) 1989-93 by Claus Gittinger

              All Rights Reserved

this class implements vertical scrollbars with scroller and

2 step-scroll buttons. when moved or stepped, it performs a

predefined action.

%W% %E%

written spring/summer 89 by claus

'!

!ScrollBar class methodsFor:'initialization'!

initialize

    "read defaults"

    super initialize.

    "layout controls how buttons are positioned:

        #top puts them at top/left

        #bottom puts them at bottom/right

        #around puts them around thumb

    "

    defaultLayout := Resources at:'LAYOUT' default:#around

! !

!ScrollBar class methodsFor:'defaults'!

scrollUpButtonForm:style

    "answer the form used for the scrollUp Button"

    defaultScrollUpForm isNil ifTrue:[

        defaultScrollUpForm := Form fromFile:(Resources at:'UP_BUTTON_FORM_FILE'

                                                   default:(style == #mswindows

                                                                 ifTrue:['ScrollUp_win.xbm']

                                                                 ifFalse:['ScrollUp.xbm'])

                                             )

                                  resolution:100

    ].

    defaultScrollUpForm isNil ifTrue:[

        defaultScrollUpForm := Form width:16 height:16 

                                      fromArray:#(2r00000000 2r00000000

                                                  2r00000001 2r10000000

                                                  2r00000010 2r01000000

                                                  2r00000100 2r00100000

                                                  2r00001000 2r00010000

                                                  2r00010000 2r00001000

                                                  2r00100000 2r00000100

                                                  2r01000000 2r00000010

                                                  2r01111000 2r00011110

                                                  2r00001000 2r00010000

                                                  2r00001000 2r00010000

                                                  2r00001000 2r00010000

                                                  2r00001000 2r00010000

                                                  2r00001000 2r00010000

                                                  2r00001111 2r11110000

                                                  2r00000000 2r00000000)

    ].

    ^ defaultScrollUpForm

!

scrollDownButtonForm:style

    "retun the form used for the scrollDown Button"

    defaultScrollDownForm isNil ifTrue:[

        defaultScrollDownForm := Form fromFile:(Resources at:'DOWN_BUTTON_FORM_FILE'

                                                    default:(style == #mswindows

                                                                 ifTrue:['ScrollDn_win.xbm']

                                                                 ifFalse:['ScrollDn.xbm'])

                                                )

                                    resolution:100

    ].

    defaultScrollDownForm isNil ifTrue:[

        defaultScrollDownForm := Form width:16 height:16 

                                      fromArray:#(2r00000000 2r00000000

                                                  2r00001111 2r11110000

                                                  2r00001000 2r00010000

                                                  2r00001000 2r00010000

                                                  2r00001000 2r00010000

                                                  2r00001000 2r00010000

                                                  2r00001000 2r00010000

                                                  2r01111000 2r00011110

                                                  2r01000000 2r00000010

                                                  2r00100000 2r00000100

                                                  2r00010000 2r00001000

                                                  2r00001000 2r00010000

                                                  2r00000100 2r00100000

                                                  2r00000010 2r01000000

                                                  2r00000001 2r10000000

                                                  2r00000000 2r00000000)

    ].

    ^ defaultScrollDownForm

! !

!ScrollBar class methodsFor:'style changes'!

styleChange

    defaultScrollUpForm := nil.

    defaultScrollDownForm := nil

    "ScrollBar styleChange"

! !

!ScrollBar methodsFor:'initialization'!

initialize

    "setup; create the 2 buttons and a scroller"

    |bwn sep w h upForm downForm c|

    super initialize.

    "compute my extent from sub-components"

    upForm  := self class scrollUpButtonForm:style.

    downForm := self class scrollDownButtonForm:style.

    h := upForm height + downForm height +

         (1 "self defaultBorderWidth" * 2) + (Scroller defaultExtent y).

    w := (upForm width) max:(downForm width).

    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 := Button form:(self class scrollUpButtonForm:style) in:self.

    button1 name:'UpButton'.

    button1 borderWidth:borderWidth.

    button1 autoRepeat.

    thumb := Scroller in:self.

    style ~~ #next ifTrue:[

        thumb borderWidth:borderWidth.

    ].

    button2 := Button form:(self class scrollDownButtonForm:style) in:self.

    button2 name:'DownButton'.

    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.

    ].

    (layout == #top) ifTrue:[

        button1 origin:(bwn @ bwn).

        button1 viewGravity:#North.

        button2 origin:(bwn @ (button1 height)).

        button2 viewGravity:#North.

        thumb origin:(bwn @ (button1 height + borderWidth + button2 height + sep + sep)).

        thumb viewGravity:#North

    ] ifFalse:[

        (layout == #bottom) ifTrue:[

            button1 viewGravity:#North.

            button2 viewGravity:#North.

            thumb origin:(bwn @ bwn).

            thumb viewGravity:#North

        ] ifFalse:[

            button1 origin:(bwn @ bwn).

            button1 viewGravity:#North.

            button2 viewGravity:#North.

            thumb origin:(bwn @ (button1 height + sep)).

            thumb viewGravity:#North

        ]

    ]

! !

!ScrollBar methodsFor:'accessing'!

scrollAction:aBlock

    "set the action, aBlock to be performed when the scroller is moved"

    thumb scrollAction:aBlock

!

scrollUpAction:aBlock

    "set the action, aBlock to be performed when the up-button is pressed"

    button1 action:aBlock

!

scrollDownAction:aBlock

    "set the action, aBlock to be performed when the down-button is pressed"

    button2 action:aBlock

!

thumbColor:aColor

    thumb thumbColor:aColor

!

thumbOrigin

    "answer position of (top of) thumb in percent"

    ^ thumb thumbOrigin

!

thumbOrigin:newOrigin

    "set position of (top of) thumb in percent"

    ^ thumb thumbOrigin:newOrigin

!

thumbHeight

    "answer height of thumb in percent"

    ^ thumb thumbHeight

!

thumbHeight:newHeight

    "set height of thumb in percent"

    ^ thumb thumbHeight:newHeight

!

thumbOrigin:newOrigin thumbHeight:newHeight

    "set origin and height of thumb in percent"

    ^ thumb thumbOrigin:newOrigin thumbHeight:newHeight

!

setThumbFor:aView

    "adjust thumb for aView"

    thumb setThumbFor:aView

!

setThumbHeightFor:aView

    "adjust thumbs height for aView"

    thumb setThumbHeightFor:aView

!

setThumbOriginFor:aView

    "adjust thumbs origin for aView"

    thumb setThumbOriginFor:aView

!

asynchronousOperation

    "set asynchronous-mode - scroll action is performed after movement

     of scroller (i.e. when mouse-button is finally released)"

    thumb asynchronousOperation

!

synchronousOperation

    "set synchronous-mode - scroll action is performed for every movement

     of scroller"

    thumb synchronousOperation

! !

!ScrollBar methodsFor:'events'!

sizeChanged:how

    "when my size changes, I have to resize/reposition the subviews"

    |upHeight downHeight thumbHeight upAndDownHeight bwn sep sep2

     thumbWidth|

    button1 isNil ifTrue:[^ self].

    thumb isNil ifTrue:[^ self].

    button2 isNil ifTrue:[^ self].

    upHeight := button1 height + borderWidth.

    downHeight := button2 height + borderWidth.

    upAndDownHeight := upHeight + downHeight.

    bwn := borderWidth negated.

    self is3D ifTrue:[

        sep := 1

    ] ifFalse:[

        sep := 0

    ].

    thumbHeight := height - upAndDownHeight - borderWidth - (sep * 3).

    ((layout ~~ #top) and:[layout ~~ #bottom]) ifTrue:[

        thumbHeight := thumbHeight - borderWidth

    ].

    "if I become too small, hide buttons and thumb"

    height < (upHeight + downHeight) ifTrue:[

        button1 shown ifTrue:[

            button1 hidden.

            button2 hidden.

            thumb hidden

        ]

    ] ifFalse:[

        shown ifTrue:[

            button1 shown ifFalse:[

                button1 show.

                button2 show.

                thumb show

            ]

        ]

    ].

    (thumbHeight < 10) ifTrue:[

        thumb shown ifTrue:[

            thumb hidden

        ]

    ] ifFalse:[

        thumb shown ifFalse:[

            button1 shown ifTrue:[

                thumb show

            ]

        ]

    ].

    "width of buttons is always my width"

    (width ~~ button1 width) ifTrue:[

        button1 width:width.

        button2 width:width

    ].

    thumbWidth := width.

    style == #next ifTrue:[

        thumbWidth := thumbWidth - (thumb borderWidth * 2).

        thumbHeight := thumbHeight - 1

    ].

    (layout == #top) ifTrue:[

        "buttons at top"

        thumb extent:(thumbWidth @ thumbHeight).

        ^ self

    ].

    sep2 := sep * 2.

    (layout == #bottom) ifTrue:[

        "buttons at bottom"

        thumbHeight := thumbHeight + borderWidth.

        (how == #smaller) ifTrue:[

            thumb extent:(thumbWidth @ thumbHeight).

            button1 origin:(bwn @ (thumbHeight + sep2)).

            button2 origin:(bwn @ (thumbHeight + sep2 + upHeight))

        ] ifFalse:[

            button1 origin:(bwn @ (thumbHeight + sep2)).

            button2 origin:(bwn @ (thumbHeight + sep2 + upHeight)).

            thumb extent:(thumbWidth @ thumbHeight)

        ].

        ^ self

    ].

    "buttons around thumb"

    button2 origin:(bwn @ (upHeight + thumbHeight + sep2 + borderWidth)).

    thumb extent:(thumbWidth @ thumbHeight).

    thumb origin:(bwn @ (upHeight - borderWidth + sep))

! !