links to this page:    
View this PageEdit this PageUploads to this PageHistory of this PageTop of the SwikiRecent ChangesSearch the SwikiHelp Guide
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:

	" 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)
			[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

	^ (TextStyle named: 'NewYork') fontOfSize: 15.! !

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

	| morph |
	morph _ self xBox.
	" hide the two X s "
	morph submorphs do: [ :m | m hide. ].

	| 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)
			[oldColor ifNotNil: [self color: (oldColor mixed: 1/2 with: Color gray).
					self xBox borderColor: #inset].
			(actWhen == #whilePressed and: [evt anyButtonPressed])
					[self doButtonAction.
					evt hand noteSignificantEvent: evt]]
			[oldColor ifNotNil: [self color: oldColor].
			self xBox borderColor: #raised]

mouseUp: evt
			["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)
					[selected _ selected not.
						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].

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

	self label: 'Check Box'.

Jim Benson