Context Navigation

Back to Ticket #85

Ticket #85: Scroller_mouse_event_fixed.st

File Scroller_mouse_event_fixed.st, 87.8 KB (added by Patrik Svestka, 5 years ago)
Fixing thumb movement in the class Scroller

Line
1	"
2	COPYRIGHT (c) 1989 by Claus Gittinger
3	All Rights Reserved
4
5	This software is furnished under a license and may be used
6	only in accordance with the terms of that license and with the
7	inclusion of the above copyright notice. This software may not
8	be provided or otherwise made available to, or used by, any
9	other person. No title to or ownership of the software is
10	hereby transferred.
11	"
12	'From Smalltalk/X jv-branch, Version:6.2.6.0 on 06-01-2017 at 09:45:37 AM' !
13
14	"{ Package: 'stx:libwidg' }"
15
16	"{ NameSpace: Smalltalk }"
17
18	View subclass:#Scroller
19	instanceVariableNames:'thumbOrigin thumbHeight thumbColor thumbFrameColor scrollAction
20	orientation thumbFrame thumbLevel scrolling pressOffset
21	synchronousOperation shadowForm lightForm inset thumbShadowColor
22	thumbLightColor thumbEdgeStyle thumbHalfShadowColor
23	thumbHalfLightColor thumbEnteredColor thumbFrameSizeDifference
24	tallyLevel tallyMarks fixThumbHeight frameBeforeMove ghostColor
25	ghostFrameColor ghostLevel rangeStart rangeEnd rangeStep entered
26	thumbActiveLevel originBeforeMove thumbImage enabled keyboardStep
27	autoRepeat repeatBlock initialRepeatDelay repeatDelay
28	lastMousePosition thumbActiveColor virtualModelValue'
29	classVariableNames:'HandleShadowForm HandleLightForm DefaultViewBackground
30	DefaultShadowColor DefaultLightColor DefaultThumbColor
31	DefaultThumbShadowColor DefaultThumbLightColor
32	DefaultThumbHalfShadowColor DefaultThumbHalfLightColor
33	DefaultHalfShadowColor DefaultHalfLightColor DefaultTallyMarks
34	DefaultTallyLevel DefaultLevel DefaultBorderWidth
35	DefaultThumbLevel DefaultInset DefaultThumbFrameColor
36	DefaultGhostColor DefaultGhostFrameColor DefaultGhostLevel
37	DefaultFixThumbHeight DefaultEdgeStyle DefaultFullViewBackground
38	DefaultThumbEnteredColor DefaultThumbActiveColor
39	DefaultThumbActiveLevel SnapBackDistance DefaultMiddleButtonJump
40	NewCursors DefaultThumbImage HandleImage DefaultHScrollerHeight
41	DefaultVScrollerWidth DefaultStopPagerAtThumb DefaultTallyInset
42	MinThumbSize DefaultTallyDistance DefaultVerticalThumbFrameImage
43	DefaultHorizontalThumbFrameImage'
44	poolDictionaries:''
45	category:'Views-Interactors'
46	!
47
48	!Scroller class methodsFor:'documentation'!
49
50	copyright
51	"
52	COPYRIGHT (c) 1989 by Claus Gittinger
53	All Rights Reserved
54
55	This software is furnished under a license and may be used
56	only in accordance with the terms of that license and with the
57	inclusion of the above copyright notice. This software may not
58	be provided or otherwise made available to, or used by, any
59	other person. No title to or ownership of the software is
60	hereby transferred.
61	"
62	!
63
64	documentation
65	"
66	this class implements the scroller for scrollbars.
67	it can also be used by itself for scrollbars without step-buttons.
68	When moved, either a predefined action is performed (scrollAction),
69	or a model is informed via the changeMsg (which is #value: by default).
70
71	The scroller can work synchronous (i.e. every move leads to an immediate evaluation
72	of the action, or asynchronous (i.e. perform action on end-of move).
73	By default, scrollers are synchronous. Asynchronous operation makes sense,
74	if the scroll operation (redraw) is expensive and takes a long time.
75
76	This class is used both for concrete instances (vertical scrollers)
77	and as an abstract superclass for horizontalScrollers, sliders and
78	miniScrollers.
79
80	range:
81	the value passed to the model or via the action blocks is scaled according
82	to the min/maxRange instance variables.
83	These default to 0..100 for percentage values.
84	It does not make sense to change the range for scrollbar-scrollers,
85	but may be useful with Sliders or in special applications.
86
87	style stuff:
88
89	Beside the obvious 3D rectangle, a scroller may draw a know-form
90	(as in NeXT) or little tally marks (as on SGI) in itself.
91	These are controlled by the shadowForm, lightForm, tallyLevel and tallyMarks
92	instance variables. All of this is initialized from the styleSheet.
93
94	[Instance variables:]
95
96	thumbOrigin <Number> origin of thumb (in percent)
97	thumbHeight <Number> height of thumb (in percent)
98	thumbColor <Color> color of thumb
99	thumbFrameColor <Color> color of the frame around the thumb
100	scrollAction <Block> 1 arg block to be evaluated when scrolled
101	(arg is position in percent)
102	orientation <Symbol> #horizontal or #vertical
103	thumbFrame <Rectangle> frame of thumb in pixels (cached)
104	thumbLevel <Number> level of thumb if 3d
105	scrolling <Boolean> true during scroll
106	pressOffset <Number> temporary (offset into frame when move started)
107	synchronousOperation <Boolean> true if synchronous (i.e. dont wait till release
108	to perform action)
109	shadowForm <Form> bitmap of knob if any (shadow part)
110	lightForm <Form> bitmap of knob if any (light part)
111	inset <Integer> number of pixels to inset thumb from view borders
112	thumbShadowColor <Color> color do draw dark parts of thumb
113	thumblightColor <Color> color to draw light parts of thumb
114	thumbEdgeStyle <SymbolOrNil> #soft or nil
115	thumbHalfShadowColor <Color> used to draw smooth edges
116	thumbHalfLightColor <Color> used to draw smooth edges
117	thumbFrameSizeDifference <Integer> number of pixels the thumb is larger than
118	it should be (can be negative for mswin-style)
119	tallyLevel <Integer> if not zero, specifies if tally-marks should
120	go into or out of the display (actually only <0/>0 is checked)
121	I dont know of a better word for these ...
122	tallyMarks <Integer> number of tally marks
123	fixThumbHeight <Boolean> perform 'wrong' height computation a la mswindows
124	rangeStart <Number> the range of the scroller
125	rangeEnd (defaults to 0..100)
126	rangeStep not currently implemented
127
128	[style settings:]
129
130	scrollerLevel <Integer> the level of the scroller w.r.t. its enclosing view
131	scrollerBorderWidth <Integer> the borderWidth (ignored for 3D styles)
132
133	scrollerViewBackground <Color> the viewBackground (color or image)
134	scrollerShadowColor <Color> the color of 3D shadowed edges (ignored in 2D styles)
135	scrollerLightColor <Color> the color of 3D lighted edges (ignored in 2D styles)
136
137	scrollerThumbColor <Color> the thumbs color (color or image)
138	scrollerThumbShadowColor <Color> the color of the thumbs shadowed edges (ignored in 2D styles)
139	scrollerThumbLightColor <Color> the color of the thumbs shadowed edges (ignored in 2D styles)
140	scrollerThumbEdgeStyle <Symbol> the edge style for the thumb (#soft or nil)
141	scrollerThumbLevel <Integer> the 3D height of the thumb
142	scrollerThumbHalfShadowColor<Color> the halfShadow for soft edged thumbs
143	scrollerThumbHalfLightColor <Color> the halfLight for soft edged thumbs
144	scrollerThumbFrameColor <Color> if non-nil, a rectangle is drawn around the thumb is this color
145	scrollerThumbInset <Integer> inset of thumb from the scrollers boundary
146	scrollerThumbFixHeight <Boolean> if true, use a fix thumb height (as in mswindows)
147	scrollerGhostColor <Color> the color in which a ghost-rectangle is drawn
148	scrollerGhostFrameColor <Color> if non-nil, a rectangle is drawn around the ghost is this color
149	scrollerGhostLevel <Color> the 3D level of the ghost rectangle
150	scrollerNTallyMarks <Integer> number of tally-marks to draw on the thumb
151	scrollerTallyLevel <Integer> the 3D level of any tally marks
152	scrollerSnapBack <Boolean> win95 behavior: snap back to original position if scrollers view
153	is left by mouse (with some distance)
154	scrollerMiddleButtonJump <Boolean> xterm behavior: middle button has shift-click behavior
155	(positions absolute to click position)
156
157	notice: for mswindows style, we force a WRONG thumb-frame
158	computation, to make the thumb have constant size;
159	if you dont like that (I do not :-),
160	set scrollerThumbFixHeight to false (in the StyleSheet).
161
162	[author:]
163	Claus Gittinger
164
165	[see also:]
166	ScrollBar
167	ScrollableView HVScrollableView
168	"
169	!
170
171	examples
172	"
173	basic scroller setup:
174	[exBegin]
175	\|top s\|
176
177	top := StandardSystemView new extent:200@200.
178	s := Scroller in:top.
179	s origin:(0.0@0.0) corner:(20@1.0).
180	s thumbHeight:10. 'percent'.
181	top open
182	[exEnd]
183
184	setting its thumb-height:
185	[exBegin]
186	\|top s\|
187
188	top := StandardSystemView new extent:200@200.
189	s := Scroller in:top.
190	s origin:(0.0@0.0) corner:(20@1.0).
191	s thumbHeight:50. 'percent'.
192	top open
193	[exEnd]
194
195	setting its thumb-origin:
196	[exBegin]
197	\|top s\|
198
199	top := StandardSystemView new extent:200@200.
200	s := Scroller in:top.
201	s origin:(0.0@0.0) corner:(20@1.0).
202	s thumbHeight:10. 'percent'.
203	s thumbOrigin:30. 'percent'.
204	top open
205	[exEnd]
206
207	a scroller with action block (ST/X style):
208	[exBegin]
209	\|top s\|
210
211	top := StandardSystemView new extent:200@200.
212	s := Scroller in:top.
213	s origin:(0.0@0.0) corner:(20@1.0).
214	s thumbHeight:10. 'percent'.
215	s scrollAction:[:percent \| Transcript show:'moved to: '; showCR:percent asFloat].
216	top open
217	[exEnd]
218
219	setting its range:
220	[exBegin]
221	\|top s\|
222
223	top := StandardSystemView new extent:200@200.
224	s := Scroller in:top.
225	s origin:(0.0@0.0) corner:(20@1.0).
226	s thumbHeight:10. 'percent'.
227	s scrollAction:[:percent \| Transcript show:'moved to: '; showCR:percent asFloat].
228	s start:0 stop:1.
229	top open
230	[exEnd]
231
232	create a scroller in its default extent and have it positioned
233	at the side; beside another view:
234	[exBegin]
235	\|top s v\|
236
237	top := StandardSystemView new extent:200@200.
238	s := Scroller in:top.
239	s origin:(0.0@0.0) corner:(0.0@1.0).
240	s rightInset:(s preferredExtent x negated).
241	s thumbHeight:10.
242	s level:1.
243
244	v := View in:top.
245	v origin:0.0@0.0 corner:1.0@1.0.
246	v leftInset:(s preferredExtent x).
247	v viewBackground:Color red.
248	v level:2.
249
250	top open
251	[exEnd]
252
253	using a model (ST-80 style):
254	[exBegin]
255	\|top s m\|
256
257	m := 0 asValue.
258	InspectorView openOn:m monitor:'value'. 'look at value'.
259
260	top := StandardSystemView new extent:200@200.
261	s := Scroller in:top.
262	s origin:(0.0@0.0) corner:(20@1.0).
263	s thumbHeight:10. 'percent'.
264	s model:m.
265	top open
266	[exEnd]
267
268	using a different changeSelector:
269	[exBegin]
270	\|top s1 s2 m\|
271
272	m := Plug new.
273	m respondTo:#value1: with:[:v \| Transcript show:'scroller 1 moved to: '; showCR:v].
274	m respondTo:#value2: with:[:v \| Transcript show:'scroller 2 moved to: '; showCR:v].
275
276	top := StandardSystemView new extent:200@200.
277	s1 := Scroller in:top.
278	s1 origin:(0.0@0.0) corner:(20@1.0).
279	s1 thumbHeight:10. 'percent'.
280	s1 model:m; change:#value1:.
281
282	s2 := Scroller in:top.
283	s2 origin:(30@0.0) corner:(50@1.0).
284	s2 thumbHeight:10. 'percent'.
285	s2 model:m; change:#value2:.
286	top open
287	[exEnd]
288	"
289	! !
290
291	!Scroller class methodsFor:'defaults'!
292
293	handleLightFormOn:aDisplay
294	"answer the form used for the handles light area;
295	cache the one for Display for the next round"
296
297	\|f\|
298
299	((aDisplay == Display) and:[HandleLightForm notNil]) ifTrue:[
300	^ HandleLightForm
301	].
302	f := Smalltalk imageFromFileNamed:'HandleLight.xbm' forClass:self.
303	f notNil ifTrue:[
304	f := f onDevice:aDisplay
305	] ifFalse:[
306	f := Form width:8 height:8 fromArray:#[2r00000000
307	2r00000010
308	2r00000011
309	2r00000011
310	2r00000011
311	2r00000011
312	2r00000110
313	2r00111100]
314	onDevice:aDisplay
315	].
316	(aDisplay == Display) ifTrue:[
317	HandleLightForm := f
318	].
319	^ f
320
321	"Modified: 23.10.2031 / 01:00:00 / cg"
322	!
323
324	handleShadowFormOn:aDisplay
325	"answer the form used for the handles shadow area;
326	cache the one for Display for the next round"
327
328	\|f\|
329
330	((aDisplay == Display) and:[HandleShadowForm notNil]) ifTrue:[
331	^ HandleShadowForm
332	].
333	f := Smalltalk imageFromFileNamed:'HandleShadow.xbm' forClass:self.
334	f notNil ifTrue:[
335	f := f onDevice:aDisplay
336	] ifFalse:[
337	f := Form width:8 height:8 fromArray:#[2r00111100
338	2r01100000
339	2r11000000
340	2r11000000
341	2r11000000
342	2r11000000
343	2r01000000
344	2r00000000]
345	onDevice:aDisplay
346	].
347	(aDisplay == Display) ifTrue:[
348	HandleShadowForm := f
349	].
350	^ f
351
352	"Modified: 19.12.1996 / 01:00:00 / cg"
353	!
354
355	updateStyleCache
356	"extract values from the styleSheet and cache them in class variables"
357
358	<resource: #style (#'scroller.viewBackground' #'scroller.fullViewBackground'
359	#'scroller.thumbColor'
360	#'scroller.shadowColor' #'scroller.lightColor'
361	#'scroller.thumbShadowColor' #'scroller.thumbLightColor'
362	#'scroller.thumbHalfShadowColor' #'scroller.thumbHalfLightColor'
363	#'scroller.thumbFrameColor' #'scroller.ghostColor'
364	#'scroller.ghostLevel' #'scroller.ghostFrameColor'
365	#'scroller.NTallyMarks' #'scroller.tallyLevel' #'scroller.tallyInset'
366	#'scroller.level' #'scroller.borderWidth'
367	#'scroller.thumbLevel' #'scroller.thumbInset'
368	#'scroller.thumbFixHeight' #'scroller.thumbEdgeStyle'
369	#'scroller.thumbEnteredColor' #'scroller.thumbActiveLevel'
370	#'scroller.thumbActiveColor'
371	#'scroller.middleButtonJump'
372	#'scroller.newCursors'
373	#'scroller.thumbImage' #'scroller.handleImage'
374	#'scroller.vScrollerWidth' #'scroller.hScrollerHeight'
375	#'scroller.stopPagerAtThumb'
376	#'scroller.verticalThumbFrameImage' #'scroller.horizontalThumbFrameImage'
377	)>
378
379	DefaultViewBackground := StyleSheet colorAt:#'scroller.viewBackground'.
380	DefaultFullViewBackground := StyleSheet colorAt:#'scroller.fullViewBackground'.
381	DefaultThumbColor := StyleSheet colorAt:#'scroller.thumbColor'.
382	DefaultThumbEnteredColor := StyleSheet colorAt:#'scroller.thumbEnteredColor'.
383	DefaultThumbActiveColor := StyleSheet colorAt:#'scroller.thumbActiveColor'.
384	DefaultShadowColor := StyleSheet colorAt:#'scroller.shadowColor'.
385	DefaultLightColor := StyleSheet colorAt:#'scroller.lightColor'.
386	DefaultThumbShadowColor := StyleSheet colorAt:#'scroller.thumbShadowColor'.
387	DefaultThumbLightColor := StyleSheet colorAt:#'scroller.thumbLightColor'.
388	DefaultThumbHalfShadowColor := StyleSheet colorAt:#'scroller.thumbHalfShadowColor'.
389	DefaultThumbHalfLightColor := StyleSheet colorAt:#'scroller.thumbHalfLightColor'.
390	DefaultThumbFrameColor := StyleSheet colorAt:#'scroller.thumbFrameColor'.
391	DefaultGhostColor := StyleSheet colorAt:#'scroller.ghostColor' default:nil.
392	DefaultGhostFrameColor := StyleSheet colorAt:#'scroller.ghostFrameColor' default:nil.
393	DefaultGhostLevel := StyleSheet at:#'scroller.ghostLevel' default:0.
394	DefaultTallyMarks := StyleSheet at:#'scroller.NTallyMarks' default:0.
395
396	DefaultTallyLevel := DefaultTallyInset := 0.
397	DefaultTallyMarks ~~ 0 ifTrue:[
398	DefaultTallyLevel := StyleSheet at:#'scroller.tallyLevel' default:1.
399	DefaultTallyInset := StyleSheet at:#'scroller.tallyInset' default:0.
400	DefaultTallyDistance := StyleSheet at:#'scroller.tallyDistance'.
401	].
402	DefaultLevel := StyleSheet at:#'scroller.level' default:0.
403	DefaultBorderWidth := StyleSheet at:#'scroller.borderWidth' default:(StyleSheet at:#'borderWidth').
404	DefaultThumbLevel := StyleSheet at:#'scroller.thumbLevel' default:0.
405	DefaultThumbActiveLevel := StyleSheet at:#'scroller.thumbActiveLevel' default:DefaultThumbLevel.
406	DefaultInset := StyleSheet at:#'scroller.thumbInset' default:0.
407	DefaultFixThumbHeight := StyleSheet at:#'scroller.thumbFixHeight' default:false.
408	DefaultEdgeStyle := StyleSheet at:#'scroller.thumbEdgeStyle'.
409	DefaultMiddleButtonJump := StyleSheet at:#'scroller.middleButtonJump' default:false.
410	NewCursors := StyleSheet at:#'scroller.newCursors' default:true.
411	DefaultThumbImage := StyleSheet at:#'scroller.thumbImage'.
412	HandleImage := StyleSheet at:#'scroller.handleImage'.
413	DefaultVerticalThumbFrameImage := StyleSheet at:#'scroller.verticalThumbFrameImage'.
414	DefaultHorizontalThumbFrameImage := StyleSheet at:#'scroller.horizontalThumbFrameImage'.
415
416	DefaultVScrollerWidth := StyleSheet at:#'scroller.vScrollerWidth' default:nil.
417	DefaultHScrollerHeight := StyleSheet at:#'scroller.hScrollerHeight' default:nil.
418
419	StyleSheet fileReadFailed ifTrue:[
420	DefaultViewBackground := Grey.
421	DefaultThumbColor := Color white.
422	DefaultThumbFrameColor := Color black.
423	DefaultInset := 1.
424	].
425
426	DefaultStopPagerAtThumb := StyleSheet at:#'scroller.stopPagerAtThumb' default:true.
427
428	SnapBackDistance := StyleSheet at:#'scroller.snapBackDistance' default:30.
429	MinThumbSize := StyleSheet at:#'scroller.minThumbSize' default:8.
430
431	"
432	self updateStyleCache
433	"
434
435	"Modified: / 28.4.1999 / 19:23:24 / cg"
436	! !
437
438	!Scroller methodsFor:'accessing'!
439
440	keyboardStep
441	"return the scrollers keyboard step. If non-nil,
442	thats the stepping value used with cursorUp/cursorDown keys.
443	(not used with Scrollers, but provided for subclasses)"
444
445	^ keyboardStep
446	!
447
448	keyboardStep:aNumber
449	"set the scrollers keyboard step. If non-nil,
450	thats the stepping value used with cursorUp/cursorDown keys.
451	(not used with Scrollers, but provided for subclasses)"
452
453	keyboardStep := aNumber
454	!
455
456	start
457	"return the scrollers range min.
458	(not used with Scrollers, but provided for subclasses)"
459
460	^ rangeStart
461	!
462
463	start:start
464	"set the scrollers range min.
465	(not used with Scrollers, but provided for subclasses)"
466
467	self start:start stop:rangeEnd.
468
469	"Modified: 25.5.1996 / 11:28:22 / cg"
470	!
471
472	start:start stop:stop
473	"set the range.
474	(not used with Scrollers, but provided for subclasses)"
475
476	\|org\|
477
478	org := self thumbOrigin.
479
480	rangeStart := start.
481	rangeEnd := stop.
482
483	rangeStart = rangeEnd ifTrue:[
484	self error:'invalid slider range (start = stop)' mayProceed:true.
485	rangeEnd := rangeStart + (rangeStep ? 1).
486	].
487
488	org < rangeStart ifTrue:[
489	org := rangeStart
490	] ifFalse:[
491	org > rangeEnd ifTrue:[
492	org := rangeEnd
493	]
494	].
495	self thumbOrigin:org.
496
497	"Modified: / 21.1.1998 / 19:22:07 / cg"
498	!
499
500	start:start stop:stop step:step
501	"set the range.
502	(not used with Scrollers, but provided for subclasses)"
503
504	self start:start stop:stop.
505	rangeStep := step.
506
507	"Created: 25.5.1996 / 11:24:09 / cg"
508	"Modified: 25.5.1996 / 11:27:43 / cg"
509	!
510
511	step
512	"return the scrollers range step.
513	(not used with Scrollers, but provided for subclasses)"
514
515	^ rangeStep
516	!
517
518	step:step
519	"set the scrollers range step.
520	(not used with Scrollers, but provided for subclasses)"
521
522	rangeStep := step
523	!
524
525	stop
526	"return the scrollers range max.
527	(not used with Scrollers, but provided for subclasses)"
528
529	^ rangeEnd
530	!
531
532	stop:stop
533	"set the scrollers range max.
534	(not used with Scrollers, but provided for subclasses)"
535
536	self start:rangeStart stop:stop.
537
538	"Modified: 25.5.1996 / 11:28:35 / cg"
539	!
540
541	thumbFrame
542	"return the area used by the thumbFrame (in device coordinates).
543	Allows access to the thumbs physical screen position, for
544	example to position a label below (see Slider-Examples)"
545
546	thumbFrame isNil ifTrue:[ self computeThumbFrame].
547	^ thumbFrame
548	!
549
550	thumbHeight
551	"answer the thumbs height (in percent by default)"
552
553	^ thumbHeight * (rangeEnd - rangeStart) abs / 100
554
555	"Modified: / 21.1.1998 / 19:25:33 / cg"
556	!
557
558	thumbHeight:aNumber
559	"set the thumbs height (in percent by default)"
560
561	\|newHeight realNewHeight oldFrame nBg\|
562
563	newHeight := aNumber / ((rangeEnd - rangeStart) abs / 100).
564
565	(newHeight > 100) ifTrue:[
566	realNewHeight := 100
567	] ifFalse:[
568	realNewHeight := newHeight
569	].
570	((realNewHeight ~= thumbHeight) or:[thumbFrame isNil]) ifTrue:[
571	thumbHeight := realNewHeight.
572
573	(DefaultFullViewBackground notNil
574	and:[DefaultViewBackground notNil
575	and:[DefaultFullViewBackground ~~ DefaultViewBackground]]) ifTrue:[
576	realNewHeight >= 100 ifTrue:[
577	nBg := DefaultFullViewBackground.
578	] ifFalse:[
579	nBg := DefaultViewBackground
580	].
581	nBg := nBg onDevice:device.
582	nBg ~~ viewBackground ifTrue:[
583	self viewBackground:nBg.
584	self invalidate.
585	]
586	].
587
588	shown ifTrue:[
589	oldFrame := thumbFrame.
590	self computeThumbFrame.
591	oldFrame ~= thumbFrame ifTrue:[
592	self invalidate.
593	]
594	] ifFalse:[
595	thumbFrame := nil.
596	self invalidate.
597	].
598	]
599
600	"Modified: / 21.10.1998 / 22:35:31 / cg"
601	!
602
603	thumbOrigin
604	"answer the thumbs origin (in percent by default)"
605
606	\|org\|
607
608	org := thumbOrigin * (rangeEnd - rangeStart) / 100 + rangeStart.
609	rangeStep notNil ifTrue:[
610	org := org roundTo:rangeStep.
611	rangeStep isInteger ifTrue:[
612	org := org asInteger
613	]
614	].
615	^ org
616
617	"Modified: / 21.1.1998 / 19:13:48 / cg"
618	!
619
620	thumbOrigin:aNumber
621	"set the thumbs origin (in percent by default)"
622
623	\|org newOrigin realNewOrigin
624	oldFrame oldTop oldBot oldLeft oldRight
625	thumbTop thumbBot thumbLeft thumbRight
626	tH "{ Class: SmallInteger }"
627	tW "{ Class: SmallInteger }"
628	delta needFullDraw
629	bgLeft bgTop bgWidth bgHeight\|
630
631	aNumber isNil ifTrue:[
632	newOrigin := 0
633	] ifFalse:[
634	org := aNumber.
635	rangeStep notNil ifTrue:[
636	org := org roundTo:rangeStep.
637	rangeStep isInteger ifTrue:[
638	org := org asInteger
639	]
640	].
641	newOrigin := (org - rangeStart) asFloat / (rangeEnd - rangeStart / 100).
642	].
643
644	((newOrigin + thumbHeight) > 100) ifTrue:[
645	realNewOrigin := 100 - thumbHeight
646	] ifFalse: [
647	realNewOrigin := newOrigin
648	].
649	(realNewOrigin > 100) ifTrue:[
650	realNewOrigin := 100
651	] ifFalse: [
652	(realNewOrigin < 0) ifTrue:[
653	realNewOrigin := 0
654	]
655	].
656	((realNewOrigin ~= thumbOrigin) or:[thumbFrame isNil]) ifTrue:[
657	thumbOrigin := realNewOrigin.
658
659	shown ifTrue:[
660	oldFrame := thumbFrame.
661	self computeThumbFrame.
662	(thumbHeight = 100) ifTrue:[
663	"/ full: don't draw
664	^ self
665	].
666
667	(thumbFrame ~= oldFrame) ifTrue:[
668	oldFrame isNil ifTrue:[
669	self invalidate.
670	^ self
671	].
672	tH := thumbFrame height.
673	tW := thumbFrame width.
674
675	oldTop := oldFrame top.
676	oldBot := oldTop + tH.
677	oldLeft := oldFrame left.
678	oldRight := oldLeft + tW.
679
680	thumbTop := thumbFrame top.
681	thumbBot := thumbTop + tH.
682	thumbLeft := thumbFrame left.
683	thumbRight := thumbLeft + tW.
684
685	needFullDraw := self exposeEventPending
686	or:[((orientation == #vertical) and:[oldBot >= height])
687	or:[((orientation ~~ #vertical) and:[oldRight >= width])]].
688
689	needFullDraw ifTrue:[
690	"
691	cannot copy since thumb was below the end
692	or may be not available for the copy
693	"
694	self invalidate.
695	^ self
696	].
697
698	self catchExpose.
699	"
700	copy the thumbs pixels
701	"
702	(orientation == #vertical) ifTrue:[
703	self
704	copyFrom:self
705	x:thumbLeft y:oldTop
706	toX:thumbLeft y:thumbTop
707	width:tW height:tH
708	async:true.
709	] ifFalse:[
710	self
711	copyFrom:self
712	x:oldLeft y:thumbTop
713	toX:thumbLeft y:thumbTop
714	width:tW height:tH
715	async:true.
716	].
717
718	"
719	clear some of the previous thumbs area to background
720	"
721	(orientation == #vertical) ifTrue:[
722	bgLeft := thumbLeft.
723	bgWidth := tW.
724	oldTop > thumbTop ifTrue:[
725	delta := oldTop - thumbTop.
726	oldTop > thumbBot ifTrue:[
727	bgTop := oldTop.
728	bgHeight := tH + 1
729	] ifFalse:[
730	bgTop := thumbBot.
731	bgHeight := delta
732	]
733	] ifFalse:[
734	delta := thumbTop - oldTop.
735	oldBot < thumbTop ifTrue:[
736	bgTop := oldTop.
737	bgHeight := tH + 1
738	] ifFalse:[
739	bgTop := oldTop.
740	bgHeight := delta
741	]
742	].
743	] ifFalse:[
744	bgTop := thumbTop.
745	bgHeight := tH.
746	oldLeft > thumbLeft ifTrue:[
747	delta := oldLeft - thumbLeft.
748	oldLeft > thumbRight ifTrue:[
749	bgLeft := oldLeft.
750	bgWidth := tW + 1.
751	] ifFalse:[
752	bgLeft := thumbRight.
753	bgWidth := delta.
754	]
755	] ifFalse:[
756	delta := thumbLeft - oldLeft.
757	oldRight < thumbLeft ifTrue:[
758	bgLeft := oldLeft.
759	bgWidth := tW + 1.
760	] ifFalse:[
761	bgLeft := oldLeft.
762	bgWidth := delta.
763	]
764	].
765	].
766	self drawThumbBackgroundInX:bgLeft y:bgTop width:bgWidth height:bgHeight.
767	self waitForExpose
768	]
769	] ifFalse:[
770	thumbFrame := nil
771	]
772	]
773
774	"Modified: / 4.5.1999 / 18:57:28 / cg"
775	!
776
777	thumbOrigin:originNumber thumbHeight:heightNumber
778	"set both thumbs height and origin (in percent by default)"
779
780	\|newHeight newOrigin realNewOrigin realNewHeight old new changed
781	nBg range\|
782
783	range := rangeEnd - rangeStart.
784
785	newOrigin := (originNumber - rangeStart) / (range / 100).
786	newHeight := heightNumber / (range abs / 100).
787
788	(newHeight > 100) ifTrue:[
789	realNewHeight := 100
790	] ifFalse:[
791	realNewHeight := newHeight
792	].
793	((newOrigin + realNewHeight) > 100) ifTrue:[
794	realNewOrigin := 100 - realNewHeight
795	] ifFalse: [
796	realNewOrigin := newOrigin
797	].
798	(realNewOrigin < 0) ifTrue: [
799	realNewOrigin := 0
800	].
801
802	changed := (realNewHeight ~= thumbHeight) or:[realNewOrigin ~= thumbOrigin].
803	(changed or:[thumbFrame isNil]) ifTrue:[
804	old := self absFromPercent:thumbOrigin.
805	new := self absFromPercent:realNewOrigin.
806	changed := old ~~ new.
807	changed ifFalse:[
808	old := self absFromPercent:thumbHeight.
809	new := self absFromPercent:realNewHeight.
810	changed := (old ~~ new)
811	].
812	(changed or:[thumbFrame isNil]) ifTrue:[
813	thumbOrigin := realNewOrigin.
814	thumbHeight := realNewHeight.
815
816	(DefaultFullViewBackground notNil
817	and:[DefaultViewBackground notNil
818	and:[DefaultFullViewBackground ~~ DefaultViewBackground]]) ifTrue:[
819	realNewHeight >= 100 ifTrue:[
820	nBg := DefaultFullViewBackground.
821	] ifFalse:[
822	nBg := DefaultViewBackground
823	].
824	nBg := nBg onDevice:device.
825	nBg ~~ viewBackground ifTrue:[
826	self viewBackground:nBg.
827	]
828	].
829
830	thumbFrame := nil.
831	self invalidate.
832	]
833	]
834
835	"Modified: / 21.1.1998 / 19:32:41 / cg"
836	!
837
838	virtualModelValue
839	^ virtualModelValue
840
841	"Modified (format): / 05-01-2017 / 13:48:27 / svestkap"
842	!
843
844	virtualModelValue:aNumber
845	virtualModelValue := aNumber.
846
847	"Modified (format): / 05-01-2017 / 13:48:32 / svestkap"
848	! !
849
850	!Scroller methodsFor:'accessing-behavior'!
851
852	action:aBlock
853	"for protocol compatibility; same as scrollAction:"
854
855	self scrollAction:aBlock
856	!
857
858	asynchronousOperation
859	<resource:#obsolete>
860	self obsoleteMethodWarning:'use #beAsynchronous'.
861	self beAsynchronous
862	!
863
864	beAsynchronous
865	"set scroll-mode to be asynchronous - scroll action is only performed after
866	scrolling, when mouse-button is finally released (no tracking)."
867
868	synchronousOperation := false
869
870	"Modified: / 12-12-2016 / 13:16:38 / svestkap"
871	!
872
873	beSynchronous
874	"set scroll-mode to be synchronous - scroll action is performed for
875	every movement of thumb (tracking)."
876
877	synchronousOperation := true
878	!
879
880	enabled
881	"return enable/disable state of the scoller"
882
883	^ enabled
884
885	"Created: / 30.3.1999 / 15:24:50 / stefan"
886	!
887
888	enabled:aBoolean
889	"enable/disable the scoller"
890
891	enabled ~~ aBoolean ifTrue:[
892	enabled := aBoolean.
893	self updateBackground.
894	aBoolean ifFalse:[
895	self cursor: Cursor normal
896	]
897	]
898
899	"Created: / 30.3.1999 / 15:23:14 / stefan"
900	!
901
902	isSynchronous
903	"return true if the scroll-mode is synchronous.
904	If true, the scroll action is performed for every movement of the thumb (tracking).
905	If false, the scroll action is only performed at the end."
906
907	^ synchronousOperation
908	!
909
910	scrollAction
911	"answer the scroll action block"
912
913	^ scrollAction
914	!
915
916	scrollAction:aBlock
917	"set the scroll action, aBlock which is evaluated when scrolled"
918
919	scrollAction := aBlock
920	!
921
922	scrollDownAction:aBlock
923	"ignored -
924	but implemented, so that scroller can be used in place of a scrollbar"
925	!
926
927	scrollLeftAction:aBlock
928	"ignored -
929	but implemented, so that scroller can be used in place of a scrollbar"
930	!
931
932	scrollRightAction:aBlock
933	"ignored -
934	but implemented, so that scroller can be used in place of a scrollbar"
935	!
936
937	scrollUpAction:aBlock
938	"ignored -
939	but implemented, so that scroller can be used in place of a scrollbar"
940	!
941
942	synchronousOperation
943	<resource:#obsolete>
944	self obsoleteMethodWarning:'use #beSynchronous'.
945	self beSynchronous
946	! !
947
948	!Scroller methodsFor:'accessing-bg & border'!
949
950	allViewBackground:something if:condition
951	"ignore here for all scrollers (I want my own background)"
952
953	"/ ^ super allViewBackground:something
954	! !
955
956	!Scroller methodsFor:'accessing-look'!
957
958	is3D
959	"return true, if I use a 3D style"
960
961	<resource: #style (#name)>
962
963	styleSheet name = #mswindows ifTrue:[^ true].
964	^ super is3D
965
966	"Modified: 17.1.1997 / 23:21:42 / cg"
967	!
968
969	orientation
970	"return the scrollers orientation (#vertical or #horizontal)"
971
972	^ orientation
973	!
974
975	orientation:aSymbol
976	"set the scrollers orientation (#vertical or #horizontal)"
977
978	\|oldFrame\|
979
980	orientation := aSymbol.
981	preferredExtent := nil.
982
983	shown ifTrue:[
984	oldFrame := thumbFrame.
985	self computeThumbFrame.
986
987	oldFrame ~= thumbFrame ifTrue:[
988	self invalidate.
989	]
990	]
991
992	"Created: 1.4.1997 / 12:18:32 / cg"
993	"Modified: 1.4.1997 / 12:20:46 / cg"
994	!
995
996	thumb
997	"for compatibility with scrollBars, return the receiver"
998
999	^ self
1000
1001	"Created: 26.5.1996 / 12:21:12 / cg"
1002	!
1003
1004	thumbColor
1005	"return the thumbs color"
1006
1007	^ thumbColor
1008	!
1009
1010	thumbColor:aColor
1011	"change the color of the thumb"
1012
1013	<resource: #style (#name)>
1014
1015	\|avgColor graphicsDevice\|
1016
1017	graphicsDevice := device.
1018	thumbColor := aColor onDevice:graphicsDevice.
1019	(styleSheet name ~~ #normal) ifTrue:[
1020	avgColor := aColor averageColorIn:(0@0 corner:7@7).
1021	thumbShadowColor := avgColor darkened onDevice:graphicsDevice.
1022	thumbLightColor := avgColor lightened onDevice:graphicsDevice.
1023	thumbHalfShadowColor := thumbShadowColor darkened onDevice:graphicsDevice.
1024	thumbHalfLightColor := thumbLightColor lightened onDevice:graphicsDevice.
1025	].
1026	self invalidate
1027
1028	"Modified: 8.2.1997 / 15:15:58 / cg"
1029	! !
1030
1031	!Scroller methodsFor:'autoRepeat'!
1032
1033	installRepeat
1034	self installRepeat:repeatDelay.
1035	!
1036
1037	installRepeat:repeatDelay
1038	\|repeatBlockCopy\|
1039
1040	"protect against races"
1041	repeatBlockCopy := repeatBlock.
1042	repeatBlockCopy notNil ifTrue:[
1043	self repairDamage.
1044	Processor addTimedBlock:repeatBlockCopy afterSeconds:repeatDelay
1045	]
1046	!
1047
1048	pagedAbovePointer
1049	lastMousePosition notNil ifTrue:[
1050	orientation == #horizontal ifTrue:[
1051	^ lastMousePosition x > thumbFrame center x
1052	] ifFalse:[
1053	^ lastMousePosition y > thumbFrame center y
1054	].
1055	].
1056	^ false.
1057	!
1058
1059	pagedBelowPointer
1060	lastMousePosition notNil ifTrue:[
1061	thumbFrame isNil ifTrue:[
1062	self computeThumbFrame.
1063	thumbFrame isNil ifTrue:[^ false].
1064	].
1065	orientation == #horizontal ifTrue:[
1066	^ lastMousePosition x < thumbFrame center x
1067	] ifFalse:[
1068	^ lastMousePosition y < thumbFrame center y
1069	].
1070	].
1071	^ false.
1072	!
1073
1074	repeatPageDown
1075	repeatBlock notNil ifTrue:[
1076	"stop scroll"
1077	(DefaultStopPagerAtThumb and:[self pagedBelowPointer]) ifTrue:[^ self].
1078	self repairDamage.
1079	self pageDown.
1080	self installRepeat.
1081	]
1082	!
1083
1084	repeatPageUp
1085	repeatBlock notNil ifTrue:[
1086	"stop scroll"
1087	(DefaultStopPagerAtThumb and:[self pagedAbovePointer]) ifTrue:[^ self].
1088	self repairDamage.
1089	self pageUp.
1090	self installRepeat.
1091	]
1092	! !
1093
1094	!Scroller methodsFor:'drawing'!
1095
1096	drawEdgedLineFrom:x1 y:y1 toX:x2 y:y2 level:lvl lightColor:lightColor shadowColor:shadowColor
1097	\|color1 color2 x y dl\|
1098
1099	"iris style - draw tallys"
1100
1101	lvl > 0 ifTrue:[
1102	color1 := lightColor.
1103	color2 := shadowColor.
1104	] ifFalse:[
1105	color1 := shadowColor.
1106	color2 := lightColor.
1107	].
1108
1109	dl := 1.
1110
1111	self paint:color1.
1112	x1 = x2 ifTrue:[
1113	"/ vertical
1114	self displayLineFromX:x1 y:y1-dl toX:x2 y:y2-dl.
1115	self paint:color2.
1116	x := x1 + 1.
1117	self displayLineFromX:x y:y1 toX:x y:y2.
1118	] ifFalse:[
1119	"/ horizontal
1120	self displayLineFromX:x1-dl y:y1 toX:x2-dl y:y2.
1121	self paint:color2.
1122	y := y1 + 1.
1123	self displayLineFromX:x1 y:y toX:x2 y:y.
1124	].
1125	!
1126
1127	drawHandleFormAtX:x y:y
1128	"styles with a handle in the middle (NeXT) use this"
1129
1130	thumbShadowColor := thumbShadowColor onDevice:device.
1131
1132	self paint:thumbShadowColor.
1133	self displayForm:shadowForm x:x y:y.
1134	lightForm notNil ifTrue:[
1135	thumbLightColor := thumbLightColor onDevice:device.
1136	self paint:thumbLightColor.
1137	self displayForm:lightForm x:x y:y.
1138	].
1139
1140	"Modified: / 19.5.1998 / 16:26:49 / cg"
1141	!
1142
1143	drawTallyMarks
1144	"draw the thumb"
1145
1146	\|color1 color2
1147	lvl "{ Class: SmallInteger }"
1148	t "{ Class: SmallInteger }"
1149	l "{ Class: SmallInteger }"
1150	w "{ Class: SmallInteger }"
1151	h "{ Class: SmallInteger }"
1152	x "{ Class: SmallInteger }"
1153	y "{ Class: SmallInteger }"
1154	xL xR yT yB dist yTop yBot xLeft xRight
1155	light shadow\|
1156
1157	"iris style - draw tallys"
1158
1159	lvl := thumbLevel.
1160	scrolling ifTrue:[
1161	lvl := thumbActiveLevel
1162	].
1163
1164	thumbFrame isNil ifTrue:[^ self].
1165	w := thumbFrame width.
1166	h := thumbFrame height.
1167	l := thumbFrame left.
1168	t := thumbFrame top.
1169
1170	light := thumbLightColor.
1171	shadow := thumbShadowColor.
1172	(styleSheet at:#'scroller.vista3DStyle' default:false) "styleSheet name == #winVista" ifTrue:[
1173	light := (entered ifTrue:[thumbEnteredColor] ifFalse:[thumbColor]) lightened.
1174	shadow := (entered ifTrue:[thumbEnteredColor] ifFalse:[thumbColor]) darkened.
1175	].
1176
1177	tallyLevel > 0 ifTrue:[
1178	color1 := light.
1179	color2 := shadow.
1180	] ifFalse:[
1181	color1 := shadow.
1182	color2 := light.
1183	].
1184
1185	"draw tally marks"
1186
1187	(orientation == #vertical) ifTrue:[
1188	y := t + (h // 2) - 1.
1189	xL := l + lvl - 1 + DefaultTallyInset.
1190	xR := l + w - lvl + 1 - DefaultTallyInset.
1191
1192	dist := DefaultTallyDistance ? device verticalPixelPerMillimeter rounded.
1193
1194	tallyMarks even ifTrue:[
1195	yTop := y - (dist // 2).
1196	yBot := y + (dist - (dist // 2)).
1197	self drawEdgedLineFrom:xL y:yTop toX:xR y:yTop level:tallyLevel lightColor:light shadowColor:shadow.
1198	self drawEdgedLineFrom:xL y:yBot toX:xR y:yBot level:tallyLevel lightColor:light shadowColor:shadow.
1199	] ifFalse:[
1200	self drawEdgedLineFrom:xL y:y toX:xR y:y level:tallyLevel lightColor:light shadowColor:shadow.
1201	yTop := yBot := y.
1202	].
1203
1204	tallyMarks > 1 ifTrue:[
1205	"dont draw other marks if there is not enough space"
1206
1207	h > (dist * (tallyMarks * 2)) ifTrue:[
1208	self drawEdgedLineFrom:xL y:(yTop - dist) toX:xR y:(yTop - dist) level:tallyLevel lightColor:light shadowColor:shadow.
1209	self drawEdgedLineFrom:xL y:(yBot + dist) toX:xR y:(yBot + dist) level:tallyLevel lightColor:light shadowColor:shadow.
1210	]
1211	]
1212	] ifFalse:[
1213	x := l + (w // 2) - 1.
1214	yT := t + lvl - 1 + DefaultTallyInset.
1215	yB := t + h - lvl + 1 - DefaultTallyInset.
1216
1217	dist := DefaultTallyDistance ? device horizontalPixelPerMillimeter rounded.
1218
1219	tallyMarks even ifTrue:[
1220	xLeft := x - (dist // 2).
1221	xRight := x + (dist - (dist // 2)).
1222	self drawEdgedLineFrom:xLeft y:yT toX:xLeft y:yB level:tallyLevel lightColor:light shadowColor:shadow.
1223	self drawEdgedLineFrom:xRight y:yT toX:xRight y:yB level:tallyLevel lightColor:light shadowColor:shadow.
1224	] ifFalse:[
1225	self drawEdgedLineFrom:x y:yT toX:x y:yB level:tallyLevel lightColor:light shadowColor:shadow.
1226	xLeft := xRight := x.
1227	].
1228	tallyMarks > 1 ifTrue:[
1229	"dont draw other marks if there is not enough space"
1230
1231	w > (dist * (tallyMarks * 2)) ifTrue:[
1232	self drawEdgedLineFrom:(xLeft - dist) y:yT toX:(xLeft - dist) y:yB level:tallyLevel lightColor:light shadowColor:shadow.
1233	self drawEdgedLineFrom:(xRight + dist) y:yT toX:(xRight + dist) y:yB level:tallyLevel lightColor:light shadowColor:shadow.
1234	]
1235	]
1236	]
1237
1238	"Modified: / 29.4.1999 / 09:35:52 / cg"
1239	!
1240
1241	drawThumb
1242	"draw the thumb"
1243
1244	\|handleX handleY l t lvl
1245	w "{ Class: SmallInteger }"
1246	h "{ Class: SmallInteger }"
1247	clr clr2 styleName xpStyle vistaStyle n frameImageOrNil frameImage\|
1248
1249	(thumbHeight >= 100) ifTrue:[^ self].
1250	thumbFrame isNil ifTrue:[^ self].
1251
1252	styleName := styleSheet name.
1253	xpStyle := styleName == #winXP.
1254	vistaStyle := styleSheet at:#'scroller.vista3DStyle' default:false. "/ styleName == #winVista.
1255
1256	w := thumbFrame width.
1257	h := thumbFrame height.
1258	l := thumbFrame left.
1259	t := thumbFrame top.
1260
1261	(scrolling and:[thumbActiveColor notNil]) ifTrue:[
1262	clr := thumbActiveColor
1263	] ifFalse:[
1264	clr := entered
1265	ifTrue:[thumbEnteredColor]
1266	ifFalse:[thumbColor].
1267	].
1268
1269	clr notNil ifTrue:[
1270	(styleSheet at:#'scroller.vista3DStyle' default:false) ifTrue:[
1271	"/ color gradient drawing
1272	"/ with colors rougly smilar to the vista colors, which are:
1273	"/ 243 242 240 236 234 233 215 211 207 205 200 192 206
1274	clr2 := styleSheet colorAt:#'scroller.vista3DStyleLightColor' default:Color white.
1275
1276	(orientation == #vertical) ifTrue:[
1277	n := w
1278	] ifFalse:[
1279	n := h
1280	].
1281	1 to:n-1 do:[:i \|
1282	\|m\|
1283
1284	i == (n-1) ifTrue:[
1285	m := 0.4.
1286	] ifFalse:[
1287	i <= (n//2) ifTrue:[
1288	i <= (n//4) ifTrue:[
1289	m := 3.
1290	] ifFalse:[
1291	i <= (n//3) ifTrue:[
1292	m := 2.5.
1293	] ifFalse:[
1294	m := 2.
1295	].
1296	].
1297	] ifFalse:[
1298	i > (n*3//4) ifTrue:[
1299	i > (n*4//5) ifTrue:[
1300	m := 0.
1301	] ifFalse:[
1302	m := 0.2.
1303	]
1304	] ifFalse:[
1305	i > (n*2//3) ifTrue:[
1306	m := 0.4
1307	] ifFalse:[
1308	m := 0.8.
1309	].
1310	].
1311	].
1312	].
1313	self paint:(clr2 mixed:m with:clr).
1314	(orientation == #vertical) ifTrue:[
1315	self displayLineFromX:(l+i-1) y:t+1 toX:(l+i-1) y:(t+h-2)
1316	] ifFalse:[
1317	self displayLineFromX:(l+1) y:(t+i-1) toX:(l+w-2) y:(t+i-1)
1318	].
1319	].
1320	] ifFalse:[
1321	self paint:clr.
1322	(xpStyle and:[self isMiniScroller not]) ifTrue:[
1323	"/ hack for xp
1324	(orientation == #vertical) ifTrue:[
1325	self fillRectangleX:l y:t+1 width:w-2 height:h-4.
1326	] ifFalse:[
1327	self fillRectangleX:l+1 y:t width:w-4 height:h-2.
1328	]
1329	] ifFalse:[
1330	(styleSheet at:#'scroller.roundStyle' default:false) ifTrue:[
1331	"/ hack for osx
1332	(orientation == #vertical) ifTrue:[
1333	1 to:3 do:[:i \|
1334	\|yLine left right\|
1335
1336	left := l+i-1.
1337	right := l+w-i+1.
1338	yLine := t+3-i.
1339	self displayLineFromX:left y:yLine toX:right y:yLine.
1340	yLine := t+h-3-1+i.
1341	self displayLineFromX:left y:yLine toX:right y:yLine.
1342	].
1343	self fillRectangleX:l y:t+3 width:w height:h-6.
1344	] ifFalse:[
1345	1 to:3 do:[:i \|
1346	\|xLine top bot\|
1347
1348	top := t+i-1.
1349	bot := t+h-i+1.
1350	xLine := l+3-i.
1351	self displayLineFromX:xLine y:top toX:xLine y:bot.
1352	xLine := l+w-3-1+i.
1353	self displayLineFromX:xLine y:top toX:xLine y:bot.
1354	].
1355	self fillRectangleX:l+3 y:t width:w-6 height:h.
1356	].
1357	] ifFalse:[
1358	self fillRectangleX:l y:t width:w height:h.
1359	].
1360	].
1361	].
1362	].
1363	lvl := thumbLevel.
1364	scrolling ifTrue:[
1365	lvl := thumbActiveLevel
1366	].
1367
1368	lvl ~~ 0 ifTrue:[
1369	self drawEdgesForX:l y:t width:w height:h level:lvl
1370	shadow:thumbShadowColor light:thumbLightColor
1371	halfShadow:thumbHalfShadowColor halfLight:thumbHalfLightColor
1372	style:thumbEdgeStyle.
1373	].
1374	frameImageOrNil := (orientation == #vertical)
1375	ifTrue:[ DefaultVerticalThumbFrameImage ]
1376	ifFalse:[ DefaultHorizontalThumbFrameImage ].
1377	frameImageOrNil notNil ifTrue:[
1378	frameImage := frameImageOrNil magnifiedTo:(w @ h).
1379	frameImage displayOn:self x:l y:t
1380	].
1381
1382	self isMiniScroller ifTrue:[^ self].
1383
1384	thumbFrameColor notNil ifTrue:[
1385	clr2 := styleSheet colorAt:#'scroller.thumbFrameColor2'.
1386	clr2 notNil ifTrue:[
1387	self paint:clr2.
1388	(orientation == #vertical) ifTrue:[
1389	self displayLineFromX:l+w-2 y:t+1 toX:l+w-2 y:t+h-3.
1390	self displayLineFromX:l y:t+h-3 toX:l+w-2 y:t+h-3.
1391	] ifFalse:[
1392	self displayLineFromX:l+2 y:t+h-2 toX:l+w-3 y:t+h-2.
1393	self displayLineFromX:l+w-3 y:t toX:l+w-3 y:t+h-2.
1394	].
1395	].
1396
1397	vistaStyle ifTrue:[
1398	self paint:clr slightlyDarkened.
1399	] ifFalse:[
1400	self paint:thumbFrameColor.
1401	].
1402	xpStyle ifTrue:[
1403	(orientation == #vertical) ifTrue:[
1404	self displayLineFromX:l+w-1 y:t+1 toX:l+w-1 y:t+h-3.
1405	self displayLineFromX:l+1 y:t+h-2 toX:l+w-2 y:t+h-2.
1406	self displayLineFromX:l+w-2 y:t+h-3 toX:l+w-2 y:t+h-3.
1407	"/ self displayLineFromX:l-2 y:t+h-3 toX:l-2 y:t+h-3.
1408	] ifFalse:[
1409	self displayLineFromX:l+2 y:t+h-1 toX:l+w-3 y:t+h-1.
1410	self displayLineFromX:l+w-2 y:t+1 toX:l+w-2 y:t+h-2.
1411	self displayLineFromX:l+w-3 y:t+h-2 toX:l+w-3 y:t+h-2.
1412	].
1413	] ifFalse:[
1414	h := h - 1.
1415	self displayRectangleX:l y:t width:w height:h.
1416	].
1417	vistaStyle ifTrue:[
1418	self paint:clr lightened.
1419	self displayPointX:l y:t.
1420	self displayPointX:l+w-1 y:t.
1421	self displayPointX:l y:t+h-1.
1422	self displayPointX:l+w-1 y:t+h-1.
1423	].
1424	].
1425
1426	thumbImage notNil ifTrue:[
1427	thumbImage displayOn:self x:l y:t
1428	].
1429
1430	(false "tallyLevel == 0" or:[tallyMarks == 0]) ifTrue:[
1431	shadowForm notNil ifTrue:[
1432	"next style - draw tally bitmap"
1433	handleX := l + ((w - 8) // 2).
1434	handleY := t + ((h - 8) // 2).
1435	self drawHandleFormAtX:handleX y:handleY
1436	].
1437	^ self
1438	].
1439
1440	"iris style - draw tallys"
1441	self drawTallyMarks.
1442
1443	"Modified: / 29-11-2011 / 11:55:24 / cg"
1444	!
1445
1446	drawThumbBackgroundInX:x y:y width:w height:h
1447	"draw part of the thumbs background; defined as a separate
1448	method, to allow drawing of arbitrary patterns under thumb
1449	(see ColorSlider)."
1450
1451	\|oldClip gX gY gW gH\|
1452
1453	shown ifTrue:[
1454	oldClip := self clippingRectangleOrNil.
1455	self clippingRectangle:(Rectangle left:x top:y width:w height:h).
1456	self clearDeviceRectangleX:x y:y width:w height:h.
1457
1458	styleSheet name == #winVista ifTrue:[
1459	self paint:(Color greyByte:16rE3).
1460	(orientation == #vertical) ifTrue:[
1461	self displayLineFromX:0 y:0 toX:0 y:height-1.
1462	self displayLineFromX:1 y:0 toX:1 y:height-1.
1463	] ifFalse:[
1464	self displayLineFromX:0 y:0 toX:width-1 y:0.
1465	self displayLineFromX:0 y:1 toX:width-1 y:1.
1466	].
1467	].
1468
1469	frameBeforeMove notNil ifTrue:[
1470	(ghostColor notNil
1471	or:[ghostFrameColor notNil
1472	or:[ghostLevel ~~ 0]]) ifTrue:[
1473	(frameBeforeMove intersects:(x@y extent:w@h)) ifTrue:[
1474	gX := frameBeforeMove left.
1475	gY := frameBeforeMove top.
1476	gW := frameBeforeMove width.
1477	gH := frameBeforeMove height.
1478
1479	ghostColor notNil ifTrue:[
1480	self paint:ghostColor.
1481	self fillRectangle:frameBeforeMove.
1482	].
1483	(ghostLevel ~~ 0) ifTrue:[
1484	self drawEdgesForX:gX y:gY width:gW height:gH level:ghostLevel
1485	].
1486	ghostFrameColor notNil ifTrue:[
1487	self paint:ghostFrameColor.
1488	self displayRectangleX:gX y:gY width:gW height:gH
1489	].
1490	]
1491	]
1492	].
1493	self clippingRectangle:oldClip
1494	]
1495
1496	"Modified: / 4.5.1999 / 18:51:53 / cg"
1497	! !
1498
1499	!Scroller methodsFor:'event handling'!
1500
1501	buttonControlPress:button x:x y:y
1502	"mouse-click with control - jump to top/bottom"
1503
1504	\|curr limit1 limit2\|
1505
1506	thumbFrame isNil ifTrue:[
1507	self computeThumbFrame.
1508	thumbFrame isNil ifTrue:[
1509	^ self.
1510	]
1511	].
1512	(orientation == #vertical) ifTrue:[
1513	curr := y.
1514	limit1 := thumbFrame top.
1515	limit2 := thumbFrame bottom
1516	] ifFalse:[
1517	curr := x.
1518	limit1 := thumbFrame left.
1519	limit2 := thumbFrame right
1520	].
1521
1522	(curr < limit1) ifTrue:[
1523	"to top"
1524	self thumbOrigin:0.
1525	self tellOthers
1526	] ifFalse:[
1527	(curr > limit2) ifTrue:[
1528	"to bottom"
1529	self thumbOrigin:100.
1530	self tellOthers
1531	]
1532	].
1533	!
1534
1535	buttonMotion:state x:x y:y
1536	"mouse-button was moved while pressed;
1537	redraw thumb at its new position and, if scroll-mode is asynchronous,
1538	the scroll action is performed"
1539
1540	<resource: #style (#name
1541	#'scroller.snapBack')>
1542
1543	\|pos curr limit prevOrigin newOrigin snap\|
1544
1545	lastMousePosition := x@y.
1546
1547	(self sensor hasButtonMotionEventFor:self) ifTrue:[
1548	^ self.
1549	].
1550
1551	enabled ifFalse:[^ self].
1552
1553	scrolling ifFalse: [
1554	thumbFrame notNil ifTrue:[
1555	self highlightThumbForPointerX:x y:y.
1556	].
1557	^ self
1558	].
1559
1560	entered := true.
1561	frameBeforeMove isNil ifTrue:[
1562	self startMove.
1563	].
1564
1565	(orientation == #vertical) ifTrue:[
1566	curr := y.
1567	limit := height.
1568	snap := (x < SnapBackDistance negated) or:[x > (width + SnapBackDistance)].
1569	] ifFalse:[
1570	curr := x.
1571	limit := width.
1572	snap := (y < SnapBackDistance negated) or:[y > (height + SnapBackDistance)].
1573	].
1574
1575	(curr < 0) ifTrue:[ "check against limits"
1576	pos := 0
1577	] ifFalse:[
1578	(curr > limit) ifTrue:[
1579	pos := limit
1580	] ifFalse:[
1581	pos := curr
1582	]
1583	].
1584
1585	prevOrigin := self thumbOrigin.
1586	newOrigin := self percentFromAbs:(pos - pressOffset).
1587
1588	snap ifTrue:[
1589	(styleSheet at:#'scroller.snapBack' default:false) ifTrue:[
1590	newOrigin := originBeforeMove.
1591	]
1592	].
1593
1594	prevOrigin ~= newOrigin ifTrue:[
1595	self thumbOrigin:newOrigin.
1596
1597	synchronousOperation ifTrue: [
1598	self tellOthers.
1599	]
1600	]
1601
1602	"Modified: / 14.4.1998 / 18:37:34 / cg"
1603	!
1604
1605	buttonPress:button x:x y:y
1606	"button was pressed - if above thumb, page up; if below thumb, page down;
1607	otherwise start scrolling.
1608	If either shift is pressed, or the 'scrollerMiddleButtonJump' styleSheet
1609	value is true and its the middle button, do a jump to the clicked position."
1610
1611	\|curr limit1 limit2 sensor\|
1612
1613	enabled ifFalse:[^ self].
1614	shown ifFalse:[^ self].
1615	scrolling ifTrue:[^ self].
1616	"/virtualRange isNil ifTrue:[virtualRange := (rangeEnd-rangeStart)/2.].
1617
1618	sensor := self sensor.
1619	(sensor shiftDown
1620	or:[DefaultMiddleButtonJump and:[button ~~ 1]]) ifTrue:[
1621	^ self buttonShiftPress:button x:x y:y
1622	].
1623	sensor ctrlDown ifTrue:[
1624	^ self buttonControlPress:button x:x y:y
1625	].
1626	(button ~~ #select and:[button ~~ 1]) ifTrue:[
1627	^ self
1628	].
1629
1630	thumbFrame isNil ifTrue:[
1631	self computeThumbFrame.
1632	thumbFrame isNil ifTrue:[^ self].
1633	].
1634
1635	(orientation == #vertical) ifTrue:[
1636	curr := y.
1637	limit1 := thumbFrame top.
1638	limit2 := thumbFrame bottom
1639	] ifFalse:[
1640	curr := x.
1641	limit1 := thumbFrame left.
1642	limit2 := thumbFrame right
1643	].
1644
1645	self highlightThumbForPointerX:x y:y.
1646	self changeCursorFor:(x@y).
1647
1648	(curr < limit1) ifTrue:[
1649	"page up/left"
1650	self moveLeft.
1651	autoRepeat ifTrue:[
1652	repeatBlock notNil ifTrue:[
1653	Processor removeTimedBlock:repeatBlock.
1654	].
1655	repeatBlock := [self sensor pushUserEvent:#repeatPageUp for:self].
1656	sensor pushUserEvent:#installRepeat: for:self withArgument:initialRepeatDelay.
1657	]
1658	] ifFalse:[
1659	(curr > limit2) ifTrue:[
1660	"page down/right"
1661	self moveRight.
1662	autoRepeat ifTrue:[
1663	repeatBlock notNil ifTrue:[
1664	Processor removeTimedBlock:repeatBlock.
1665	].
1666	repeatBlock := [self sensor pushUserEvent:#repeatPageDown for:self].
1667	sensor pushUserEvent:#installRepeat: for:self withArgument:initialRepeatDelay.
1668	]
1669	] ifFalse:[
1670	pressOffset := curr - limit1.
1671	scrolling := true.
1672	(thumbActiveColor notNil and:[thumbColor ~~ thumbActiveColor]) ifTrue:[
1673	self drawThumb
1674	]
1675	]
1676	].
1677
1678	"Modified: / 02-02-1998 / 23:30:26 / stefan"
1679	"Modified: / 15-12-2010 / 10:13:10 / cg"
1680	"Modified (format): / 04-01-2017 / 13:29:34 / svestkap"
1681	!
1682
1683	buttonRelease:button x:x y:y
1684	"mouse-button was released - if scroll-mode is asynchronous, the scroll
1685	action is now performed"
1686
1687	\|rect mustDrawThumb\|
1688
1689	lastMousePosition := nil.
1690
1691	repeatBlock notNil ifTrue:[
1692	repeatBlock := nil.
1693	Processor removeTimedBlock:repeatBlock.
1694	repeatBlock := nil
1695	].
1696
1697	(button == 1 or:[DefaultMiddleButtonJump])
1698	ifFalse:[
1699	^ super buttonRelease:button x:x y:y
1700	].
1701
1702
1703	scrolling ifTrue:[
1704	scrolling := false.
1705	thumbFrame notNil ifTrue:[
1706	mustDrawThumb := false.
1707
1708	frameBeforeMove notNil ifTrue:[
1709	rect := frameBeforeMove.
1710	frameBeforeMove := nil.
1711	self drawThumbBackgroundInX:rect left
1712	y:rect top
1713	width:rect width
1714	height:rect height.
1715
1716	(rect intersects:thumbFrame) ifTrue:[
1717	mustDrawThumb := true.
1718	]
1719	].
1720	thumbLevel ~~ thumbActiveLevel ifTrue:[
1721	mustDrawThumb := true
1722	].
1723	(thumbActiveColor notNil and:[thumbColor ~~ thumbActiveColor]) ifTrue:[
1724	mustDrawThumb := true
1725	].
1726	mustDrawThumb ifTrue:[
1727	self drawThumb
1728	].
1729
1730	"/ scrolling := false.
1731	synchronousOperation ifFalse: [
1732	self tellOthers.
1733	]
1734	]
1735	].
1736	self changeCursorFor:(x@y)
1737
1738	"Modified: / 19-01-1998 / 13:45:59 / cg"
1739	"Modified: / 02-02-1998 / 23:37:27 / stefan"
1740	"Modified: / 02-01-2017 / 13:51:29 / svestkap"
1741	!
1742
1743	buttonShiftPress:button x:x y:y
1744	"mouse-click with shift - jump to position"
1745
1746	\|pos curr curr2 limit1 limit2\|
1747
1748	thumbFrame isNil ifTrue:[
1749	self computeThumbFrame.
1750	thumbFrame isNil ifTrue:[
1751	^ self.
1752	]
1753	].
1754	(orientation == #vertical) ifTrue:[
1755	curr := y.
1756	curr2 := y - (thumbFrame height // 2).
1757	limit1 := height.
1758	limit2 := thumbFrame top
1759	] ifFalse:[
1760	curr := x.
1761	curr2 := x - (thumbFrame width // 2).
1762	limit1 := width.
1763	limit2 := thumbFrame left
1764	].
1765
1766	(curr2 < 0) ifTrue:[ "check against limits"
1767	pos := 0
1768	] ifFalse:[
1769	(curr2 > limit1) ifTrue:[
1770	pos := limit1
1771	] ifFalse:[
1772	pos := curr2
1773	]
1774	].
1775
1776	self startMove.
1777
1778	self thumbOrigin:(self percentFromAbs:pos).
1779	self tellOthers.
1780
1781	(orientation == #vertical) ifTrue:[
1782	limit2 := thumbFrame top
1783	] ifFalse:[
1784	limit2 := thumbFrame left
1785	].
1786	pressOffset := curr - limit2.
1787	scrolling := true.
1788
1789	self changeCursorFor:(x@y).
1790
1791
1792	"Modified: / 19.3.1997 / 11:29:08 / cg"
1793	"Modified: / 2.2.1998 / 23:35:18 / stefan"
1794	!
1795
1796	changeCursorFor:p
1797	"update the mouse cursor"
1798
1799	\|frm sensor which\|
1800
1801	enabled ifFalse:[
1802	self cursor:Cursor normal.
1803	^ self
1804	].
1805	NewCursors ifFalse:[^ self].
1806
1807	frm := self thumbFrame.
1808	frm isNil ifTrue:[^ self].
1809
1810	thumbHeight = 100 ifTrue:[
1811	which := #normal.
1812	] ifFalse:[
1813	sensor := self sensor.
1814
1815	(((frm containsPoint:p) and:[sensor leftButtonPressed])
1816	"or:[sensor shiftDown]") ifTrue:[
1817	orientation == #horizontal ifTrue:[
1818	which := #xMarker
1819	] ifFalse:[
1820	which := #marker
1821	].
1822	] ifFalse:[
1823	orientation == #horizontal ifTrue:[
1824	p x > frm right ifTrue:[
1825	which := #right
1826	] ifFalse:[
1827	p x < frm left ifTrue:[
1828	which := #left
1829	] ifFalse:[
1830	which := #hand
1831	]
1832	]
1833	] ifFalse:[
1834	p y > frm bottom ifTrue:[
1835	which := #down
1836	] ifFalse:[
1837	p y < frm top ifTrue:[
1838	which := #up
1839	] ifFalse:[
1840	which := #hand
1841	]
1842	]
1843	]
1844	]
1845	].
1846	self cursor:(Cursor perform:which).
1847
1848	"Created: / 23.10.1997 / 03:55:24 / cg"
1849	"Modified: / 7.5.1998 / 02:06:10 / cg"
1850	!
1851
1852	highlightThumbForPointerX:x y:y
1853	"if x/y is within the thumb frame, highlight it"
1854
1855	\|frm in\|
1856
1857	in := (frm := self thumbFrame) containsPoint:(x@y).
1858	(in ~~ entered
1859	or:[thumbLevel ~~ thumbActiveLevel]) ifTrue:[
1860	entered := in.
1861	(thumbColor ~~ thumbEnteredColor
1862	or:[thumbLevel ~~ thumbActiveLevel]) ifTrue: [
1863	self drawThumb
1864	].
1865	].
1866
1867	self changeCursorFor:(x@y)
1868
1869	"Created: 6.3.1996 / 17:35:07 / cg"
1870	"Modified: 23.10.1997 / 03:56:31 / cg"
1871	!
1872
1873	keyPress:key x:x y:y
1874	"/ stupid - due to delegation, this is never invoked ...
1875	enabled ifFalse:[^ self].
1876
1877	self changeCursorFor:(x@y).
1878	super keyPress:key x:x y:y
1879
1880	"Created: 23.10.1997 / 03:57:34 / cg"
1881	!
1882
1883	keyRelease:key x:x y:y
1884	"/ stupid - due to delegation, this is never invoked ...
1885	self changeCursorFor:(x@y).
1886	super keyRelease:key x:x y:y
1887
1888	"Created: 23.10.1997 / 03:58:25 / cg"
1889	!
1890
1891	pointerEnter:state x:x y:y
1892	"mouse-button left view
1893	redraw thumb if enteredColor ~~ thumbColor"
1894
1895	scrolling ifTrue:[
1896	(state bitAnd:(device anyButtonMotionMask)) == 0 ifTrue: [
1897	self buttonRelease:1 x:x y:y
1898	].
1899	].
1900	super pointerEnter:state x:x y:y
1901
1902	"Modified: / 14.10.1998 / 15:40:51 / cg"
1903	!
1904
1905	pointerLeave:state
1906	"mouse-button left view
1907	redraw thumb if enteredColor ~~ thumbColor"
1908
1909	(entered and:[(state bitAnd:(device anyButtonMotionMask)) == 0]) ifTrue: [
1910	entered := false.
1911	thumbEnteredColor ~= thumbColor ifTrue:[
1912	self invalidate.
1913	"/ self drawThumb
1914	]
1915	].
1916
1917	"Created: / 6.3.1996 / 17:31:16 / cg"
1918	"Modified: / 11.9.1998 / 00:13:53 / cg"
1919	!
1920
1921	redraw
1922	"redraw"
1923
1924	self redrawX:0 y:0 width:width height:height.
1925	self redrawEdges
1926
1927	"Modified: / 18-07-2016 / 13:26:45 / svestkap"
1928	!
1929
1930	redrawX:x y:y width:w height:h
1931	shown ifFalse:[
1932	^ self.
1933	].
1934
1935	thumbFrame isNil ifTrue:[
1936	self computeThumbFrame
1937	].
1938	self drawThumbBackgroundInX:x y:y width:w height:h.
1939	thumbFrame isNil ifTrue:[
1940	"/ thumb hidden
1941	^ self
1942	].
1943
1944	orientation == #vertical ifTrue:[
1945	(y > thumbFrame bottom) ifTrue:[
1946	^ self
1947	].
1948	((y + h) < thumbFrame top) ifTrue:[
1949	^ self
1950	].
1951	] ifFalse:[
1952	(x > thumbFrame right) ifTrue:[
1953	^ self
1954	].
1955	((x + w) < thumbFrame left) ifTrue:[
1956	^ self
1957	].
1958	].
1959
1960	self drawThumb
1961
1962	"Modified: / 29-10-1997 / 15:48:48 / cg"
1963	"Modified: / 18-07-2016 / 13:45:09 / svestkap"
1964	!
1965
1966	sizeChanged:how
1967	"size of scroller changed - recompute thumbs frame and redraw it"
1968
1969	\|oldThumbFrame oldTop oldBot newTop newBot oldLeft oldRight newLeft newRight\|
1970
1971	super sizeChanged:how.
1972
1973	oldThumbFrame := thumbFrame.
1974	thumbFrame := nil.
1975	shown ifFalse:[
1976	thumbFrame := nil.
1977	self invalidate.
1978	^ self.
1979	].
1980	self computeThumbFrame.
1981
1982	"/ any change ?
1983	thumbFrame = oldThumbFrame ifTrue:[
1984	^ self
1985	].
1986	thumbFrame isNil ifTrue:[
1987	self invalidate.
1988	^ self
1989	].
1990	oldThumbFrame isNil ifTrue:[
1991	self invalidate:thumbFrame.
1992	^ self.
1993	].
1994
1995	"/ try to redraw as little as possible
1996
1997	oldTop := oldThumbFrame top.
1998	oldBot := oldThumbFrame bottom.
1999	newTop := thumbFrame top.
2000	newBot := thumbFrame bottom.
2001	oldLeft := oldThumbFrame left.
2002	oldRight := oldThumbFrame right.
2003	newLeft := thumbFrame left.
2004	newRight := thumbFrame right.
2005
2006	(orientation == #vertical
2007	and:[oldLeft == newLeft
2008	and:[oldRight == newRight]]) ifTrue:[
2009	(oldTop == newTop) ifTrue:[
2010	oldBot < newBot ifTrue:[
2011	"/ thumb became larger, but origin remains
2012	"/ (view became smaller)
2013	self invalidate:(Rectangle
2014	left:newLeft top:oldBot-thumbLevel
2015	right:newRight bottom:newBot).
2016	^ self.
2017	].
2018	oldBot > newBot ifTrue:[
2019	"/ thumb became smaller, but origin remains
2020	"/ (view became larger)
2021	self invalidate:(Rectangle
2022	left:newLeft top:newBot-thumbLevel
2023	right:newRight bottom:oldBot).
2024	^ self.
2025	].
2026	].
2027	(oldBot == newBot) ifTrue:[
2028	newTop < oldTop ifTrue:[
2029	"/ thumb became larger, but corner remains
2030	"/ (view became smaller)
2031	self invalidate:(Rectangle
2032	left:newLeft top:newTop
2033	right:newRight bottom:oldTop+thumbLevel).
2034	^ self.
2035	].
2036	newTop > oldTop ifTrue:[
2037	"/ thumb became smaller, but corner remains
2038	"/ (view became larger)
2039	self invalidate:(Rectangle
2040	left:newLeft top:oldTop
2041	right:newRight bottom:newTop+thumbLevel).
2042	^ self.
2043	]
2044	].
2045	].
2046
2047	(orientation == #horizontal
2048	and:[oldTop == newTop
2049	and:[oldBot == newBot]]) ifTrue:[
2050	(oldLeft == newLeft) ifTrue:[
2051	oldRight < newRight ifTrue:[
2052	"/ thumb became larger, but origin remains
2053	"/ (view became smaller)
2054	self invalidate:(Rectangle
2055	left:oldRight-thumbLevel top:newTop
2056	right:newRight bottom:newBot).
2057	^ self.
2058	].
2059	oldRight > newRight ifTrue:[
2060	"/ thumb became smaller, but origin remains
2061	"/ (view became larger)
2062	self invalidate:(Rectangle
2063	left:newRight-thumbLevel top:newTop
2064	right:oldRight bottom:newBot).
2065	^ self.
2066	].
2067	].
2068	].
2069
2070	self invalidate:(oldThumbFrame merge: thumbFrame).
2071
2072	"Modified: / 23.5.1999 / 13:50:41 / cg"
2073	!
2074
2075	update:something with:aParameter from:changedObject
2076	"handle update from a model (if any)"
2077
2078	(changedObject == model
2079	"and:[something == aspectMsg]") ifTrue:[
2080	self thumbOrigin:(model value).
2081	"/ self tellOthers.
2082	^ self
2083	].
2084	super update:something with:aParameter from:changedObject
2085
2086	"Modified: / 30.3.1999 / 14:26:28 / stefan"
2087	! !
2088
2089	!Scroller methodsFor:'focus handling'!
2090
2091	wantsFocusWithButtonPress
2092	"no, do not catch the keyboard focus on button click"
2093
2094	^ false
2095
2096	"Modified: / 18-07-2016 / 13:25:51 / svestkap"
2097	! !
2098
2099	!Scroller methodsFor:'forced scroll'!
2100
2101	moveLeft
2102	rangeStep notNil ifTrue:[
2103	self thumbOrigin:(self modelValueCheck:(model value)
2104	operation:#'-'
2105	secondValue:rangeStep).
2106	self tellOthers.
2107	] ifFalse:[
2108	self moveStepMissing
2109	].
2110
2111	"Created: / 03-01-2017 / 11:24:13 / svestkap"
2112	"Modified (comment): / 05-01-2017 / 14:40:20 / svestkap"
2113	!
2114
2115	moveRight
2116	rangeStep notNil ifTrue:[
2117	self thumbOrigin:(self modelValueCheck:(model value)
2118	operation:#'+'
2119	secondValue:rangeStep).
2120	self tellOthers.
2121	] ifFalse:[
2122	self moveStepMissing
2123	].
2124
2125	"Created: / 03-01-2017 / 11:24:33 / svestkap"
2126	"Modified: / 05-01-2017 / 14:46:12 / svestkap"
2127	!
2128
2129	scrollDown:amountToScroll
2130	"compatibility with SimpleView. This allows mouse wheel actions on Scrollers
2131	Note: this is used for horizontal scrollers, too (scrollRight)"
2132
2133	self scrollStep:amountToScroll
2134	!
2135
2136	scrollStep:delta
2137	"step by some delta"
2138
2139	\|oldOrg newOrg\|
2140
2141	oldOrg := self thumbOrigin.
2142	newOrg := ((oldOrg + delta) max:rangeStart) min:rangeEnd.
2143	oldOrg ~= newOrg ifTrue:[
2144	self thumbOrigin:newOrg.
2145	self tellOthers.
2146	]
2147
2148	"Created: / 21.4.1998 / 20:51:57 / cg"
2149	"Modified: / 21.4.1998 / 20:52:22 / cg"
2150	!
2151
2152	scrollToBeginning
2153	"scroll to the beginning"
2154
2155	self thumbOrigin:rangeStart.
2156	self tellOthers
2157
2158	"Created: 6.3.1996 / 17:55:13 / cg"
2159	!
2160
2161	scrollToEnd
2162	"scroll to the end"
2163
2164	self thumbOrigin:rangeEnd.
2165	self tellOthers
2166
2167	"Created: 6.3.1996 / 17:55:25 / cg"
2168	!
2169
2170	scrollUp:amountToScroll
2171	"compatibility with SimpleView. This allows mouse wheel actions on Scrollers
2172	Note: this is used for horizontal scrollers, too (scrollLeft)"
2173
2174	self scrollStep:amountToScroll negated
2175	! !
2176
2177	!Scroller methodsFor:'forwarding changed origin'!
2178
2179	tellOthers
2180	\|org\|
2181
2182	org := self thumbOrigin.
2183
2184	"
2185	the ST-80 way of notifying scrolls
2186	"
2187	self sendChangeMessageWith:org.
2188
2189	"
2190	the ST/X way of notifying scrolls
2191	"
2192	scrollAction notNil ifTrue:[
2193	scrollAction value:org
2194	].
2195
2196	"/
2197	"/ this will vanish - the scroller should share
2198	"/ a valueHolder with the scrolledView.
2199	"/
2200	dependents notNil ifTrue:[ self changed:#scrollerPosition ].
2201
2202	"Modified: / 21.1.1998 / 19:12:55 / cg"
2203	! !
2204
2205	!Scroller methodsFor:'initialization'!
2206
2207	defaultExtent
2208	"compute my extent from sub-components"
2209
2210	^ self preferredExtent
2211
2212	"Modified: 22.4.1996 / 23:37:53 / cg"
2213	!
2214
2215	fetchDeviceResources
2216	"fetch device colors, to avoid reallocation at redraw time"
2217
2218	\|graphicsDevice\|
2219
2220	super fetchDeviceResources.
2221	graphicsDevice := device.
2222
2223	thumbShadowColor notNil ifTrue:[thumbShadowColor := thumbShadowColor onDevice:graphicsDevice].
2224	thumbLightColor notNil ifTrue:[thumbLightColor := thumbLightColor onDevice:graphicsDevice].
2225	thumbHalfShadowColor notNil ifTrue:[thumbHalfShadowColor := thumbHalfShadowColor onDevice:graphicsDevice].
2226	thumbHalfLightColor notNil ifTrue:[thumbHalfLightColor := thumbHalfLightColor onDevice:graphicsDevice].
2227
2228	thumbEnteredColor notNil ifTrue:[thumbEnteredColor := thumbEnteredColor onDevice:graphicsDevice].
2229	ghostColor notNil ifTrue:[ghostColor := ghostColor onDevice:graphicsDevice].
2230	ghostFrameColor notNil ifTrue:[ghostFrameColor := ghostFrameColor onDevice:graphicsDevice].
2231
2232	"Modified: 13.1.1997 / 21:56:38 / cg"
2233	!
2234
2235	initCursor
2236	"set the cursor - a hand"
2237
2238	cursor := Cursor hand
2239	!
2240
2241	initStyle
2242	"initialize style dep. stuff"
2243
2244	<resource: #style (#name
2245	#'scroller.autoRepeat'
2246	#'scroller.initialRepeatDelay'
2247	#'scroller.repeatDelay')>
2248
2249	\|nm graphicsDevice\|
2250
2251	super initStyle.
2252	graphicsDevice := device.
2253
2254	DefaultViewBackground notNil ifTrue:[
2255	viewBackground := DefaultViewBackground onDevice:graphicsDevice.
2256	].
2257	DefaultShadowColor notNil ifTrue:[
2258	shadowColor := DefaultShadowColor onDevice:graphicsDevice.
2259	].
2260	DefaultLightColor notNil ifTrue:[
2261	lightColor := DefaultLightColor onDevice:graphicsDevice.
2262	].
2263
2264	tallyMarks := DefaultTallyMarks.
2265	tallyLevel := DefaultTallyLevel.
2266	DefaultLevel ~~ level ifTrue:[
2267	self level:DefaultLevel.
2268	].
2269	DefaultBorderWidth ~~ self borderWidth ifTrue:[
2270	self borderWidth:DefaultBorderWidth.
2271	].
2272	thumbLevel := DefaultThumbLevel.
2273	thumbActiveLevel := DefaultThumbActiveLevel.
2274	thumbActiveColor := DefaultThumbActiveColor.
2275	inset := DefaultInset.
2276	fixThumbHeight := DefaultFixThumbHeight.
2277	thumbEdgeStyle := DefaultEdgeStyle.
2278
2279	DefaultGhostColor notNil ifTrue:[
2280	ghostColor := DefaultGhostColor onDevice:graphicsDevice.
2281	].
2282	DefaultGhostFrameColor notNil ifTrue:[
2283	ghostFrameColor := DefaultGhostFrameColor onDevice:graphicsDevice.
2284	].
2285	ghostLevel := DefaultGhostLevel.
2286
2287	DefaultThumbFrameColor notNil ifTrue:[
2288	thumbFrameColor := DefaultThumbFrameColor onDevice:graphicsDevice.
2289	].
2290	DefaultThumbShadowColor notNil ifTrue:[
2291	thumbShadowColor := DefaultThumbShadowColor
2292	] ifFalse:[
2293	thumbShadowColor := shadowColor.
2294	].
2295	DefaultThumbLightColor notNil ifTrue:[
2296	thumbLightColor := DefaultThumbLightColor
2297	] ifFalse:[
2298	thumbLightColor := lightColor.
2299	].
2300
2301	thumbEdgeStyle notNil ifTrue:[
2302	DefaultThumbHalfShadowColor notNil ifTrue:[
2303	thumbHalfShadowColor := DefaultThumbHalfShadowColor
2304	].
2305
2306	DefaultThumbHalfLightColor notNil ifTrue:[
2307	thumbHalfLightColor := DefaultThumbHalfLightColor
2308	].
2309	].
2310
2311	nm := styleSheet name.
2312
2313	graphicsDevice hasGrayscales ifFalse:[
2314	thumbEdgeStyle notNil ifTrue:[
2315	thumbHalfShadowColor := Color darkGray.
2316	thumbHalfLightColor := self whiteColor
2317	].
2318
2319	thumbShadowColor := self blackColor.
2320	"/ thumbLightColor := White.
2321
2322	nm = #motif ifTrue:[
2323	DefaultThumbColor isNil ifTrue:[
2324	thumbColor := self whiteColor.
2325	].
2326	]
2327	].
2328
2329	DefaultThumbColor notNil ifTrue:[
2330	thumbColor := DefaultThumbColor onDevice:graphicsDevice
2331	] ifFalse:[
2332	nm ~= #napkin ifTrue:[
2333	thumbColor := self whiteColor.
2334	nm ~= #normal ifTrue:[
2335	graphicsDevice hasGrayscales ifFalse:[
2336	thumbColor := Color gray
2337	].
2338	].
2339	].
2340	].
2341	thumbColor notNil ifTrue:[
2342	thumbColor := thumbColor onDevice:graphicsDevice.
2343	].
2344
2345	thumbShadowColor notNil ifTrue:[
2346	thumbShadowColor := thumbShadowColor onDevice:graphicsDevice.
2347	].
2348	thumbLightColor notNil ifTrue:[
2349	thumbLightColor := thumbLightColor onDevice:graphicsDevice.
2350	].
2351	thumbHalfShadowColor notNil ifTrue:[
2352	thumbHalfShadowColor := thumbHalfShadowColor onDevice:graphicsDevice.
2353	].
2354	thumbHalfLightColor notNil ifTrue:[
2355	thumbHalfLightColor := thumbHalfLightColor onDevice:graphicsDevice.
2356	].
2357	thumbEdgeStyle notNil ifTrue:[
2358	thumbHalfShadowColor isNil ifTrue:[
2359	thumbHalfShadowColor := thumbShadowColor lightened onDevice:graphicsDevice
2360	]
2361	].
2362
2363	DefaultThumbEnteredColor notNil ifTrue:[
2364	thumbEnteredColor := DefaultThumbEnteredColor onDevice:graphicsDevice.
2365	] ifFalse:[
2366	thumbEnteredColor := thumbColor.
2367	].
2368
2369	(DefaultThumbEnteredColor notNil or:[NewCursors]) ifTrue:[
2370	self enableMotionEvents.
2371	self enableEnterLeaveEvents.
2372	].
2373
2374	DefaultThumbImage notNil ifTrue:[
2375	thumbImage := DefaultThumbImage onDevice:graphicsDevice.
2376	fixThumbHeight := true.
2377	].
2378
2379	HandleImage notNil ifTrue:[
2380	shadowForm := HandleImage onDevice:graphicsDevice.
2381	] ifFalse:[
2382	nm = #next ifTrue:[
2383	shadowForm := self class handleShadowFormOn:graphicsDevice.
2384	lightForm := self class handleLightFormOn:graphicsDevice
2385	] ifFalse:[
2386	shadowForm := lightForm := nil
2387	].
2388	].
2389	self drawableId notNil ifTrue:[
2390	self computeThumbFrame
2391	].
2392
2393	autoRepeat := styleSheet at:#'scroller.autoRepeat' default:true.
2394	initialRepeatDelay := styleSheet at:#'scroller.initialRepeatDelay' default:0.3.
2395	repeatDelay := styleSheet at:#'scroller.repeatDelay' default:0.15.
2396
2397	"Modified: / 5.9.1998 / 20:21:41 / cg"
2398	!
2399
2400	initialize
2401	"initialize - setup instvars from defaults"
2402
2403	orientation isNil ifTrue:[orientation := #vertical].
2404
2405	super initialize.
2406
2407	scrolling := entered := false.
2408	enabled := synchronousOperation := true.
2409
2410	thumbOrigin := virtualModelValue := 0.
2411	thumbHeight := 100.
2412	thumbFrameSizeDifference := 0.
2413
2414	rangeStart := 0.
2415	rangeEnd := 100.
2416	rangeStep := nil."/ meaning: arbitrary precision
2417
2418	"/ inset := 1.
2419
2420	"/ self computeThumbFrame
2421
2422	"Modified: / 07-03-1999 / 00:07:32 / cg"
2423	"Modified: / 06-01-2017 / 09:44:08 / svestkap"
2424	!
2425
2426	realize
2427	super realize.
2428	model notNil ifTrue:[
2429	self thumbOrigin:(model value).
2430	].
2431	! !
2432
2433	!Scroller methodsFor:'private'!
2434
2435	absFromPercent:percent
2436	"given a percentage, compute number of pixels"
2437
2438	\|fullSize\|
2439
2440	(orientation == #vertical) ifTrue:[
2441	fullSize := height
2442	] ifFalse:[
2443	fullSize := width
2444	].
2445
2446	"/ avoid hitting the boundary if no frame and no level (i.e. st80 style)
2447	(thumbLevel == 0 and:[thumbFrameColor isNil]) ifTrue:[
2448	fullSize := fullSize - 1
2449	].
2450
2451	^ ((percent * (fullSize - thumbFrameSizeDifference - (margin * 2))) / 100) rounded
2452
2453	"Modified: 7.3.1997 / 16:05:57 / cg"
2454	!
2455
2456	computeThumbFrame
2457	"compute the thumbs frame (a rectangle) whenever thumb is moved,
2458	changed height or the scrollers size has changed.
2459	We take care, that the thumb will not become too small (i.e.
2460	invisible or uncatchable).
2461	Also, for mswindows style, its height/width is constant."
2462
2463	\|newPos1 newPos2 newSize1 newSize2 nh nw ny nx
2464	computedSize minSz sz1 sz2 nb nr\|
2465
2466	thumbHeight >= 100 ifTrue:[
2467	self thumbOrigin ~= 0.0 ifTrue:[
2468	self thumbOrigin:0
2469	].
2470
2471	thumbFrame := nil.
2472	^ self
2473	].
2474
2475	"compute position & size"
2476	newPos1 := (self absFromPercent:thumbOrigin) + margin.
2477	newSize1 := computedSize := self absFromPercent:thumbHeight.
2478	(orientation == #vertical) ifTrue:[
2479	sz1 := height.
2480	sz2 := width
2481	] ifFalse:[
2482	sz1 := width.
2483	sz2 := height
2484	].
2485
2486	"
2487	do we have to adjust the computed size ?
2488	"
2489	newPos2 := margin + inset.
2490	newSize2 := sz2 - (2 * newPos2).
2491
2492	"/ (style ~~ #normal) ifTrue:[
2493	thumbLevel ~~ 0 ifTrue:[
2494	"
2495	do not make thumb too small (for handle & to be catchable)
2496	"
2497	minSz := MinThumbSize "10" + (2 * thumbLevel)
2498	] ifFalse:[
2499	"
2500	do not make thumb too small (uncatchable)
2501	"
2502	minSz := MinThumbSize "4"
2503	].
2504
2505	(newSize1 < minSz) ifTrue:[
2506	newSize1 := minSz.
2507	thumbFrameSizeDifference := newSize1 - computedSize
2508	] ifFalse:[
2509	thumbFrameSizeDifference := 0.
2510	].
2511
2512	fixThumbHeight ifTrue:[
2513	"have a fix-size thumb (i.e. mswindows style)"
2514
2515	newSize1 := sz2 - (2 * inset). "make it square"
2516	thumbImage notNil ifTrue:[
2517	newSize1 := (newSize1 max:(thumbImage height)) max:(thumbImage width)
2518	].
2519	thumbFrameSizeDifference := newSize1 - computedSize.
2520	].
2521
2522	"
2523	oops - if height does not reflect real visibible area, we have to adjust the origin
2524	"
2525	(thumbFrameSizeDifference == 0) ifFalse:[
2526	newPos1 := (self absFromPercent:thumbOrigin) + margin.
2527	"/ newPos1 := ((thumbOrigin * (sz1 - thumbFrameSizeDifference - (margin * 2))) / 100) rounded + margin
2528	].
2529
2530	(orientation == #vertical) ifTrue:[
2531	ny := newPos1 max:margin.
2532	nx := newPos2.
2533	nh := newSize1.
2534	nw := newSize2 max:2.
2535	ny + nh >= (height - margin) ifTrue:[
2536	ny := (height - 1 - margin - nh) max:margin.
2537	].
2538	(nx+nw) >= width ifTrue:[
2539	nx := ((width - nw) // 2) max:0.
2540	].
2541
2542	nb := ny + nh - 1.
2543	nb >= (height - margin) ifTrue:[
2544	ny <= margin ifTrue:[
2545	thumbFrame := nil.
2546	^ self
2547	]
2548	].
2549	] ifFalse:[
2550	nx := newPos1 max:margin.
2551	ny := newPos2.
2552	nw := newSize1.
2553	nh := newSize2 max:2.
2554	nx + nw >= (width - margin) ifTrue:[
2555	nx := (width - 1 - margin - nw) max:margin.
2556	].
2557	(ny+nh) >= height ifTrue:[
2558	ny := ((height - nh) // 2) max:0.
2559	].
2560	nr := nx + nw - 1.
2561	nr >= (width - margin) ifTrue:[
2562	nx <= margin ifTrue:[
2563	thumbFrame := nil.
2564	^ self
2565	]
2566	].
2567	].
2568	(((styleSheet name == #winXP) or:[styleSheet name == #winVista])
2569	and:[self isMiniScroller not]) ifTrue:[
2570	nw := nw + 1.
2571	nh := nh + 1.
2572	].
2573
2574	"
2575	do not create a new Rectangle if its the same anyway
2576	"
2577	thumbFrame notNil ifTrue:[
2578	(ny == thumbFrame top) ifTrue:[
2579	(nx == thumbFrame left) ifTrue:[
2580	(nh == thumbFrame height) ifTrue:[
2581	(nw == thumbFrame width) ifTrue:[ ^ self]
2582	]
2583	]
2584	]
2585	].
2586
2587	thumbFrame := Rectangle left:nx top:ny width:nw height:nh.
2588
2589	"Modified: / 12.5.1998 / 20:58:51 / cg"
2590	!
2591
2592	modelValueCheck:modelValue operation:operator secondValue:secondValue
2593	modelValue isNil ifTrue:[
2594	^ virtualModelValue := self virtualModelValue perform:operator asSymbol with:secondValue.
2595	] ifFalse:[
2596	^ modelValue perform:operator asSymbol with:secondValue
2597	]
2598
2599	"Created: / 05-01-2017 / 12:56:35 / svestkap"
2600	"Modified: / 05-01-2017 / 14:42:56 / svestkap"
2601	!
2602
2603	moveStepMissing
2604	rangeStep isNil ifTrue:[
2605	self error:'No thumb step defined!!' mayProceed:false.
2606	].
2607
2608	"Created: / 04-01-2017 / 12:25:42 / svestkap"
2609	!
2610
2611	percentFromAbs:absValue
2612	"given a number of pixels, compute percentage"
2613
2614	\|fullSize val t\|
2615
2616	(orientation == #vertical) ifTrue:[
2617	fullSize := height
2618	] ifFalse:[
2619	fullSize := width
2620	].
2621
2622	absValue < 0 ifTrue:[^ rangeStart].
2623	absValue > fullSize ifTrue:[^ rangeEnd].
2624
2625	t := fullSize - thumbFrameSizeDifference - (margin * 2).
2626	t = 0 ifTrue:[
2627	"/ in rare cases, this happens ...
2628	val := 0
2629	] ifFalse:[
2630	val := absValue / t * (rangeEnd - rangeStart).
2631	].
2632	val := val + rangeStart.
2633
2634	rangeStart < rangeEnd ifTrue:[
2635	val < rangeStart ifTrue:[^ rangeStart].
2636	val > rangeEnd ifTrue:[^ rangeEnd].
2637	] ifFalse:[
2638	val > rangeStart ifTrue:[^ rangeStart].
2639	val < rangeEnd ifTrue:[^ rangeEnd].
2640	].
2641	^ val
2642
2643	"Modified: / 21.1.1998 / 19:31:15 / cg"
2644	!
2645
2646	startMove
2647	originBeforeMove := self thumbOrigin.
2648
2649	(ghostColor notNil
2650	or:[ghostFrameColor notNil
2651	or:[ghostLevel ~~ 0]]) ifTrue:[
2652	thumbFrame isNil ifTrue:[
2653	self computeThumbFrame.
2654	].
2655	frameBeforeMove := thumbFrame insetBy:1@1
2656	].
2657
2658	!
2659
2660	updateBackground
2661	"make my background grey, whenever either readOnly or disable"
2662
2663	\|bg\|
2664
2665	enabled ifTrue:[
2666	bg := DefaultViewBackground.
2667	].
2668	bg isNil ifTrue:[
2669	bg := View defaultViewBackgroundColor.
2670	].
2671
2672	bg ~= viewBackground ifTrue:[
2673	self backgroundColor:bg.
2674	self invalidate
2675	]
2676
2677	! !
2678
2679	!Scroller methodsFor:'private-scrollbar & scrollview interface'!
2680
2681	setThumbFor:aView
2682	"get contents and size info from aView and adjust thumb"
2683
2684	\|percentSize percentOrigin contentsSize contentsPosition viewsSize t\|
2685
2686	scrolling ifTrue:[self invalidate].
2687
2688	"
2689	get the content's size
2690	"
2691	aView isNil ifTrue:[
2692	contentsSize := 0
2693	] ifFalse:[
2694	orientation == #vertical ifTrue:[
2695	contentsSize := aView heightOfContents.
2696	(t := aView transformation) notNil ifTrue:[
2697	contentsSize := t applyScaleY:contentsSize.
2698	].
2699	] ifFalse:[
2700	contentsSize := aView widthOfContents.
2701	(t := aView transformation) notNil ifTrue:[
2702	contentsSize := t applyScaleX:contentsSize.
2703	].
2704	]
2705	].
2706
2707	(contentsSize = 0) ifTrue:[
2708	percentSize := 100.
2709	percentOrigin := 100
2710	] ifFalse:[
2711	(orientation == #vertical) ifTrue:[
2712	viewsSize := aView innerHeight.
2713	contentsPosition := aView yOriginOfContents.
2714	] ifFalse:[
2715	viewsSize := aView innerWidth.
2716	contentsPosition := aView xOriginOfContents
2717	].
2718
2719	percentSize := viewsSize * 100.0 / contentsSize.
2720	percentOrigin := contentsPosition * 100.0 / contentsSize.
2721	percentOrigin + percentSize > 100.0 ifTrue:[
2722	"actually showing stuff below contents of view"
2723	"
2724	contentsSize := contentsPosition + aView innerHeight.
2725	percentSize := viewsSize * 100.0 / contentsSize.
2726	percentOrigin := contentsPosition * 100.0 / contentsSize
2727	"
2728	]
2729	].
2730	(percentSize = thumbHeight) ifTrue:[
2731	self thumbOrigin:percentOrigin
2732	] ifFalse:[
2733	(percentOrigin = thumbOrigin) ifTrue:[
2734	self thumbHeight:percentSize
2735	] ifFalse:[
2736	self thumbOrigin:percentOrigin thumbHeight:percentSize
2737	]
2738	].
2739	!
2740
2741	setThumbHeightFor:aView
2742	"get contents and size info from aView and adjust thumb height"
2743
2744	\|percent total viewsSize\|
2745
2746	scrolling ifTrue:[self invalidate].
2747
2748	(orientation == #vertical) ifTrue:[
2749	total := aView heightOfContents.
2750	aView transformation notNil ifTrue:[
2751	total := aView transformation applyScaleY:total.
2752	].
2753	] ifFalse:[
2754	total := aView widthOfContents.
2755	aView transformation notNil ifTrue:[
2756	total := aView transformation applyScaleX:total.
2757	].
2758	].
2759	(total = 0) ifTrue:[
2760	percent := 100
2761	] ifFalse:[
2762	viewsSize := (orientation == #vertical) ifTrue:[aView innerHeight]
2763	ifFalse:[aView innerWidth].
2764	percent := viewsSize * 100.0 / total
2765	].
2766	self thumbHeight:percent
2767	!
2768
2769	setThumbOriginFor:aView
2770	"get contents and size info from aView and adjust thumb origin"
2771
2772	\|percent total contentsPosition\|
2773
2774	scrolling ifTrue:[self invalidate].
2775
2776	(orientation == #vertical) ifTrue:[
2777	total := aView heightOfContents.
2778	aView transformation notNil ifTrue:[
2779	total := aView transformation applyScaleY:total.
2780	].
2781	] ifFalse:[
2782	total := aView widthOfContents.
2783	aView transformation notNil ifTrue:[
2784	total := aView transformation applyScaleX:total.
2785	].
2786	].
2787	(total = 0) ifTrue:[
2788	percent := 100
2789	] ifFalse:[
2790	contentsPosition := (orientation == #vertical) ifTrue:[aView yOriginOfContents]
2791	ifFalse:[aView xOriginOfContents].
2792	percent := contentsPosition * 100.0 / total
2793	].
2794	self thumbOrigin:percent.
2795	! !
2796
2797	!Scroller methodsFor:'queries'!
2798
2799	isMiniScroller
2800	^ false
2801	!
2802
2803	isScrolling
2804	"true, if thumb is being moved (by user)"
2805
2806	^ scrolling
2807	!
2808
2809	preferredExtent
2810	"return my preferredExtent"
2811
2812	\|defExt w h\|
2813
2814	"/ If I have an explicit preferredExtent..
2815	explicitExtent notNil ifTrue:[
2816	^ explicitExtent
2817	].
2818
2819	"/ If I have a cached preferredExtent value..
2820	preferredExtent notNil ifTrue:[
2821	^ preferredExtent
2822	].
2823
2824	defExt := self class defaultExtent.
2825
2826	orientation == #vertical ifTrue:[
2827	h := defExt y.
2828	(w := DefaultVScrollerWidth) isNil ifTrue:[
2829	w := (device horizontalPixelPerMillimeter asFloat * 5) rounded
2830	]
2831	] ifFalse:[
2832	w := defExt x.
2833	(h := DefaultHScrollerHeight) isNil ifTrue:[
2834	h := (device verticalPixelPerMillimeter asFloat * 5) rounded
2835	]
2836	].
2837
2838	preferredExtent := w @ h.
2839	^ preferredExtent.
2840
2841	"Modified: / 28.4.1999 / 18:28:19 / cg"
2842	!
2843
2844	thumbVisible
2845	"return true, if the thumb is usable i.e. its visible & movable.
2846	Can be used by the scrollBar to decide if it should hide the scroller."
2847
2848	\|m2\|
2849
2850	(thumbHeight >= 100) ifTrue:[^ false].
2851	self computeThumbFrame.
2852	thumbFrame isNil ifTrue:[^ false].
2853
2854	m2 := margin * 2.
2855	orientation == #vertical ifTrue:[
2856	thumbFrame height >= (height - m2) ifTrue:[^ false].
2857	] ifFalse:[
2858	thumbFrame width >= (width - m2) ifTrue:[^ false].
2859	].
2860	^ true
2861
2862	"Created: / 7.3.1997 / 21:10:23 / cg"
2863	"Modified: / 12.5.1998 / 20:21:00 / cg"
2864	!
2865
2866	verticalScrollStep
2867	"mouse wheel: scroll by keyboardStep or a quarter of a page
2868	Note: this is used for horizontal scrollers, too"
2869
2870	^ (keyboardStep ? (thumbHeight / 4)) max:1
2871	! !
2872
2873	!Scroller class methodsFor:'documentation'!
2874
2875	version
2876	^ '$Header$'
2877	!
2878
2879	version_CVS
2880	^ '$Header$'
2881	!
2882
2883	version_HG
2884
2885	^ '$Changeset: <not expanded> $'
2886	! !
2887

Download in other formats:

Original Format