Check Box Code
Last updated at 1:04 pm UTC on 16 January 2006
"Copyright Jim Benson 2000"
SimpleButtonMorph subclass: #CheckBoxMorph
instanceVariableNames: 'selected '
classVariableNames: ''
poolDictionaries: ''
category: 'Morphic Documentation example'
These are all instance methods:
label
" Return the labels string "
| s |
s _ ''.
self submorphsDo: [:m | (m isKindOf: StringMorph) ifTrue: [s _ m contents]].
^ s
label: aString
| oldLabel m |
(oldLabel _ self findA: StringMorph)
ifNotNil:
[oldLabel delete.
" Set extent to only include check box so that we get updated correctly "
self extent: 18 @ 18.
self world displayWorld].
" make sure we set the font"
m _ StringMorph
contents: aString
font: self standardControlFont
emphasis: 1.
" Leave a little extra at the bottom for better spacing when
trying to align multiple checkboxes"
self extent: m extent + (borderWidth + 24 @ 6).
"The label is placed at a fixed offset of 24 pixels from the left
edge "
m position: 24 @ 0 + self innerBounds topLeft.
self addMorph: m.
m lock.
self changed
standardControlFont
^ (TextStyle named: 'NewYork') fontOfSize: 15.! !
xBox
" return the xBox morph "
^ self findA: RectangleMorph.
areasRemainingToFill: aRectangle
^ aRectangle areasOutside: (self xBox bounds expandBy: 1@1).
drawOn: aCanvas
aCanvas frameRectangle: (self xBox bounds expandBy: 1@1)
color: Color black.
hideX
| morph |
morph _ self xBox.
" hide the two X s "
morph submorphs do: [ :m | m hide. ].
showX
| morph |
morph _ self xBox.
" make the Xs visible "
morph submorphs do: [ :m | m show. ].
mouseDown: evt
oldColor _ self xBox color.
actWhen == #buttonDown
ifTrue: [self doButtonAction].
mouseMove: evt
actWhen == #buttonDown ifTrue: [^ self].
(self containsPoint: evt cursorPoint)
ifTrue:
[oldColor ifNotNil: [self color: (oldColor mixed: 1/2 with: Color gray).
self xBox borderColor: #inset].
(actWhen == #whilePressed and: [evt anyButtonPressed])
ifTrue:
[self doButtonAction.
evt hand noteSignificantEvent: evt]]
ifFalse:
[oldColor ifNotNil: [self color: oldColor].
self xBox borderColor: #raised]
mouseUp: evt
oldColor
ifNotNil:
["if oldColor nil, it signals that mouse had not gone DOWN
inside me, e.g. because of a cmd-drag; in this case we
want to avoid triggering the action!!"
self color: oldColor.
oldColor _ nil.
self xBox borderColor: #raised.
(self containsPoint: evt cursorPoint)
ifTrue:
[selected _ selected not.
selected
ifTrue: [self showX]
ifFalse: [self hideX]].
arguments at: 1 put: selected.
(actWhen == #buttonUp and: [self containsPoint: evt cursorPoint])
ifTrue: [self doButtonAction].]
color: aColor
" This is really supplied to set the color of the checkbox "
super color: aColor.
" set the color of the check box "
self xBox color: aColor.
extent: aPoint
bounds extent = aPoint ifFalse: [
self changed.
bounds _ bounds topLeft extent: aPoint.
self layoutChanged.
self changed].
initialize
| rect x |
submorphs _ EmptyArray.
bounds _ 0@0 corner: 10@10.
self borderWidth: 0.
target _ nil.
actionSelector _ #check:.
arguments _ Array new: 1.
actWhen _ #buttonUp.
" Prepare the X box ; set position at upper left hand corner "
rect _ RectangleMorph new extent: 16 @ 16.
rect position: 1 @ 1 .
rect borderWidth: 2.
rect borderColor: #raised.
self addMorph: rect.
rect lock.
" Add the background X "
x _ StringMorph contents: 'X' font: Preferences standardButtonFont.
x position: 5 @ 1.
x color: Color white.
rect addMorph: x.
x lock.
x hide.
" Add the foreground X "
x _ StringMorph contents: 'X' font: Preferences standardButtonFont.
x position: 4 @ 0.
rect addMorph: x.
x lock.
x hide.
selected _ false.
" The color of the checkbox is a light gray "
self color: Color veryLightGray lighter.
self setDefaultLabel.
setDefaultLabel
self label: 'Check Box'.
Jim Benson
jb@speed.net