HorizontalScrollBar.st
author claus
Sun, 07 Aug 1994 15:23:42 +0200
changeset 38 4b9b70b2cc87
parent 21 9ef599238fea
child 59 450ce95a72a4
permissions -rw-r--r--
2.10.3 pre-final version

"
 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.
"

ScrollBar subclass:#HorizontalScrollBar
       instanceVariableNames:''
       classVariableNames:''
       poolDictionaries:''
       category:'Views-Interactors'
!

HorizontalScrollBar comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
              All Rights Reserved

$Header: /cvs/stx/stx/libwidg/HorizontalScrollBar.st,v 1.6 1994-08-07 13:22:35 claus Exp $
'!

!HorizontalScrollBar 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/HorizontalScrollBar.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'!

createElements
    button1 := ArrowButton leftIn:self.
    button1 name:'LeftButton'.
    button2 := ArrowButton rightIn:self.
    button2 name:'RightButton'.
    thumb := HorizontalScroller in:self.
!

computeInitialExtent
    "compute my extent from sub-components"

    |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.
    sep := self spaceBetweenElements.

    (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.
        ^ self
    ].

    (layout == #top) ifTrue:[
        "buttons at right"
        button1 viewGravity:#West.
        button2 viewGravity:#West.
        thumb origin:(bwn @ 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
! !

!HorizontalScrollBar methodsFor:'events'!

sizeChanged:how
    |leftWidth rightWidth thumbWidth leftAndRightWidth bwn sep sep2 
     thumbHeight h|

    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 + margin.
    sep := self spaceBetweenElements.

    thumbWidth := width - leftAndRightWidth - borderWidth - (sep * 3).
"
    ((layout ~~ #top) and:[layout ~~ #bottom]) ifTrue:[
        thumbWidth := thumbWidth - borderWidth
    ].
"
    layout == #around 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"

    h := height - (margin * 2).

    (h ~~ button1 height) ifTrue:[
        button1 height:h.
        button2 height:h
    ].

    thumbHeight := h.
    style == #next ifTrue:[
        thumbHeight := thumbHeight - (thumb borderWidth * 2).
        thumbWidth := thumbWidth - 1
    ].


    "
     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).
        ^ self
    ].

    sep2 := sep * 2.
    (layout == #top) ifTrue:[
        "buttons at right"
        thumbWidth := thumbWidth + borderWidth.
        (how == #smaller) ifTrue:[
            thumb extent:(thumbWidth @ thumbHeight).
            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 @ thumbHeight)
        ].
        ^ self
    ].
    "button around thumb"

    button1 origin:(bwn @ bwn).
    button2 origin:((leftWidth + thumbWidth + sep2 - (margin // 2)) @ bwn).
    thumb extent:((thumbWidth + margin - (margin // 2)) @ thumbHeight).
    thumb origin:((leftWidth - borderWidth + sep) @ bwn)
! !