[ENH] Grow Box

Stephen T. Pope stp at create.ucsb.edu
Thu Feb 1 02:24:13 UTC 2001


This is the grow box code again. 

'This adds another button just to the left of the collapse button in
window labels that grows/shrinks the view by 50%.'!

SystemWindow addInstVarName: 'growBox ' !

!SystemWindow methodsFor: 'initialization' stamp: 'stp 08/28/1999 10:57'!
initialize
	| aFont |
	super initialize.
	allowReframeHandles := true.
	labelString ifNil: [labelString _ 'Untitled Window'].
	isCollapsed _ false.
	activeOnlyOnTop _ true.
	paneMorphs _ Array new.
	paneRects _ Array new.
	borderColor _ #raised.
	borderWidth _ 1.
	color _ Color black.
	aFont _ Preferences standardButtonFont.
	stripes _ Array with: (RectangleMorph newBounds: bounds)  "see extent:"
				with: (RectangleMorph newBounds: bounds).
	self addMorph: (stripes first borderWidth: 1).
	self addMorph: (stripes second borderWidth: 2).
	self addMorph: (label _ StringMorph new contents: labelString;
			font: Preferences windowTitleFont emphasis: 1).
	self setLabelWidgetAllowance.
	self addCloseBox.
	self addMenuControl.
	self addMorph: (collapseBox _ SimpleButtonMorph new borderWidth: 0;
			label: 'O' font: aFont; color: Color transparent;
			actionSelector: #collapseOrExpand; target: self; extent: 16 at 16).
	self addMorph: (growBox _ SimpleButtonMorph new borderWidth: 0;
			label: '^' font: aFont; color: Color transparent;
			actionSelector: #growOrShrink; target: self; extent: 16 at 16).
	Preferences noviceMode ifTrue:
		[closeBox ifNotNil: [closeBox setBalloonText: 'close window'].
		menuBox ifNotNil: [menuBox setBalloonText: 'window menu'].
		collapseBox ifNotNil: [collapseBox setBalloonText: 'collapse/expand window']].
	self on: #mouseEnter send: #spawnReframeHandle: to: self.
	self on: #mouseLeave send: #spawnReframeHandle: to: self.
	label on: #mouseDown send: #relabelEvent: to: self.
	self extent: 300 at 200.
	mustNotClose _ false.
	updatablePanes _ Array new.! !

!SystemWindow methodsFor: 'geometry' stamp: 'stp 09/02/1999 09:49'!
extent: newExtent
	| inner labelRect |
	isCollapsed
		ifTrue: [super extent: newExtent x @ (self labelHeight + 2)]
		ifFalse: [super extent: newExtent].
	inner _ self innerBounds.
	labelRect _ self labelRect.

	stripes first bounds: (labelRect insetBy: 1).
	stripes second bounds: (labelRect insetBy: 3).
	self setStripeColorsFrom: self paneColorToUse.
	closeBox ifNotNil:
		[closeBox align: closeBox topLeft with: inner topLeft + (4 at 0)].
	menuBox ifNotNil:
		[menuBox align: menuBox topLeft with: (inner topLeft + (19 at 1))].
	collapseBox align: collapseBox topRight with: inner topRight - (4 at 0).
	growBox ifNotNil:
		[growBox align: growBox topRight with: collapseBox topLeft].
	label fitContents; setWidth: (label width min: bounds width - self labelWidgetAllowance).
	label align: label bounds topCenter with: inner topCenter.
		isCollapsed
		ifTrue: [collapsedFrame _ self bounds]
		ifFalse: [self setBoundsOfPaneMorphs. fullFrame _ self bounds]! !

!SystemWindow methodsFor: 'resize/collapse' stamp: 'stp 08/28/1999 11:34'!
growOrShrink
	"Expand (or shrink if shiftDown) the view by 50% in the X and 100% in
the Y, clipping to the screen size and centering it.
	The minimum size is 120 at 120."

	| oldSize newSize |
	oldSize := self bounds.
	newSize := Sensor leftShiftDown
		ifTrue: [(oldSize scaleBy: 0.66 at 0.5) truncated]
		ifFalse: [(oldSize scaleBy: 1.5 at 2.0) truncated].
	newSize extent < (120 at 120)
		ifTrue: [^self].
	newSize := newSize translateBy: (newSize center - oldSize center) negated.
	newSize := newSize intersect: Display boundingBox.
	super bounds: newSize.
	paneMorphs reverseDo: [:m | self addMorph: m]! !


-- 

stp
  Stephen Travis Pope
  http://www.create.ucsb.edu/~stp





More information about the Squeak-dev mailing list