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

documentation
"
    this class implements horizontal scrollbars with scroller and
    2 step-scroll buttons. When moved or stepped, it performs a
    predefined action.

    [author:]
        Claus Gittinger
"
! !

!HorizontalScrollBar methodsFor:'accessing-behavior'!

scrollLeftAction
    "return the action which is performed on scroll-left"

    ^ button1 action
!

scrollLeftAction:aBlock
    "set the action to be performed on scroll-left"

    button1 action:aBlock
!

scrollRightAction
    "return the action which is performed on scroll-right"

    ^ button2 action
!

scrollRightAction:aBlock
    "set the action  to be performed on scroll-right"

    button2 action:aBlock
! !

!HorizontalScrollBar methodsFor:'event handling'!

sizeChanged:how
    "my size has changed somehow - reposition the components"

    <resource: #style (#name)>

    "handle changed size - reposition elements"

    |leftWidth rightWidth thumbWidth leftAndRightWidth bwn sep2 
     thumbHeight h style b1Hidden b2Hidden thumbHidden bX|

    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.

    thumbWidth := width - leftAndRightWidth - borderWidth - (elementSpacing * 3).
"
    ((buttonLayout ~~ #top) and:[buttonLayout ~~ #bottom]) ifTrue:[
        thumbWidth := thumbWidth - borderWidth
    ].
"
    buttonLayout == #around ifTrue:[
        thumbWidth := thumbWidth + borderWidth
    ].

    "if I become too small, hide buttons"

    width < leftAndRightWidth ifTrue:[
        b1Hidden := b2Hidden := thumbHidden := true.
    ] ifFalse:[
        b1Hidden := b2Hidden := thumbHidden := false.
    ].

    (thumbWidth < 10) ifTrue:[
        thumbHidden := true.
    ] ifFalse:[
        thumbHidden := false.
    ].

    button1 hiddenOnRealize:b1Hidden.
    b1Hidden ifTrue:[
        button1 unmap
    ] ifFalse:[
        shown ifTrue:[button1 realize]
    ].
    button2 hiddenOnRealize:b1Hidden.
    b2Hidden ifTrue:[
        button2 unmap
    ] ifFalse:[
        shown ifTrue:[button2 realize]
    ].
    thumb hiddenOnRealize:thumbHidden.
    thumbHidden ifTrue:[
        thumb unmap
    ] ifFalse:[
        shown ifTrue:[thumb realize]
    ].

    "height of buttons is always my width"

    h := height - (margin * 2).

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

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

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

    (buttonLayout == #bottom) ifTrue:[
        "buttons at left"
        thumb extent:(thumbWidth @ thumbHeight).
        ^ self
    ].

    sep2 := elementSpacing * 2.
    (buttonLayout == #top) ifTrue:[
        "buttons at right"
        thumbWidth := thumbWidth + borderWidth.
        thumbHidden ifTrue:[
            bX := elementSpacing
        ] ifFalse:[
            bX := thumbWidth + sep2.
        ].
        (how == #smaller) ifTrue:[
            thumb extent:(thumbWidth @ thumbHeight).
            button1 origin:(bX @ bwn).
            button2 origin:((bX + leftWidth) @ bwn)
        ] ifFalse:[
            button1 origin:(bX @ bwn).
            button2 origin:((bX + leftWidth) @ bwn).
            thumb extent:(thumbWidth @ thumbHeight)
        ].
        ^ self
    ].
    "button around thumb"

    style == #motif ifTrue:[
        sep2 := sep2 + 1
    ].

    button1 origin:(bwn @ bwn).
    style == #os2 ifTrue:[
        button2 origin:((leftWidth + thumbWidth + sep2 - margin) @ bwn).
        thumb extent:((thumbWidth - margin - margin) @ thumbHeight).
        thumb origin:((leftWidth - borderWidth + elementSpacing + margin) @ bwn)
    ] ifFalse:[
        button2 origin:((leftWidth + thumbWidth + sep2 - (margin // 2)) @ bwn).
        thumb extent:((thumbWidth + margin - (margin // 2)) @ thumbHeight).
        thumb origin:((leftWidth - borderWidth + elementSpacing) @ bwn)
    ].

    "Modified: 3.5.1996 / 23:47:30 / stefan"
    "Modified: 17.1.1997 / 23:19:15 / cg"
! !

!HorizontalScrollBar methodsFor:'initialization'!

createElements
    "private: create my elements"

    button1 := ArrowButton leftIn:self.
    button2 := ArrowButton rightIn:self.
    thumb := HorizontalScroller in:self.
!

setElementPositions
    "position sub-components"

    |bwn|

    bwn := borderWidth negated + margin.

    (buttonLayout == #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 
		       + elementSpacing + elementSpacing) @ bwn).
	thumb viewGravity:#West.
	^ self
    ].

    (buttonLayout == #top) ifTrue:[
	"buttons at right"
	button1 viewGravity:#West.
	button2 viewGravity:#West.
	thumb origin:(bwn @ bwn).
	thumb viewGravity:#West
    ].

    "buttonLayout == #around "
    button1 origin:(bwn @ bwn).
    button1 viewGravity:#West.
    button2 viewGravity:#West.
    thumb origin:((button1 width + elementSpacing) @ bwn).
    thumb viewGravity:#West
! !

!HorizontalScrollBar methodsFor:'queries'!

preferredExtent
    "compute my extent from sub-components"

    <resource: #style (#name)>

    |w h leftForm rightForm wLeft hLeft wRight hRight style|

    "/ If I have an explicit preferredExtent ..

    preferredExtent notNil ifTrue:[
        ^ preferredExtent
    ].

    "/ need fix - this is a kludge;
    "/ the reference to the mswindows style here is bad
    style := styleSheet name.
    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.
        "
         just in case ...
        "
        leftForm isNil ifTrue:[
            wLeft := hLeft := 16
        ] ifFalse:[
            wLeft := leftForm width.
            hLeft := leftForm height
        ].
        rightForm isNil ifTrue:[
            wRight := hRight := 16
        ] ifFalse:[
            wRight := rightForm width.
            hRight := rightForm height
        ].
        w := wLeft + wRight + (1 * 2) + (HorizontalScroller defaultExtent x).
        h := hLeft max:hRight.
        (style ~~ #normal) ifTrue:[
            h := h + 4.
            w := w + 4
        ].
    ].
    preferredExtent := w @ h.
    ^ preferredExtent.

    "Modified: 17.1.1997 / 23:18:48 / cg"
! !

!HorizontalScrollBar class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libwidg/HorizontalScrollBar.st,v 1.23 1997-01-17 22:24:42 cg Exp $'
! !