"
COPYRIGHT (c) 1993 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.
"
Button subclass:#ArrowButton
instanceVariableNames:'arrowStyle direction'
classVariableNames:'DownArrowForm UpArrowForm LeftArrowForm RightArrowForm
CachedStyle DefaultArrowStyle DefaultBackgroundColor
DefaultForegroundColor DefaultActiveBackgroundColor
DefaultActiveForegroundColor DefaultEnteredBackgroundColor
DefaultEnteredForegroundColor DefaultDisabledForegroundColor
DefaultArrowButtonActiveLevel DefaultArrowButtonPassiveLevel
DownArrowFormFile UpArrowFormFile LeftArrowFormFile
RightArrowFormFile'
poolDictionaries:''
category:'Views-Interactors'
!
!ArrowButton class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1993 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
"
ArrowButtons display an arrow as their label; they are mainly
used for scrollbars, but can be useful on their own in some applications.
Beside the contents, their default behavior is to perform their action
when pressed - not (as is the default for normal buttons) when released.
Indivdual ArrowButtons can be created by sending one of:
ArrowButton upIn:aView /downIn: / leftIn: or rightIn:
passing the parent view as argument.
See examples.
[styleSheet parameters:]
arrowButtonStyle <Symbol> the style of the button;
#motif, #st80 or nil (default)
arrowButtonForegroundColor <nil | Color> foregroundColor
arrowButtonBackgroundColor <nil | Color> backgroundColor
arrowButtonActiveForegroundColor foregroundColor when pressed
arrowButtonActiveBackgroundColor backgroundColor when pressed
arrowButtonEnteredForegroundColor foregroundColor when mouse pointer entered
arrowButtonEnteredBackgroundColor backgroundColor when mouse pointer entered
[author:]
Claus Gittinger
[See also:]
Button Toggle CheckToggle CheckBox
ScrollBar
"
!
examples
"
example1:
[exBegin]
|v p b1 b2 b3 b4|
v := StandardSystemView extent:200@200.
p := HorizontalPanelView origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:v.
b1 := ArrowButton upIn:p.
b2 := ArrowButton downIn:p.
b3 := ArrowButton leftIn:p.
b4 := ArrowButton rightIn:p.
b1 action:['whatEver you like here ...'].
b2 action:['whatEver you like here ...'].
b3 action:['whatEver you like here ...'].
b4 action:['whatEver you like here ...'].
v open
[exEnd]
example2:
[exBegin]
|v p b1 b2 b3 b4|
v := StandardSystemView extent:200@200.
p := HorizontalPanelView origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:v.
b1 := (ArrowButton upIn:p) extent:30@30.
b2 := (ArrowButton downIn:p) extent:30@30.
b3 := (ArrowButton leftIn:p) extent:30@30.
b4 := (ArrowButton rightIn:p) extent:30@30.
b1 action:['whatEver you like here ...'].
b2 action:['whatEver you like here ...'].
b3 action:['whatEver you like here ...'].
b4 action:['whatEver you like here ...'].
v open
[exEnd]
example3:
[exBegin]
|v p b1 b2 b3 b4|
v := StandardSystemView extent:200@200.
p := View origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:v.
b1 := (ArrowButton upIn:p) origin:(0.33 @ 0.0) corner:(0.67 @ 0.33).
b3 := (ArrowButton leftIn:p) origin:(0.0 @ 0.33) corner:(0.33 @ 0.67).
b4 := (ArrowButton rightIn:p) origin:(0.67 @ 0.33) corner:(1.0 @ 0.67).
b2 := (ArrowButton downIn:p) origin:(0.33 @ 0.67) corner:(0.67 @ 1.0).
b1 action:['whatEver you like here ...'].
b2 action:['whatEver you like here ...'].
b3 action:['whatEver you like here ...'].
b4 action:['whatEver you like here ...'].
v open
[exEnd]
example4 (not good coding style, to explicitely use a particular style,
just a demonstration how it looks ..):
[exBegin]
|v p b1 b2 b3 b4 oldStyle|
oldStyle := View defaultStyle.
View defaultStyle:#motif.
v := StandardSystemView extent:100@100.
p := View origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:v.
b1 := (ArrowButton upIn:p) origin:(0.33 @ 0.0) corner:(0.67 @ 0.33).
b3 := (ArrowButton leftIn:p) origin:(0.0 @ 0.33) corner:(0.33 @ 0.67).
b4 := (ArrowButton rightIn:p) origin:(0.67 @ 0.33) corner:(1.0 @ 0.67).
b2 := (ArrowButton downIn:p) origin:(0.33 @ 0.67) corner:(0.67 @ 1.0).
b1 action:['whatEver you like here ...'].
b2 action:['whatEver you like here ...'].
b3 action:['whatEver you like here ...'].
b4 action:['whatEver you like here ...'].
View defaultStyle:oldStyle.
v open
[exEnd]
"
! !
!ArrowButton class methodsFor:'instance creation'!
downIn:aView
"create and return a new down-button in aView"
^ (super in:aView) direction:#down
"Modified: 22.1.1997 / 11:59:08 / cg"
!
leftIn:aView
"create and return a new left-button in aView"
^ (super in:aView) direction:#left
"Modified: 22.1.1997 / 11:59:14 / cg"
!
new
"return a new arrowButton - direction defaults to #up"
^ super new direction:#up
!
rightIn:aView
"create and return a new right-button in aView"
^ (super in:aView) direction:#right
"Modified: 22.1.1997 / 11:59:21 / cg"
!
upIn:aView
"create and return a new up-button in aView"
^ (super in:aView) direction:#up
"Modified: 22.1.1997 / 11:59:27 / cg"
! !
!ArrowButton class methodsFor:'defaults'!
DownArrowForm
^DownArrowForm
!
LeftArrowForm
^LeftArrowForm
!
RightArrowForm
^RightArrowForm
!
UpArrowForm
^UpArrowForm
!
defaultDownArrowButtonForm
"return the default form used for the scrollDown Button
(if no styleSheet value is defined, and no form can be constructed)"
<resource: #image>
StyleSheet name == #win95 ifTrue:[
^ Form
width:11 height:11
fromArray:#[
2r00000000 2r00000000
2r00000000 2r00000000
2r00000000 2r00000000
2r00000000 2r00000000
2r00111111 2r10000000
2r00011111 2r00000000
2r00001110 2r00000000
2r00000100 2r00000000
2r00000000 2r00000000
2r00000000 2r00000000
2r00000000 2r00000000
]
].
^ 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]
"
self defaultDownArrowButtonForm
"
"Modified: / 26.3.1999 / 15:16:07 / cg"
!
defaultLeftArrowButtonForm
"return the default form used for the scrollLeft Button
(if no styleSheet value is defined, and no form can be constructed)"
<resource: #image>
StyleSheet name == #win95 ifTrue:[
^ Form
width:11 height:11
fromArray:#[
2r00000000 2r00000000
2r00000000 2r00000000
2r00000010 2r00000000
2r00000110 2r00000000
2r00001110 2r10000000
2r00011110 2r00000000
2r00001110 2r00000000
2r00000110 2r00000000
2r00000010 2r00000000
2r00000000 2r00000000
2r00000000 2r00000000
]
].
^ 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]
"
self defaultLeftArrowButtonForm
"
"Modified: / 26.3.1999 / 15:17:38 / cg"
!
defaultRightArrowButtonForm
"return the default form used for the scrollRight Button
(if no styleSheet value is defined, and no form can be constructed)"
<resource: #image>
StyleSheet name == #win95 ifTrue:[
^ Form
width:11 height:11
fromArray:#[
2r00000000 2r00000000
2r00000000 2r00000000
2r00001000 2r00000000
2r00001100 2r00000000
2r00001110 2r10000000
2r00001111 2r00000000
2r00001110 2r00000000
2r00001100 2r00000000
2r00001000 2r00000000
2r00000000 2r00000000
2r00000000 2r00000000
]
].
^ 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]
"
self defaultRightArrowButtonForm
"
"Modified: / 26.3.1999 / 15:18:29 / cg"
!
defaultUpArrowButtonForm
"return the default form used for the scrollUp Button
(if no styleSheet value is defined, and no form can be constructed)"
<resource: #image>
StyleSheet name == #win95 ifTrue:[
^ Form
width:11 height:11
fromArray:#[
2r00000000 2r00000000
2r00000000 2r00000000
2r00000000 2r00000000
2r00000100 2r00000000
2r00001110 2r00000000
2r00011111 2r00000000
2r00111111 2r10000000
2r00000000 2r00000000
2r00000000 2r00000000
2r00000000 2r00000000
2r00000000 2r00000000
]
].
^ 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]
"
self defaultUpArrowButtonForm
"
"Modified: / 26.3.1999 / 15:19:11 / cg"
!
downArrowButtonForm:styleSymbol on:aDevice
"return the form used for the scrollDown Button"
<resource: #style (#'arrowButton.downForm')>
|form|
"
use cached form, if device is appropriate
"
CachedStyle ~~ styleSymbol ifTrue:[
DownArrowForm := nil
].
((form := DownArrowForm) notNil and:[form device == aDevice]) ifTrue:[
^ form
].
form := DownArrowForm := StyleSheet at:#'arrowButton.downForm' default:nil.
form notNil ifTrue:[^ form].
"
special treatment for st80 arrows
- they do not really fit into the general (bitmap) scheme ...
(i.e. they are computed instead of drawn from a bitmap)
"
styleSymbol ~~ #st80 ifTrue:[
DownArrowFormFile notNil ifTrue:[
form := Image fromFile:DownArrowFormFile resolution:100 on:aDevice.
form isNil ifTrue:[
form := Image fromFile:('bitmaps/' , DownArrowFormFile) resolution:100 on:aDevice.
form isNil ifTrue:[
'ArrowButton [info]: no bitmapFile: ' infoPrint. DownArrowFormFile infoPrintCR.
]
]
]
].
"
form to use as a fallback, if no bitmap file is present
(actually not really needed - just to show something useful, in
case of a bad installation)
"
form isNil ifTrue:[
styleSymbol == #st80 ifTrue:[
form := Form width:9 height:9 depth:1 on:Display.
form isNil ifTrue:[^ nil].
form clear.
form lineWidth:2.
form capStyle:#round.
form paint:(Color colorId:1).
form displayLineFromX:0 y:2 toX:4 y:6.
form displayLineFromX:4 y:6 toX:8 y:2.
form beImmediateForm.
] ifFalse:[
form := self defaultDownArrowButtonForm onDevice:aDevice.
form isNil ifTrue:[^ nil].
].
].
"
remember form for next use
"
CachedStyle := styleSymbol.
DownArrowForm := form.
^ form
"Modified: / 26.10.1997 / 17:01:54 / cg"
!
leftArrowButtonForm:styleSymbol on:aDevice
"return the form used for the scrollLeft Button"
<resource: #style (#'arrowButton.leftForm')>
|form|
"
use cached form, if device is appropriate
"
CachedStyle ~~ styleSymbol ifTrue:[
LeftArrowForm := nil
].
((form := LeftArrowForm) notNil and:[form device == aDevice]) ifTrue:[
^ form
].
form := LeftArrowForm := StyleSheet at:#'arrowButton.leftForm' default:nil.
form notNil ifTrue:[^ form].
"
special treatment for st80 arrows
- they do not really fit into the general (bitmap) scheme ...
(i.e. they are computed instead of drawn from a bitmap)
"
styleSymbol ~~ #st80 ifTrue:[
LeftArrowFormFile notNil ifTrue:[
form := Image fromFile:LeftArrowFormFile resolution:100 on:aDevice.
form isNil ifTrue:[
form := Image fromFile:'bitmaps/' , LeftArrowFormFile resolution:100 on:aDevice.
form isNil ifTrue:[
'ArrowButton [info]: no bitmapFile: ' infoPrint. LeftArrowFormFile infoPrintCR.
]
]
]
].
"
form to use as a fallback, if no bitmap file is present
(actually not really needed - just to show something useful, in
case of a bad installation)
"
form isNil ifTrue:[
styleSymbol == #st80 ifTrue:[
form := Form width:9 height:9 depth:1 on:Display.
form isNil ifTrue:[^ nil].
form clear.
form lineWidth:2.
form capStyle:#round.
form paint:(Color colorId:1).
form displayLineFromX:6 y:0 toX:2 y:4.
form displayLineFromX:2 y:4 toX:6 y:8.
form beImmediateForm.
] ifFalse:[
form := self defaultLeftArrowButtonForm onDevice:aDevice.
form isNil ifTrue:[^ nil].
].
].
"
remember form for next use
"
CachedStyle := styleSymbol.
LeftArrowForm := form.
^ form
"Modified: / 26.10.1997 / 17:01:47 / cg"
!
rightArrowButtonForm:styleSymbol on:aDevice
"return the form used for the scrollRight Button"
<resource: #style (#'arrowButton.rightForm')>
|form|
"
use cached form, if device is appropriate
"
CachedStyle ~~ styleSymbol ifTrue:[
RightArrowForm := nil
].
((form := RightArrowForm) notNil and:[form device == aDevice]) ifTrue:[
^ form
].
form := RightArrowForm := StyleSheet at:#'arrowButton.rightForm' default:nil.
form notNil ifTrue:[^ form].
"
special treatment for st80 arrows
- they do not really fit into the general (bitmap) scheme ...
(i.e. they are computed instead of drawn from a bitmap)
"
styleSymbol ~~ #st80 ifTrue:[
RightArrowFormFile notNil ifTrue:[
form := Image fromFile:RightArrowFormFile resolution:100 on:aDevice.
form isNil ifTrue:[
form := Image fromFile:'bitmaps/' , RightArrowFormFile resolution:100 on:aDevice.
form isNil ifTrue:[
'ArrowButton [info]: no bitmapFile: ' infoPrint. RightArrowFormFile infoPrintCR.
]
]
]
].
"
form to use as a fallback, if no bitmap file is present
(actually not really needed - just to show something useful, in
case of a bad installation)
"
form isNil ifTrue:[
styleSymbol == #st80 ifTrue:[
form := Form width:9 height:9 depth:1 on:Display.
form isNil ifTrue:[^ nil].
form clear.
form lineWidth:2.
form capStyle:#round.
form paint:(Color colorId:1).
form displayLineFromX:2 y:0 toX:6 y:4.
form displayLineFromX:6 y:4 toX:2 y:8.
form beImmediateForm.
] ifFalse:[
form := self defaultRightArrowButtonForm onDevice:aDevice.
form isNil ifTrue:[^ nil].
].
].
"
remember form for next use
"
CachedStyle := styleSymbol.
RightArrowForm := form.
^ form
"Modified: / 26.10.1997 / 17:01:40 / cg"
!
upArrowButtonForm:styleSymbol on:aDevice
"return the form used for the scrollUp Button"
<resource: #style (#'arrowButton.upForm')>
|form|
"
use cached form, if device is appropriate
"
CachedStyle ~~ styleSymbol ifTrue:[
UpArrowForm := nil
].
((form := UpArrowForm) notNil and:[form device == aDevice]) ifTrue:[
^ form
].
form := UpArrowForm := StyleSheet at:#'arrowButton.upForm' default:nil.
form notNil ifTrue:[^ form].
"
special treatment for st80 arrows
- they do not really fit into the general (bitmap) scheme ...
(i.e. they are computed instead of drawn from a bitmap)
"
styleSymbol ~~ #st80 ifTrue:[
UpArrowFormFile notNil ifTrue:[
form := Image fromFile:UpArrowFormFile resolution:100 on:aDevice.
form isNil ifTrue:[
form := Image fromFile:'bitmaps/' , UpArrowFormFile resolution:100 on:aDevice.
form isNil ifTrue:[
'ArrowButton [info]: no bitmapFile: ' infoPrint. UpArrowFormFile infoPrintCR.
]
]
]
].
"
form to use as a fallback, if no bitmap file is present
(actually not really needed - just to show something useful, in
case of a bad installation)
"
form isNil ifTrue:[
styleSymbol == #st80 ifTrue:[
form := Form width:9 height:9 depth:1 on:aDevice.
form isNil ifTrue:[^ nil].
form clear.
form lineWidth:2.
form capStyle:#round.
form paint:(Color colorId:1).
form displayLineFromX:0 y:6 toX:4 y:2.
form displayLineFromX:4 y:2 toX:8 y:6.
form beImmediateForm.
] ifFalse:[
form := self defaultUpArrowButtonForm onDevice:aDevice.
form isNil ifTrue:[^ nil].
].
].
"
remember form for next use
"
CachedStyle := styleSymbol.
UpArrowForm := form.
^ form
"Modified: / 26.10.1997 / 17:01:32 / cg"
!
updateStyleCache
"extract values from the styleSheet and cache them in class variables"
<resource: #style (#'arrowButton.style'
#'arrowButton.activeLevel' #'arrowButton.passiveLevel'
#'arrowButton.backgroundColor' #'arrowButton.foregroundColor'
#'arrowButton.activeBackgroundColor' #'arrowButton.activeForegroundColor'
#'arrowButton.enteredBackgroundColor' #'arrowButton.enteredForegroundColor'
#'arrowButton.disabledForegroundColor'
#'arrowButton.downForm' #'arrowButton.upForm'
#'arrowButton.leftForm' #'arrowButton.rightForm'
#'arrowButton.downFormFile' #'arrowButton.upFormFile'
#'arrowButton.leftFormFile' #'arrowButton.rightFormFile')>
|styleSheet|
styleSheet := StyleSheet.
DefaultArrowStyle := styleSheet at:#'arrowButton.style' default:styleSheet name.
DefaultArrowStyle := DefaultArrowStyle asSymbol.
DefaultArrowButtonActiveLevel := styleSheet at:#'arrowButton.activeLevel' default:nil.
DefaultArrowButtonPassiveLevel := styleSheet at:#'arrowButton.passiveLevel' default:nil.
DefaultBackgroundColor := styleSheet colorAt:#'arrowButton.backgroundColor'.
DefaultForegroundColor := styleSheet colorAt:#'arrowButton.foregroundColor'.
DefaultActiveBackgroundColor := styleSheet colorAt:#'arrowButton.activeBackgroundColor'.
DefaultActiveForegroundColor := styleSheet colorAt:#'arrowButton.activeForegroundColor'.
DefaultEnteredBackgroundColor := styleSheet colorAt:#'arrowButton.enteredBackgroundColor'.
DefaultEnteredForegroundColor := styleSheet colorAt:#'arrowButton.enteredForegroundColor'.
DefaultDisabledForegroundColor := styleSheet colorAt:#'arrowButton.disabledForegroundColor'.
DownArrowForm := styleSheet at:#'arrowButton.downForm' default:nil.
UpArrowForm := styleSheet at:#'arrowButton.upForm' default:nil.
LeftArrowForm := styleSheet at:#'arrowButton.leftForm' default:nil.
RightArrowForm := styleSheet at:#'arrowButton.rightForm' default:nil.
UpArrowFormFile := DownArrowFormFile := LeftArrowFormFile := RightArrowFormFile := nil.
UpArrowForm isNil ifTrue:[
UpArrowFormFile := styleSheet at:#'arrowButton.upFormFile' default:'ScrollUp.xbm'.
].
DownArrowForm isNil ifTrue:[
DownArrowFormFile := styleSheet at:#'arrowButton.downFormFile' default:'ScrollDn.xbm'.
].
LeftArrowForm isNil ifTrue:[
LeftArrowFormFile := styleSheet at:#'arrowButton.leftFormFile' default:'ScrollLt.xbm'.
].
RightArrowForm isNil ifTrue:[
RightArrowFormFile := styleSheet at:#'arrowButton.rightFormFile' default:'ScrollRt.xbm'.
].
"
self updateStyleCache
"
"Modified: 31.8.1995 / 03:01:14 / claus"
"Modified: 20.10.1997 / 13:50:57 / cg"
! !
!ArrowButton methodsFor:'accessing'!
direction
"return the buttons direction - a symbol"
^ direction
!
direction:aDirectionSymbol
"create and return a new arrow button in aView"
|form|
aDirectionSymbol == #up ifTrue:[
form := (self class upArrowButtonForm:arrowStyle on:device).
].
aDirectionSymbol == #down ifTrue:[
form := (self class downArrowButtonForm:arrowStyle on:device).
].
aDirectionSymbol == #left ifTrue:[
form := (self class leftArrowButtonForm:arrowStyle on:device).
].
aDirectionSymbol == #right ifTrue:[
form := (self class rightArrowButtonForm:arrowStyle on:device).
].
direction := aDirectionSymbol.
self form:form
"Modified: 24.2.1997 / 21:19:59 / cg"
! !
!ArrowButton methodsFor:'accessing-look'!
allViewBackground:something
super viewBackground:something.
bgColor := activeBgColor := enteredBgColor := something
! !
!ArrowButton methodsFor:'focus handling'!
wantsFocusWithButtonPress
"no, do not catch the keyboard focus on button click"
^ false
! !
!ArrowButton methodsFor:'initialization'!
initStyle
"setup viewStyle specifics"
super initStyle.
DefaultBackgroundColor notNil ifTrue:[
bgColor := DefaultBackgroundColor onDevice:device
].
DefaultForegroundColor notNil ifTrue:[
fgColor := DefaultForegroundColor onDevice:device
].
DefaultActiveForegroundColor notNil ifTrue:[
activeFgColor := DefaultActiveForegroundColor onDevice:device
].
DefaultActiveBackgroundColor notNil ifTrue:[
activeBgColor := DefaultActiveBackgroundColor onDevice:device
].
DefaultEnteredForegroundColor notNil ifTrue:[
enteredFgColor := DefaultEnteredForegroundColor onDevice:device
].
DefaultEnteredBackgroundColor notNil ifTrue:[
enteredBgColor := DefaultEnteredBackgroundColor onDevice:device
].
DefaultDisabledForegroundColor notNil ifTrue:[
disabledFgColor := DefaultDisabledForegroundColor onDevice:device
].
arrowStyle := DefaultArrowStyle.
DefaultArrowButtonActiveLevel notNil ifTrue:[onLevel := DefaultArrowButtonActiveLevel].
DefaultArrowButtonPassiveLevel notNil ifTrue:[offLevel := DefaultArrowButtonPassiveLevel].
offLevel ~~ level ifTrue:[self level:offLevel].
"/ "
"/ special treatment for motif arrows
"/ - they do not really fit into the general (bitmap) scheme ...
"/ "
"/ arrowStyle == #motif ifTrue:[
"/ onLevel := 0.
"/ offLevel := 0.
"/ self level:0.
"/ ]
"Modified: 22.1.1997 / 11:57:00 / cg"
!
initialize
super initialize.
hSpace := vSpace := 0.
controller beTriggerOnDown.
"Modified: 6.3.1997 / 20:58:49 / cg"
! !
!ArrowButton methodsFor:'redrawing'!
drawWith:fg and:bg
"this is a q&d hack for motif ..."
|topLeft botRight isString orgX orgY r colors|
arrowStyle ~~ #motif ifTrue:[
^ super drawWith:fg and:bg.
].
"
the code below does a lot of bitmap drawing, but allows
to 3D-ify any logo (it draws it displaced by some pixels
to the upper left in one-color and displaced to the
lower right in the other color). It should be rewritten to
cache the result for later drawing operations.
"
logo notNil ifTrue:[
self paint:bg.
self fillRectangleX:0 y:0 width:width height:height.
shadowColor := shadowColor onDevice:device.
lightColor := lightColor onDevice:device.
controller pressed ifTrue:[
topLeft := shadowColor.
botRight := lightColor
] ifFalse:[
topLeft := lightColor.
botRight := shadowColor
].
isString := logo isString.
isString ifFalse:[
logo depth ~~ 1 ifTrue:[
"/ allow for deep logos (for motif)
"/ one catch: if the view background is a complex pixmap
"/ we cannot use this as colorMap entry.
"/ therefore, compute the average colors and take these
"/ (this looks ok for buttons ...)
r := (0@0 corner:10@10).
colors := (Array with:(bg averageColorIn:r)
with:(topLeft averageColorIn:r)
with:(botRight averageColorIn:r)
with:(fg averageColorIn:r)).
colors ~= logo colorMap ifTrue:[
logo release.
logo colorMap:colors.
].
logo photometric:#palette.
logo := logo on:device.
self displayForm:logo x:labelOriginX y:labelOriginY.
^ self
].
logo := logo onDevice:device.
orgX := labelOriginX.
orgY := labelOriginY.
] ifTrue:[
orgY := height - font height // 2 + font ascent.
orgX := width - labelOriginX // 4 - 1.
].
self paint:topLeft.
#(-1 0 -1) with:#(-1 -1 0) do:[:dX :dY |
|x y|
x := orgX + dX.
y := orgY + dY.
isString ifTrue:[
self displayString:logo x:x y:y.
] ifFalse:[
self displayForm:logo x:x y:y.
]
].
self paint:botRight.
#(1 1 0) with:#(0 1 1) do:[:dX :dY |
|x y|
x := orgX + dX.
y := orgY + dY.
isString ifTrue:[
self displayString:logo x:x y:y.
] ifFalse:[
self displayForm:logo x:x y:y.
]
].
"
finally, the form itself
"
self paint:fg.
isString ifTrue:[
self displayString:logo x:orgX y:orgY.
] ifFalse:[
self displayForm:logo x:orgX y:orgY.
]
]
"Modified: 31.8.1995 / 03:03:12 / claus"
"Modified: 19.3.1997 / 17:11:22 / cg"
! !
!ArrowButton class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libwidg/ArrowButton.st,v 1.55 1999-08-18 15:14:19 cg Exp $'
! !