HorizontalScrollBar.st
author claus
Thu, 17 Nov 1994 15:38:53 +0100
changeset 63 f4eaf04d1eaf
parent 60 f3c738c24ce6
child 70 14443a9ea4ec
permissions -rw-r--r--
*** empty log message ***

"
 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.9 1994-11-17 14:38:02 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.9 1994-11-17 14:38:02 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
    "private: create my elements"

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

computeInitialExtent
    "compute my extent from sub-components"

    |w h leftForm rightForm wLeft hLeft wRight hRight|

    "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.
	"
	 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
	].
    ].
    self extent:w @ h.
!

setElementPositions
    "position sub-components"

    |bwn|

    bwn := borderWidth negated + margin.

    (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 
		       + elementSpacing + elementSpacing) @ 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 + elementSpacing) @ bwn).
    thumb viewGravity:#West
! !

!HorizontalScrollBar methodsFor:'accessing'!

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:'events'!

sizeChanged:how
    "handle changed size - reposition elements"

    |leftWidth rightWidth thumbWidth leftAndRightWidth bwn 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.

    thumbWidth := width - leftAndRightWidth - borderWidth - (elementSpacing * 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
    ].
    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
    ].

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

    sep2 := elementSpacing * 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"

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