hg/stx-libwidg: ArrowButton.st@8f395aba0173 (annotated)

1 3ebee08bea15 Initial revision claus parents: diff changeset	1	"
3ebee08bea15 Initial revision claus parents: diff changeset	2	COPYRIGHT (c) 1993 by Claus Gittinger
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	3	All Rights Reserved
1 3ebee08bea15 Initial revision claus parents: diff changeset	4
3ebee08bea15 Initial revision claus parents: diff changeset	5	This software is furnished under a license and may be used
3ebee08bea15 Initial revision claus parents: diff changeset	6	only in accordance with the terms of that license and with the
3ebee08bea15 Initial revision claus parents: diff changeset	7	inclusion of the above copyright notice. This software may not
3ebee08bea15 Initial revision claus parents: diff changeset	8	be provided or otherwise made available to, or used by, any
3ebee08bea15 Initial revision claus parents: diff changeset	9	other person. No title to or ownership of the software is
3ebee08bea15 Initial revision claus parents: diff changeset	10	hereby transferred.
3ebee08bea15 Initial revision claus parents: diff changeset	11	"
3ebee08bea15 Initial revision claus parents: diff changeset	12
3ebee08bea15 Initial revision claus parents: diff changeset	13	Button subclass:#ArrowButton
440 2beb33cb0146 added style resource directive Claus Gittinger <cg@exept.de> parents: 270 diff changeset	14	instanceVariableNames:'arrowStyle'
2beb33cb0146 added style resource directive Claus Gittinger <cg@exept.de> parents: 270 diff changeset	15	classVariableNames:'DownArrowForm UpArrowForm LeftArrowForm RightArrowForm
2beb33cb0146 added style resource directive Claus Gittinger <cg@exept.de> parents: 270 diff changeset	16	CachedStyle DefaultArrowStyle DefaultBackgroundColor
2beb33cb0146 added style resource directive Claus Gittinger <cg@exept.de> parents: 270 diff changeset	17	DefaultForegroundColor DefaultActiveBackgroundColor
2beb33cb0146 added style resource directive Claus Gittinger <cg@exept.de> parents: 270 diff changeset	18	DefaultActiveForegroundColor DefaultEnteredBackgroundColor
2beb33cb0146 added style resource directive Claus Gittinger <cg@exept.de> parents: 270 diff changeset	19	DefaultEnteredForegroundColor DefaultDisabledForegroundColor
2beb33cb0146 added style resource directive Claus Gittinger <cg@exept.de> parents: 270 diff changeset	20	DefaultArrowButtonActiveLevel DefaultArrowButtonPassiveLevel
2beb33cb0146 added style resource directive Claus Gittinger <cg@exept.de> parents: 270 diff changeset	21	DownArrowFormFile UpArrowFormFile LeftArrowFormFile
2beb33cb0146 added style resource directive Claus Gittinger <cg@exept.de> parents: 270 diff changeset	22	RightArrowFormFile'
2beb33cb0146 added style resource directive Claus Gittinger <cg@exept.de> parents: 270 diff changeset	23	poolDictionaries:''
2beb33cb0146 added style resource directive Claus Gittinger <cg@exept.de> parents: 270 diff changeset	24	category:'Views-Interactors'
1 3ebee08bea15 Initial revision claus parents: diff changeset	25	!
3ebee08bea15 Initial revision claus parents: diff changeset	26
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	27	!ArrowButton class methodsFor:'documentation'!
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	28
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	29	copyright
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	30	"
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	31	COPYRIGHT (c) 1993 by Claus Gittinger
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	32	All Rights Reserved
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	33
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	34	This software is furnished under a license and may be used
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	35	only in accordance with the terms of that license and with the
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	36	inclusion of the above copyright notice. This software may not
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	37	be provided or otherwise made available to, or used by, any
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	38	other person. No title to or ownership of the software is
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	39	hereby transferred.
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	40	"
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	41	!
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	42
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	43	documentation
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	44	"
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	45	ArrowButtons display an arrow as their label; they are mainly
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	46	used for scrollbars, but can be useful on their own in some applications.
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	47	Beside the contents, their default behavior is to perform their action
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	48	when pressed - not (as is the default for normal buttons) when released.
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	49
65 b33e4f3a264e * empty log message * claus parents: 62 diff changeset	50	Indivdual ArrowButtons can be created by sending one of:
580 a31ba5bcc4c0 commentary Claus Gittinger <cg@exept.de> parents: 440 diff changeset	51	ArrowButton upIn:aView /downIn: / leftIn: or rightIn:
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	52	passing the parent view as argument.
65 b33e4f3a264e * empty log message * claus parents: 62 diff changeset	53
130 338e856bddc9 . claus parents: 128 diff changeset	54	See examples.
338e856bddc9 . claus parents: 128 diff changeset	55
580 a31ba5bcc4c0 commentary Claus Gittinger <cg@exept.de> parents: 440 diff changeset	56
a31ba5bcc4c0 commentary Claus Gittinger <cg@exept.de> parents: 440 diff changeset	57	[styleSheet parameters:]
a31ba5bcc4c0 commentary Claus Gittinger <cg@exept.de> parents: 440 diff changeset	58
a31ba5bcc4c0 commentary Claus Gittinger <cg@exept.de> parents: 440 diff changeset	59	arrowButtonStyle <Symbol> the style of the button;
a31ba5bcc4c0 commentary Claus Gittinger <cg@exept.de> parents: 440 diff changeset	60	#motif, #st80 or nil (default)
a31ba5bcc4c0 commentary Claus Gittinger <cg@exept.de> parents: 440 diff changeset	61	arrowButtonForegroundColor <nil \| Color> foregroundColor
a31ba5bcc4c0 commentary Claus Gittinger <cg@exept.de> parents: 440 diff changeset	62	arrowButtonBackgroundColor <nil \| Color> backgroundColor
a31ba5bcc4c0 commentary Claus Gittinger <cg@exept.de> parents: 440 diff changeset	63
a31ba5bcc4c0 commentary Claus Gittinger <cg@exept.de> parents: 440 diff changeset	64	arrowButtonActiveForegroundColor foregroundColor when pressed
a31ba5bcc4c0 commentary Claus Gittinger <cg@exept.de> parents: 440 diff changeset	65	arrowButtonActiveBackgroundColor backgroundColor when pressed
a31ba5bcc4c0 commentary Claus Gittinger <cg@exept.de> parents: 440 diff changeset	66
a31ba5bcc4c0 commentary Claus Gittinger <cg@exept.de> parents: 440 diff changeset	67	arrowButtonEnteredForegroundColor foregroundColor when mouse pointer entered
a31ba5bcc4c0 commentary Claus Gittinger <cg@exept.de> parents: 440 diff changeset	68	arrowButtonEnteredBackgroundColor backgroundColor when mouse pointer entered
a31ba5bcc4c0 commentary Claus Gittinger <cg@exept.de> parents: 440 diff changeset	69
585 8f395aba0173 documentation Claus Gittinger <cg@exept.de> parents: 580 diff changeset	70	[author:]
8f395aba0173 documentation Claus Gittinger <cg@exept.de> parents: 580 diff changeset	71	Claus Gittinger
8f395aba0173 documentation Claus Gittinger <cg@exept.de> parents: 580 diff changeset	72
580 a31ba5bcc4c0 commentary Claus Gittinger <cg@exept.de> parents: 440 diff changeset	73	[See also:]
a31ba5bcc4c0 commentary Claus Gittinger <cg@exept.de> parents: 440 diff changeset	74	Button Toggle CheckToggle CheckBox
a31ba5bcc4c0 commentary Claus Gittinger <cg@exept.de> parents: 440 diff changeset	75	ScrollBar
130 338e856bddc9 . claus parents: 128 diff changeset	76
62 7cc1e330da47 * empty log message * claus parents: 60 diff changeset	77	"
7cc1e330da47 * empty log message * claus parents: 60 diff changeset	78	!
1 3ebee08bea15 Initial revision claus parents: diff changeset	79
62 7cc1e330da47 * empty log message * claus parents: 60 diff changeset	80	examples
7cc1e330da47 * empty log message * claus parents: 60 diff changeset	81	"
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	82	example1:
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	83
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	84	\|v p b1 b2 b3 b4\|
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	85
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	86	v := StandardSystemView extent:200@200.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	87	p := HorizontalPanelView origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:v.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	88	b1 := ArrowButton upIn:p.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	89	b2 := ArrowButton downIn:p.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	90	b3 := ArrowButton leftIn:p.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	91	b4 := ArrowButton rightIn:p.
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	92
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	93	b1 action:['whatEver you like here ...'].
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	94	b2 action:['whatEver you like here ...'].
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	95	b3 action:['whatEver you like here ...'].
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	96	b4 action:['whatEver you like here ...'].
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	97
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	98	v open
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	99
1 3ebee08bea15 Initial revision claus parents: diff changeset	100
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	101	example2:
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	102
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	103	\|v p b1 b2 b3 b4\|
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	104
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	105	v := StandardSystemView extent:200@200.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	106	p := HorizontalPanelView origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:v.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	107	b1 := (ArrowButton upIn:p) extent:30@30.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	108	b2 := (ArrowButton downIn:p) extent:30@30.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	109	b3 := (ArrowButton leftIn:p) extent:30@30.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	110	b4 := (ArrowButton rightIn:p) extent:30@30.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	111
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	112	b1 action:['whatEver you like here ...'].
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	113	b2 action:['whatEver you like here ...'].
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	114	b3 action:['whatEver you like here ...'].
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	115	b4 action:['whatEver you like here ...'].
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	116
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	117	v open
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	118
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	119	example3:
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	120
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	121	\|v p b1 b2 b3 b4\|
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	122
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	123	v := StandardSystemView extent:200@200.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	124	p := View origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:v.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	125	b1 := (ArrowButton upIn:p) origin:(0.33 @ 0.0) corner:(0.67 @ 0.33).
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	126	b3 := (ArrowButton leftIn:p) origin:(0.0 @ 0.33) corner:(0.33 @ 0.67).
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	127	b4 := (ArrowButton rightIn:p) origin:(0.67 @ 0.33) corner:(1.0 @ 0.67).
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	128	b2 := (ArrowButton downIn:p) origin:(0.33 @ 0.67) corner:(0.67 @ 1.0).
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	129
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	130	b1 action:['whatEver you like here ...'].
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	131	b2 action:['whatEver you like here ...'].
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	132	b3 action:['whatEver you like here ...'].
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	133	b4 action:['whatEver you like here ...'].
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	134
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	135	v open
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	136
65 b33e4f3a264e * empty log message * claus parents: 62 diff changeset	137	example4 (not good coding style, to explicitely use a particular style,
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	138	just a demonstration how it looks ..):
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	139
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	140	\|v p b1 b2 b3 b4 oldStyle\|
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	141
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	142	oldStyle := View defaultStyle.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	143	View defaultStyle:#motif.
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	144
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	145	v := StandardSystemView extent:100@100.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	146	p := View origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:v.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	147
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	148	b1 := (ArrowButton upIn:p) origin:(0.33 @ 0.0) corner:(0.67 @ 0.33).
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	149	b3 := (ArrowButton leftIn:p) origin:(0.0 @ 0.33) corner:(0.33 @ 0.67).
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	150	b4 := (ArrowButton rightIn:p) origin:(0.67 @ 0.33) corner:(1.0 @ 0.67).
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	151	b2 := (ArrowButton downIn:p) origin:(0.33 @ 0.67) corner:(0.67 @ 1.0).
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	152
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	153	b1 action:['whatEver you like here ...'].
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	154	b2 action:['whatEver you like here ...'].
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	155	b3 action:['whatEver you like here ...'].
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	156	b4 action:['whatEver you like here ...'].
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	157
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	158	View defaultStyle:oldStyle.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	159	v open
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	160	"
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	161	! !
1 3ebee08bea15 Initial revision claus parents: diff changeset	162
205 6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	163	!ArrowButton class methodsFor:'instance creation'!
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	164
205 6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	165	downIn:aView
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	166	^ (super in:aView) direction:#down
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	167	!
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	168
205 6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	169	leftIn:aView
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	170	^ (super in:aView) direction:#left
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	171	!
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	172
205 6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	173	rightIn:aView
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	174	^ (super in:aView) direction:#right
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	175	!
6 fd1b68b48422 * empty log message * claus parents: 1 diff changeset	176
205 6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	177	upIn:aView
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	178	^ (super in:aView) direction:#up
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	179	! !
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	180
205 6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	181	!ArrowButton class methodsFor:'defaults'!
1 3ebee08bea15 Initial revision claus parents: diff changeset	182
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	183	downArrowButtonForm:style on:aDevice
1 3ebee08bea15 Initial revision claus parents: diff changeset	184	"retun the form used for the scrollDown Button"
3ebee08bea15 Initial revision claus parents: diff changeset	185
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	186	\|form\|
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	187
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	188	"
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	189	use cached form, if device is appropriate
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	190	"
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	191	CachedStyle ~~ style ifTrue:[
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	192	UpArrowForm := DownArrowForm := LeftArrowForm := RightArrowForm := nil
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	193	].
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	194
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	195	((aDevice == Display) and:[DownArrowForm notNil]) ifTrue:[
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	196	^ DownArrowForm
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	197	].
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	198
154 054838fe6c84 . claus parents: 153 diff changeset	199	DownArrowForm := StyleSheet at:'arrowButtonDownForm' default:nil.
054838fe6c84 . claus parents: 153 diff changeset	200	DownArrowForm notNil ifTrue:[
054838fe6c84 . claus parents: 153 diff changeset	201	^ DownArrowForm
054838fe6c84 . claus parents: 153 diff changeset	202	].
054838fe6c84 . claus parents: 153 diff changeset	203
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	204	"
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	205	special treatment for st80 arrows
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	206	- they do not really fit into the general (bitmap) scheme ...
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	207	(i.e. they are computed instead of drawn from a bitmap)
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	208	"
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	209	style ~~ #st80 ifTrue:[
130 338e856bddc9 . claus parents: 128 diff changeset	210	DownArrowFormFile notNil ifTrue:[
338e856bddc9 . claus parents: 128 diff changeset	211	form := Form fromFile:DownArrowFormFile resolution:100 on:aDevice.
338e856bddc9 . claus parents: 128 diff changeset	212	form isNil ifTrue:[
338e856bddc9 . claus parents: 128 diff changeset	213	'ARRBUTTON: no bitmapFile: ' infoPrint. DownArrowFormFile infoPrintNL.
338e856bddc9 . claus parents: 128 diff changeset	214	]
338e856bddc9 . claus parents: 128 diff changeset	215	]
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	216	].
6 fd1b68b48422 * empty log message * claus parents: 1 diff changeset	217
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	218	"
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	219	form to use as a fallback, if no bitmap file is present
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	220	(actually not really needed - just to show something useful, in
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	221	case of a bad installation)
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	222	"
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	223	form isNil ifTrue:[
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	224	style == #st80 ifTrue:[
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	225	form := Form width:9 height:9 depth:1 on:Display.
270 aa6a36e199e7 be tolerant in case form creation fails Claus Gittinger <cg@exept.de> parents: 205 diff changeset	226	form isNil ifTrue:[^ nil].
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	227	form clear.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	228	form lineWidth:2.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	229	form capStyle:#round.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	230	form paint:(Color colorId:1).
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	231	form displayLineFromX:0 y:2 toX:4 y:6.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	232	form displayLineFromX:4 y:6 toX:8 y:2
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	233	] ifFalse:[
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	234	form := Form width:16 height:16
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	235	fromArray:#[2r00000000 2r00000000
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	236	2r00001111 2r11110000
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	237	2r00001000 2r00010000
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	238	2r00001000 2r00010000
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	239	2r00001000 2r00010000
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	240	2r00001000 2r00010000
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	241	2r00001000 2r00010000
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	242	2r01111000 2r00011110
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	243	2r01000000 2r00000010
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	244	2r00100000 2r00000100
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	245	2r00010000 2r00001000
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	246	2r00001000 2r00010000
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	247	2r00000100 2r00100000
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	248	2r00000010 2r01000000
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	249	2r00000001 2r10000000
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	250	2r00000000 2r00000000]
270 aa6a36e199e7 be tolerant in case form creation fails Claus Gittinger <cg@exept.de> parents: 205 diff changeset	251	on:aDevice.
aa6a36e199e7 be tolerant in case form creation fails Claus Gittinger <cg@exept.de> parents: 205 diff changeset	252	form isNil ifTrue:[^ nil].
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	253	].
1 3ebee08bea15 Initial revision claus parents: diff changeset	254	].
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	255	form := form on:aDevice.
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	256
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	257	"
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	258	remember form for next use
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	259	"
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	260	(aDevice == Display) ifTrue:[
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	261	CachedStyle := style.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	262	DownArrowForm := form
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	263	].
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	264
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	265	^ form
1 3ebee08bea15 Initial revision claus parents: diff changeset	266	!
3ebee08bea15 Initial revision claus parents: diff changeset	267
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	268	leftArrowButtonForm:style on:aDevice
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	269	"retun the form used for the scrollLeft Button"
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	270
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	271	\|form\|
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	272
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	273	"
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	274	use cached form, if device is appropriate
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	275	"
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	276	CachedStyle ~~ style ifTrue:[
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	277	UpArrowForm := DownArrowForm := LeftArrowForm := RightArrowForm := nil
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	278	].
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	279
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	280	((aDevice == Display) and:[LeftArrowForm notNil]) ifTrue:[
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	281	^ LeftArrowForm
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	282	].
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	283
154 054838fe6c84 . claus parents: 153 diff changeset	284	LeftArrowForm := StyleSheet at:'arrowButtonLeftForm' default:nil.
054838fe6c84 . claus parents: 153 diff changeset	285	LeftArrowForm notNil ifTrue:[
054838fe6c84 . claus parents: 153 diff changeset	286	^ LeftArrowForm
054838fe6c84 . claus parents: 153 diff changeset	287	].
054838fe6c84 . claus parents: 153 diff changeset	288
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	289	"
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	290	special treatment for st80 arrows
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	291	- they do not really fit into the general (bitmap) scheme ...
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	292	(i.e. they are computed instead of drawn from a bitmap)
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	293	"
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	294	style ~~ #st80 ifTrue:[
130 338e856bddc9 . claus parents: 128 diff changeset	295	LeftArrowFormFile notNil ifTrue:[
338e856bddc9 . claus parents: 128 diff changeset	296	form := Form fromFile:LeftArrowFormFile resolution:100 on:aDevice.
338e856bddc9 . claus parents: 128 diff changeset	297	form isNil ifTrue:[
338e856bddc9 . claus parents: 128 diff changeset	298	'ARRBUTTON: no bitmapFile: ' infoPrint. LeftArrowFormFile infoPrintNL.
338e856bddc9 . claus parents: 128 diff changeset	299	]
338e856bddc9 . claus parents: 128 diff changeset	300	]
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	301	].
6 fd1b68b48422 * empty log message * claus parents: 1 diff changeset	302
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	303	"
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	304	form to use as a fallback, if no bitmap file is present
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	305	(actually not really needed - just to show something useful, in
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	306	case of a bad installation)
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	307	"
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	308	form isNil ifTrue:[
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	309	style == #st80 ifTrue:[
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	310	form := Form width:9 height:9 depth:1 on:Display.
270 aa6a36e199e7 be tolerant in case form creation fails Claus Gittinger <cg@exept.de> parents: 205 diff changeset	311	form isNil ifTrue:[^ nil].
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	312	form clear.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	313	form lineWidth:2.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	314	form capStyle:#round.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	315	form paint:(Color colorId:1).
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	316	form displayLineFromX:6 y:0 toX:2 y:4.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	317	form displayLineFromX:2 y:4 toX:6 y:8.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	318	] ifFalse:[
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	319	form := Form width:16 height:16
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	320	fromArray:#[2r00000000 2r00000000
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	321	2r00000001 2r10000000
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	322	2r00000010 2r10000000
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	323	2r00000100 2r10000000
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	324	2r00001000 2r11111110
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	325	2r00010000 2r00000010
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	326	2r00100000 2r00000010
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	327	2r01000000 2r00000010
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	328	2r01000000 2r00000010
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	329	2r00100000 2r00000010
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	330	2r00010000 2r00000010
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	331	2r00001000 2r11111110
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	332	2r00000100 2r10000000
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	333	2r00000010 2r10000000
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	334	2r00000001 2r10000000
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	335	2r00000000 2r00000000]
270 aa6a36e199e7 be tolerant in case form creation fails Claus Gittinger <cg@exept.de> parents: 205 diff changeset	336	on:aDevice.
aa6a36e199e7 be tolerant in case form creation fails Claus Gittinger <cg@exept.de> parents: 205 diff changeset	337	form isNil ifTrue:[^ nil].
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	338	].
1 3ebee08bea15 Initial revision claus parents: diff changeset	339	].
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	340	form := form on:aDevice.
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	341
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	342	"
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	343	remember form for next use
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	344	"
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	345	(aDevice == Display) ifTrue:[
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	346	CachedStyle := style.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	347	LeftArrowForm := form
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	348	].
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	349
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	350	^ form
1 3ebee08bea15 Initial revision claus parents: diff changeset	351	!
3ebee08bea15 Initial revision claus parents: diff changeset	352
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	353	rightArrowButtonForm:style on:aDevice
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	354	"retun the form used for the scrollRight Button"
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	355
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	356	\|form\|
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	357
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	358	"
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	359	use cached form, if device is appropriate
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	360	"
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	361	CachedStyle ~~ style ifTrue:[
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	362	UpArrowForm := DownArrowForm := LeftArrowForm := RightArrowForm := nil
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	363	].
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	364
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	365	((aDevice == Display) and:[RightArrowForm notNil]) ifTrue:[
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	366	^ RightArrowForm
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	367	].
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	368
154 054838fe6c84 . claus parents: 153 diff changeset	369	RightArrowForm := StyleSheet at:'arrowButtonRightForm' default:nil.
054838fe6c84 . claus parents: 153 diff changeset	370	RightArrowForm notNil ifTrue:[
054838fe6c84 . claus parents: 153 diff changeset	371	^ RightArrowForm
054838fe6c84 . claus parents: 153 diff changeset	372	].
054838fe6c84 . claus parents: 153 diff changeset	373
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	374	"
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	375	special treatment for st80 arrows
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	376	- they do not really fit into the general (bitmap) scheme ...
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	377	(i.e. they are computed instead of drawn from a bitmap)
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	378	"
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	379	style ~~ #st80 ifTrue:[
130 338e856bddc9 . claus parents: 128 diff changeset	380	RightArrowFormFile notNil ifTrue:[
338e856bddc9 . claus parents: 128 diff changeset	381	form := Form fromFile:RightArrowFormFile resolution:100 on:aDevice.
338e856bddc9 . claus parents: 128 diff changeset	382	form isNil ifTrue:[
338e856bddc9 . claus parents: 128 diff changeset	383	'ARRBUTTON: no bitmapFile: ' infoPrint. RightArrowFormFile infoPrintNL.
338e856bddc9 . claus parents: 128 diff changeset	384	]
338e856bddc9 . claus parents: 128 diff changeset	385	]
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	386	].
6 fd1b68b48422 * empty log message * claus parents: 1 diff changeset	387
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	388	"
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	389	form to use as a fallback, if no bitmap file is present
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	390	(actually not really needed - just to show something useful, in
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	391	case of a bad installation)
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	392	"
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	393	form isNil ifTrue:[
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	394	style == #st80 ifTrue:[
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	395	form := Form width:9 height:9 depth:1 on:Display.
270 aa6a36e199e7 be tolerant in case form creation fails Claus Gittinger <cg@exept.de> parents: 205 diff changeset	396	form isNil ifTrue:[^ nil].
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	397	form clear.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	398	form lineWidth:2.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	399	form capStyle:#round.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	400	form paint:(Color colorId:1).
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	401	form displayLineFromX:2 y:0 toX:6 y:4.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	402	form displayLineFromX:6 y:4 toX:2 y:8
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	403	] ifFalse:[
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	404	form := Form width:16 height:16
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	405	fromArray:#[2r00000000 2r00000000
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	406	2r00000001 2r10000000
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	407	2r00000001 2r01000000
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	408	2r00000001 2r00100000
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	409	2r01111111 2r00010000
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	410	2r01000000 2r00001000
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	411	2r01000000 2r00000100
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	412	2r01000000 2r00000010
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	413	2r01000000 2r00000010
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	414	2r01000000 2r00000100
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	415	2r01000000 2r00001000
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	416	2r01111111 2r00010000
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	417	2r00000001 2r00100000
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	418	2r00000001 2r01000000
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	419	2r00000001 2r10000000
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	420	2r00000000 2r00000000]
270 aa6a36e199e7 be tolerant in case form creation fails Claus Gittinger <cg@exept.de> parents: 205 diff changeset	421	on:aDevice.
aa6a36e199e7 be tolerant in case form creation fails Claus Gittinger <cg@exept.de> parents: 205 diff changeset	422	form isNil ifTrue:[^ nil].
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	423	].
1 3ebee08bea15 Initial revision claus parents: diff changeset	424	].
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	425	form := form on:aDevice.
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	426
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	427	"
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	428	remember form for next use
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	429	"
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	430	(aDevice == Display) ifTrue:[
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	431	CachedStyle := style.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	432	RightArrowForm := form
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	433	].
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	434
4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	435	^ form
1 3ebee08bea15 Initial revision claus parents: diff changeset	436	!
3ebee08bea15 Initial revision claus parents: diff changeset	437
205 6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	438	upArrowButtonForm:style on:aDevice
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	439	"return the form used for the scrollUp Button"
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	440
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	441	\|form\|
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	442
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	443	"
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	444	use cached form, if device is appropriate
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	445	"
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	446	CachedStyle ~~ style ifTrue:[
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	447	UpArrowForm := DownArrowForm := LeftArrowForm := RightArrowForm := nil
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	448	].
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	449
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	450	((aDevice == Display) and:[UpArrowForm notNil]) ifTrue:[
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	451	^ UpArrowForm
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	452	].
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	453
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	454	UpArrowForm := StyleSheet at:'arrowButtonUpForm' default:nil.
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	455	UpArrowForm notNil ifTrue:[
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	456	^ UpArrowForm
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	457	].
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	458
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	459	"
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	460	special treatment for st80 arrows
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	461	- they do not really fit into the general (bitmap) scheme ...
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	462	(i.e. they are computed instead of drawn from a bitmap)
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	463	"
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	464	style ~~ #st80 ifTrue:[
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	465	UpArrowFormFile notNil ifTrue:[
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	466	form := Form fromFile:UpArrowFormFile resolution:100 on:aDevice.
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	467	form isNil ifTrue:[
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	468	'ARRBUTTON: no bitmapFile: ' infoPrint. UpArrowFormFile infoPrintNL.
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	469	]
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	470	]
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	471	].
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	472
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	473	"
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	474	form to use as a fallback, if no bitmap file is present
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	475	(actually not really needed - just to show something useful, in
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	476	case of a bad installation)
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	477	"
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	478	form isNil ifTrue:[
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	479	style == #st80 ifTrue:[
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	480	form := Form width:9 height:9 depth:1 on:aDevice.
270 aa6a36e199e7 be tolerant in case form creation fails Claus Gittinger <cg@exept.de> parents: 205 diff changeset	481	form isNil ifTrue:[^ nil].
205 6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	482	form clear.
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	483	form lineWidth:2.
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	484	form capStyle:#round.
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	485	form paint:(Color colorId:1).
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	486	form displayLineFromX:0 y:6 toX:4 y:2.
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	487	form displayLineFromX:4 y:2 toX:8 y:6.
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	488	] ifFalse:[
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	489	form := Form width:16 height:16
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	490	fromArray:#[2r00000000 2r00000000
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	491	2r00000001 2r10000000
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	492	2r00000010 2r01000000
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	493	2r00000100 2r00100000
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	494	2r00001000 2r00010000
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	495	2r00010000 2r00001000
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	496	2r00100000 2r00000100
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	497	2r01000000 2r00000010
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	498	2r01111000 2r00011110
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	499	2r00001000 2r00010000
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	500	2r00001000 2r00010000
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	501	2r00001000 2r00010000
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	502	2r00001000 2r00010000
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	503	2r00001000 2r00010000
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	504	2r00001111 2r11110000
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	505	2r00000000 2r00000000]
270 aa6a36e199e7 be tolerant in case form creation fails Claus Gittinger <cg@exept.de> parents: 205 diff changeset	506	on:aDevice.
aa6a36e199e7 be tolerant in case form creation fails Claus Gittinger <cg@exept.de> parents: 205 diff changeset	507	form isNil ifTrue:[^ nil].
205 6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	508	].
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	509	].
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	510
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	511	form := form on:aDevice.
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	512
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	513	"
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	514	remember form for next use
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	515	"
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	516	(aDevice == Display) ifTrue:[
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	517	CachedStyle := style.
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	518	UpArrowForm := form
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	519	].
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	520
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	521	^ form
1 3ebee08bea15 Initial revision claus parents: diff changeset	522	!
3ebee08bea15 Initial revision claus parents: diff changeset	523
205 6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	524	updateStyleCache
440 2beb33cb0146 added style resource directive Claus Gittinger <cg@exept.de> parents: 270 diff changeset	525	"extract values from the styleSheet and cache them in class variables"
2beb33cb0146 added style resource directive Claus Gittinger <cg@exept.de> parents: 270 diff changeset	526
2beb33cb0146 added style resource directive Claus Gittinger <cg@exept.de> parents: 270 diff changeset	527	<resource: #style (#arrowButtonStyle
2beb33cb0146 added style resource directive Claus Gittinger <cg@exept.de> parents: 270 diff changeset	528	#arrowButtonActiveLevel #arrowButtonPassiveLevel
2beb33cb0146 added style resource directive Claus Gittinger <cg@exept.de> parents: 270 diff changeset	529	#arrowButtonBackgroundColor #arrowButtonForegroundColor
2beb33cb0146 added style resource directive Claus Gittinger <cg@exept.de> parents: 270 diff changeset	530	#arrowButtonActiveBackgroundColor #arrowButtonActiveForegroundColor
2beb33cb0146 added style resource directive Claus Gittinger <cg@exept.de> parents: 270 diff changeset	531	#arrowButtonEnteredBackgroundColor #arrowButtonEnteredForegroundColor
2beb33cb0146 added style resource directive Claus Gittinger <cg@exept.de> parents: 270 diff changeset	532	#arrowButtonDisabledForegroundColor
2beb33cb0146 added style resource directive Claus Gittinger <cg@exept.de> parents: 270 diff changeset	533	#arrowButtonDownForm #arrowButtonUpForm
2beb33cb0146 added style resource directive Claus Gittinger <cg@exept.de> parents: 270 diff changeset	534	#arrowButtonLeftForm #arrowButtonRightForm
2beb33cb0146 added style resource directive Claus Gittinger <cg@exept.de> parents: 270 diff changeset	535	#arrowButtonDownFormFile #arrowButtonUpFormFile
2beb33cb0146 added style resource directive Claus Gittinger <cg@exept.de> parents: 270 diff changeset	536	#arrowButtonLeftFormFile #arrowButtonRightFormFile)>
2beb33cb0146 added style resource directive Claus Gittinger <cg@exept.de> parents: 270 diff changeset	537
205 6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	538	DefaultArrowStyle := StyleSheet at:'arrowButtonStyle' default:StyleSheet name.
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	539	DefaultArrowStyle := DefaultArrowStyle asSymbol.
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	540
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	541	DefaultArrowButtonActiveLevel := StyleSheet at:'arrowButtonActiveLevel' default:nil.
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	542	DefaultArrowButtonPassiveLevel := StyleSheet at:'arrowButtonPassiveLevel' default:nil.
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	543
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	544	DefaultBackgroundColor := StyleSheet colorAt:'arrowButtonBackgroundColor'.
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	545	DefaultForegroundColor := StyleSheet colorAt:'arrowButtonForegroundColor'.
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	546	DefaultActiveBackgroundColor := StyleSheet colorAt:'arrowButtonActiveBackgroundColor'.
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	547	DefaultActiveForegroundColor := StyleSheet colorAt:'arrowButtonActiveForegroundColor'.
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	548	DefaultEnteredBackgroundColor := StyleSheet colorAt:'arrowButtonEnteredBackgroundColor'.
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	549	DefaultEnteredForegroundColor := StyleSheet colorAt:'arrowButtonEnteredForegroundColor'.
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	550	DefaultDisabledForegroundColor := StyleSheet colorAt:'arrowButtonDisabledForegroundColor'.
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	551
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	552	DownArrowForm := StyleSheet at:'arrowButtonDownForm' default:nil.
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	553	UpArrowForm := StyleSheet at:'arrowButtonUpForm' default:nil.
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	554	LeftArrowForm := StyleSheet at:'arrowButtonLeftForm' default:nil.
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	555	RightArrowForm := StyleSheet at:'arrowButtonRightForm' default:nil.
1 3ebee08bea15 Initial revision claus parents: diff changeset	556
205 6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	557	UpArrowFormFile := DownArrowFormFile := LeftArrowFormFile := RightArrowFormFile := nil.
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	558	UpArrowForm isNil ifTrue:[
440 2beb33cb0146 added style resource directive Claus Gittinger <cg@exept.de> parents: 270 diff changeset	559	UpArrowFormFile := StyleSheet at:'arrowButtonUpFormFile' default:'ScrollUp.xbm'.
205 6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	560	].
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	561	DownArrowForm isNil ifTrue:[
440 2beb33cb0146 added style resource directive Claus Gittinger <cg@exept.de> parents: 270 diff changeset	562	DownArrowFormFile := StyleSheet at:'arrowButtonDownFormFile' default:'ScrollDn.xbm'.
205 6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	563	].
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	564	LeftArrowForm isNil ifTrue:[
440 2beb33cb0146 added style resource directive Claus Gittinger <cg@exept.de> parents: 270 diff changeset	565	LeftArrowFormFile := StyleSheet at:'arrowButtonLeftFormFile' default:'ScrollLt.xbm'.
205 6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	566	].
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	567	RightArrowForm isNil ifTrue:[
440 2beb33cb0146 added style resource directive Claus Gittinger <cg@exept.de> parents: 270 diff changeset	568	RightArrowFormFile := StyleSheet at:'arrowButtonRightFormFile' default:'ScrollRt.xbm'.
205 6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	569	].
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	570
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	571	"
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	572	self updateStyleCache
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	573	"
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	574
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	575	"Modified: 31.8.1995 / 03:01:14 / claus"
440 2beb33cb0146 added style resource directive Claus Gittinger <cg@exept.de> parents: 270 diff changeset	576	"Modified: 1.3.1996 / 13:45:57 / cg"
1 3ebee08bea15 Initial revision claus parents: diff changeset	577	! !
3ebee08bea15 Initial revision claus parents: diff changeset	578
3ebee08bea15 Initial revision claus parents: diff changeset	579	!ArrowButton methodsFor:'accessing'!
3ebee08bea15 Initial revision claus parents: diff changeset	580
3ebee08bea15 Initial revision claus parents: diff changeset	581	direction:aDirectionSymbol
6 fd1b68b48422 * empty log message * claus parents: 1 diff changeset	582	\|form\|
fd1b68b48422 * empty log message * claus parents: 1 diff changeset	583
1 3ebee08bea15 Initial revision claus parents: diff changeset	584	aDirectionSymbol == #up ifTrue:[
62 7cc1e330da47 * empty log message * claus parents: 60 diff changeset	585	form := (self class upArrowButtonForm:arrowStyle on:device).
7cc1e330da47 * empty log message * claus parents: 60 diff changeset	586	name := 'upButton'.
1 3ebee08bea15 Initial revision claus parents: diff changeset	587	].
3ebee08bea15 Initial revision claus parents: diff changeset	588	aDirectionSymbol == #down ifTrue:[
62 7cc1e330da47 * empty log message * claus parents: 60 diff changeset	589	form := (self class downArrowButtonForm:arrowStyle on:device).
7cc1e330da47 * empty log message * claus parents: 60 diff changeset	590	name := 'downButton'.
1 3ebee08bea15 Initial revision claus parents: diff changeset	591	].
3ebee08bea15 Initial revision claus parents: diff changeset	592	aDirectionSymbol == #left ifTrue:[
62 7cc1e330da47 * empty log message * claus parents: 60 diff changeset	593	form := (self class leftArrowButtonForm:arrowStyle on:device).
7cc1e330da47 * empty log message * claus parents: 60 diff changeset	594	name := 'leftButton'.
1 3ebee08bea15 Initial revision claus parents: diff changeset	595	].
3ebee08bea15 Initial revision claus parents: diff changeset	596	aDirectionSymbol == #right ifTrue:[
62 7cc1e330da47 * empty log message * claus parents: 60 diff changeset	597	form := (self class rightArrowButtonForm:arrowStyle on:device).
7cc1e330da47 * empty log message * claus parents: 60 diff changeset	598	name := 'rightButton'.
1 3ebee08bea15 Initial revision claus parents: diff changeset	599	].
6 fd1b68b48422 * empty log message * claus parents: 1 diff changeset	600	self form:form
1 3ebee08bea15 Initial revision claus parents: diff changeset	601	! !
3ebee08bea15 Initial revision claus parents: diff changeset	602
3ebee08bea15 Initial revision claus parents: diff changeset	603	!ArrowButton methodsFor:'initialization'!
3ebee08bea15 Initial revision claus parents: diff changeset	604
3ebee08bea15 Initial revision claus parents: diff changeset	605	initStyle
3ebee08bea15 Initial revision claus parents: diff changeset	606	super initStyle.
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	607
60 f3c738c24ce6 mostly style claus parents: 59 diff changeset	608	DefaultBackgroundColor notNil ifTrue:[
f3c738c24ce6 mostly style claus parents: 59 diff changeset	609	bgColor := DefaultBackgroundColor on:device
f3c738c24ce6 mostly style claus parents: 59 diff changeset	610	].
f3c738c24ce6 mostly style claus parents: 59 diff changeset	611	DefaultForegroundColor notNil ifTrue:[
f3c738c24ce6 mostly style claus parents: 59 diff changeset	612	fgColor := DefaultForegroundColor on:device
f3c738c24ce6 mostly style claus parents: 59 diff changeset	613	].
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	614	DefaultActiveForegroundColor notNil ifTrue:[
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	615	activeFgColor := DefaultActiveForegroundColor on:device
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	616	].
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	617	DefaultActiveBackgroundColor notNil ifTrue:[
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	618	activeBgColor := DefaultActiveBackgroundColor on:device
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	619	].
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	620	DefaultEnteredForegroundColor notNil ifTrue:[
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	621	enteredFgColor := DefaultEnteredForegroundColor on:device
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	622	].
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	623	DefaultEnteredBackgroundColor notNil ifTrue:[
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	624	enteredBgColor := DefaultEnteredBackgroundColor on:device
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	625	].
153 a60507aaa7a0 . claus parents: 139 diff changeset	626	DefaultDisabledForegroundColor notNil ifTrue:[
a60507aaa7a0 . claus parents: 139 diff changeset	627	disabledFgColor := DefaultDisabledForegroundColor on:device
a60507aaa7a0 . claus parents: 139 diff changeset	628	].
a60507aaa7a0 . claus parents: 139 diff changeset	629
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	630	arrowStyle := DefaultArrowStyle.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	631
128 06a050529335 . claus parents: 77 diff changeset	632	DefaultArrowButtonActiveLevel notNil ifTrue:[onLevel := DefaultArrowButtonActiveLevel].
06a050529335 . claus parents: 77 diff changeset	633	DefaultArrowButtonPassiveLevel notNil ifTrue:[offLevel := DefaultArrowButtonPassiveLevel].
06a050529335 . claus parents: 77 diff changeset	634	offLevel ~~ level ifTrue:[self level:offLevel].
06a050529335 . claus parents: 77 diff changeset	635
06a050529335 . claus parents: 77 diff changeset	636	"/ "
06a050529335 . claus parents: 77 diff changeset	637	"/ special treatment for motif arrows
06a050529335 . claus parents: 77 diff changeset	638	"/ - they do not really fit into the general (bitmap) scheme ...
06a050529335 . claus parents: 77 diff changeset	639	"/ "
06a050529335 . claus parents: 77 diff changeset	640	"/ arrowStyle == #motif ifTrue:[
06a050529335 . claus parents: 77 diff changeset	641	"/ onLevel := 0.
06a050529335 . claus parents: 77 diff changeset	642	"/ offLevel := 0.
06a050529335 . claus parents: 77 diff changeset	643	"/ self level:0.
06a050529335 . claus parents: 77 diff changeset	644	"/ ]
205 6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	645	!
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	646
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	647	initialize
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	648	super initialize.
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	649	controller beTriggerOnDown.
1 3ebee08bea15 Initial revision claus parents: diff changeset	650	! !
3ebee08bea15 Initial revision claus parents: diff changeset	651
6 fd1b68b48422 * empty log message * claus parents: 1 diff changeset	652	!ArrowButton methodsFor:'redrawing'!
fd1b68b48422 * empty log message * claus parents: 1 diff changeset	653
fd1b68b48422 * empty log message * claus parents: 1 diff changeset	654	drawWith:fg and:bg
fd1b68b48422 * empty log message * claus parents: 1 diff changeset	655	"this is a q&d hack for motif ..."
fd1b68b48422 * empty log message * claus parents: 1 diff changeset	656
155 d6f3836d2b51 . claus parents: 154 diff changeset	657	\|topLeft botRight noColor allColor isString orgX orgY r\|
6 fd1b68b48422 * empty log message * claus parents: 1 diff changeset	658
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	659	arrowStyle ~~ #motif ifTrue:[
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	660	^ super drawWith:fg and:bg.
6 fd1b68b48422 * empty log message * claus parents: 1 diff changeset	661	].
fd1b68b48422 * empty log message * claus parents: 1 diff changeset	662
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	663	"
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	664	the code below does a lot of bitmap drawing, but allows
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	665	to 3D-ify any logo (it draws it displaced by some pixels
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	666	to the upper left in one-color and displaced to the
60 f3c738c24ce6 mostly style claus parents: 59 diff changeset	667	lower right in the other color). It should be rewritten to
f3c738c24ce6 mostly style claus parents: 59 diff changeset	668	cache the result for later drawing operations.
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	669	"
6 fd1b68b48422 * empty log message * claus parents: 1 diff changeset	670	logo notNil ifTrue:[
153 a60507aaa7a0 . claus parents: 139 diff changeset	671	self paint:bg.
a60507aaa7a0 . claus parents: 139 diff changeset	672	self fillRectangleX:0 y:0 width:width height:height.
a60507aaa7a0 . claus parents: 139 diff changeset	673
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	674	shadowColor := shadowColor on:device.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	675	lightColor := lightColor on:device.
6 fd1b68b48422 * empty log message * claus parents: 1 diff changeset	676
77 565b052f5277 * empty log message * claus parents: 75 diff changeset	677	controller pressed ifTrue:[
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	678	topLeft := shadowColor.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	679	botRight := lightColor
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	680	] ifFalse:[
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	681	topLeft := lightColor.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	682	botRight := shadowColor
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	683	].
6 fd1b68b48422 * empty log message * claus parents: 1 diff changeset	684
153 a60507aaa7a0 . claus parents: 139 diff changeset	685	isString := logo isString.
a60507aaa7a0 . claus parents: 139 diff changeset	686
a60507aaa7a0 . claus parents: 139 diff changeset	687	isString ifFalse:[
a60507aaa7a0 . claus parents: 139 diff changeset	688	logo depth ~~ 1 ifTrue:[
a60507aaa7a0 . claus parents: 139 diff changeset	689	"/ allow for 4-bit logos (for motif)
155 d6f3836d2b51 . claus parents: 154 diff changeset	690	"/ one catch: if the view background is a complex pixmap
d6f3836d2b51 . claus parents: 154 diff changeset	691	"/ we cannot use this as colorMap entry.
d6f3836d2b51 . claus parents: 154 diff changeset	692	"/ therefore, compute their average colors and take these
d6f3836d2b51 . claus parents: 154 diff changeset	693	"/ (this looks ok for buttons ...)
d6f3836d2b51 . claus parents: 154 diff changeset	694	r := (0@0 corner:10@10).
d6f3836d2b51 . claus parents: 154 diff changeset	695	logo colorMap:(Array with:(bg averageColorIn:r)
d6f3836d2b51 . claus parents: 154 diff changeset	696	with:(topLeft averageColorIn:r)
d6f3836d2b51 . claus parents: 154 diff changeset	697	with:(botRight averageColorIn:r)
d6f3836d2b51 . claus parents: 154 diff changeset	698	with:(fg averageColorIn:r)).
153 a60507aaa7a0 . claus parents: 139 diff changeset	699	logo photometric:#palette.
a60507aaa7a0 . claus parents: 139 diff changeset	700	self displayForm:logo x:labelOriginX y:labelOriginY.
a60507aaa7a0 . claus parents: 139 diff changeset	701	^ self
a60507aaa7a0 . claus parents: 139 diff changeset	702	]
a60507aaa7a0 . claus parents: 139 diff changeset	703	].
38 4b9b70b2cc87 2.10.3 pre-final version claus parents: 24 diff changeset	704
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	705	noColor := Color noColor.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	706	allColor := Color allColor.
6 fd1b68b48422 * empty log message * claus parents: 1 diff changeset	707
153 a60507aaa7a0 . claus parents: 139 diff changeset	708	isString ifTrue:[
139 7dd008efa3d8 . claus parents: 130 diff changeset	709	orgY := height - font height // 2 + font ascent.
7dd008efa3d8 . claus parents: 130 diff changeset	710	orgX := width - labelOriginX // 4 - 1.
7dd008efa3d8 . claus parents: 130 diff changeset	711	].
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	712	self paint:topLeft.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	713	#(-1 0 -1) with:#(-1 -1 0) do:[:dX :dY \|
139 7dd008efa3d8 . claus parents: 130 diff changeset	714	isString ifTrue:[
7dd008efa3d8 . claus parents: 130 diff changeset	715	self displayString:logo x:orgX+dX y:orgY+dY.
7dd008efa3d8 . claus parents: 130 diff changeset	716	] ifFalse:[
7dd008efa3d8 . claus parents: 130 diff changeset	717	self displayForm:logo x:labelOriginX+dX y:labelOriginY+dY.
7dd008efa3d8 . claus parents: 130 diff changeset	718	]
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	719	].
6 fd1b68b48422 * empty log message * claus parents: 1 diff changeset	720
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	721	self paint:botRight.
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	722	#(1 1 0) with:#(0 1 1) do:[:dX :dY \|
139 7dd008efa3d8 . claus parents: 130 diff changeset	723	isString ifTrue:[
7dd008efa3d8 . claus parents: 130 diff changeset	724	self displayString:logo x:orgX+dX y:orgY+dY.
7dd008efa3d8 . claus parents: 130 diff changeset	725	] ifFalse:[
7dd008efa3d8 . claus parents: 130 diff changeset	726	self displayForm:logo x:labelOriginX+dX y:labelOriginY+dY.
7dd008efa3d8 . claus parents: 130 diff changeset	727	]
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	728	].
6 fd1b68b48422 * empty log message * claus parents: 1 diff changeset	729
59 450ce95a72a4 * empty log message * claus parents: 38 diff changeset	730	"
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	731	finally, the form itself
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	732	"
450ce95a72a4 * empty log message * claus parents: 38 diff changeset	733	self paint:fg.
139 7dd008efa3d8 . claus parents: 130 diff changeset	734	isString ifTrue:[
7dd008efa3d8 . claus parents: 130 diff changeset	735	self displayString:logo x:orgX y:orgY.
7dd008efa3d8 . claus parents: 130 diff changeset	736	] ifFalse:[
7dd008efa3d8 . claus parents: 130 diff changeset	737	self displayForm:logo x:labelOriginX y:labelOriginY.
7dd008efa3d8 . claus parents: 130 diff changeset	738	]
6 fd1b68b48422 * empty log message * claus parents: 1 diff changeset	739	]
153 a60507aaa7a0 . claus parents: 139 diff changeset	740
a60507aaa7a0 . claus parents: 139 diff changeset	741	"Modified: 31.8.1995 / 03:03:12 / claus"
6 fd1b68b48422 * empty log message * claus parents: 1 diff changeset	742	! !
205 6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	743
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	744	!ArrowButton class methodsFor:'documentation'!
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	745
6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	746	version
585 8f395aba0173 documentation Claus Gittinger <cg@exept.de> parents: 580 diff changeset	747	^ '$Header: /cvs/stx/stx/libwidg/ArrowButton.st,v 1.23 1996-04-25 17:24:32 cg Exp $'
205 6814c0bf8df8 checkin from browser Claus Gittinger <cg@exept.de> parents: 174 diff changeset	748	! !

author	Claus Gittinger <cg@exept.de>
	Thu, 25 Apr 1996 19:26:41 +0200
changeset 585	8f395aba0173
parent 580	a31ba5bcc4c0
child 593	86dd024ed773
permissions	-rw-r--r--