WebSVN – Kolibri OS – Diff – /programs/develop/cedit/SRC/scroll.ob07


﻿(*
    Copyright 2021 Anton Krotov
 
    This file is part of CEdit.
 
    CEdit is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.
 
    CEdit is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.
 
    You should have received a copy of the GNU General Public License
    along with CEdit. If not, see .
*)
 
MODULE Scroll;
 
IMPORT G := Graph, K := KolibriOS;
 
CONST
 
	ScrollIPC* = 0;
 
TYPE
 
	tScroll* = RECORD
		vertical, Inc*, Dec*, mouse*: BOOLEAN;
		top*, left*,
		width*, height*: INTEGER; (* read only *)
		btnSize, sliderSize: INTEGER;
		pos, Slider, pos0, maxVal*, value*: INTEGER;
		canvas*: G.tCanvas
	END;
 
 
PROCEDURE create* (vertical: BOOLEAN; width, height: INTEGER; btnSize, sliderSize: INTEGER; VAR scroll: tScroll);
BEGIN
	scroll.vertical := vertical;
	scroll.Inc := FALSE;
	scroll.Dec := FALSE;
	scroll.Slider := -1;
	scroll.mouse := FALSE;
	scroll.left := 0;
	scroll.top := 0;
	scroll.width := width;
	scroll.height := height;
	scroll.btnSize := btnSize;
	scroll.sliderSize := sliderSize;
	scroll.pos := 0;
	scroll.maxVal := 0;
	scroll.canvas := G.CreateCanvas(width, height)
END create;
 
 
PROCEDURE Rect (canvas: G.tCanvas; left, top, right, bottom: INTEGER);
BEGIN
	G.FillRect(canvas, left, top, right, bottom);
	G.SetColor(canvas, K.borderColor);
	G.Rect(canvas, left, top, right, bottom);
END Rect;
 
 
PROCEDURE _paint (scroll: tScroll);
VAR
	canvas: G.tCanvas;
	x, y, d, x1, x2, y1, y2,
	width, height, btn: INTEGER;
 
 
	PROCEDURE SetColor (canvas: G.tCanvas; c: BOOLEAN);
	VAR
		color: INTEGER;
	BEGIN
		IF c THEN
			color := K.btnColor
		ELSE
			color := K.btnTextColor
		END;
		G.SetColor(canvas, color)
	END SetColor;
 
 
BEGIN
	btn := scroll.btnSize;
	width := scroll.width;
	height := scroll.height;
	canvas := scroll.canvas;
	G.SetColor(canvas, K.winColor);
	G.clear(canvas);
	G.SetColor(canvas, K.borderColor);
	G.Rect(canvas, 0, 0, width - 1, height - 1);
	IF scroll.vertical THEN
		SetColor(canvas, ~scroll.Dec);
		Rect(canvas, 0, 0, width - 1, btn - 1);
		SetColor(canvas, ~scroll.Inc);
		Rect(canvas, 0, height - btn, width - 1, height - 1);
		G.SetColor(canvas, K.btnColor);
		Rect(canvas, 0, btn + scroll.pos - 1, width - 1, btn + scroll.pos + scroll.sliderSize - 1);
 
		G.SetColor(canvas, K.btnTextColor);
 
		y := btn + scroll.pos + scroll.sliderSize DIV 2 - 1;
		G.HLine(canvas, y, width DIV 4, 3*width DIV 4);
		G.HLine(canvas, y - 3, width DIV 3, 2*width DIV 3);
		G.HLine(canvas, y + 3, width DIV 3, 2*width DIV 3);
 
		d := 4*width DIV 10;
		x1 := (width - d) DIV 2;
		x2 := x1 + d;
 
		SetColor(canvas, scroll.Dec);
		y := (btn - d DIV 2) DIV 2 + d DIV 2 - 1;
		G.Triangle(canvas, x1 - 1, y, x2, y, G.triUp);
 
		SetColor(canvas, scroll.Inc);
		y := y + height - btn - d DIV 2 + 1;
		G.Triangle(canvas, x1 - 1, y, x2, y, G.triDown);
	ELSE
		SetColor(canvas, ~scroll.Dec);
		Rect(canvas, 0, 0, btn - 1, height - 1);
		SetColor(canvas, ~scroll.Inc);
		Rect(canvas, width - btn, 0, width - 1, height - 1);
		G.SetColor(canvas, K.btnColor);
		Rect(canvas, btn + scroll.pos - 1, 0, btn + scroll.pos + scroll.sliderSize - 1, height - 1);
 
		G.SetColor(canvas, K.btnTextColor);
 
		x := btn + scroll.pos + scroll.sliderSize DIV 2 - 1;
		G.VLine(canvas, x, height DIV 4, 3*height DIV 4);
		G.VLine(canvas, x - 3, height DIV 3, 2*height DIV 3);
		G.VLine(canvas, x + 3, height DIV 3, 2*height DIV 3);
 
		d := 4*height DIV 10;
		y1 := (height - d) DIV 2;
		y2 := y1 + d;
 
		SetColor(canvas, scroll.Dec);
		x := (btn - d DIV 2) DIV 2 + d DIV 2 - 1;
		G.Triangle(canvas, x, y1 - 1, x, y2, G.triLeft);
 
		SetColor(canvas, scroll.Inc);
		x := x + width - btn - d DIV 2 + 1;
		G.Triangle(canvas, x, y1 - 1, x, y2, G.triRight);
	END;
	G.DrawCanvas(scroll.canvas, scroll.left, scroll.top)
END _paint;
 
 
PROCEDURE paint* (scroll: tScroll);
BEGIN
	IF scroll.canvas # NIL THEN
		_paint(scroll)
	END
END paint;
 
 
PROCEDURE resize* (VAR scroll: tScroll; width, height: INTEGER);
BEGIN
	G.destroy(scroll.canvas);
	scroll.canvas := G.CreateCanvas(width, height);
	scroll.width := width;
	scroll.height := height;
	paint(scroll)
END resize;
 
 
PROCEDURE setValue* (VAR scroll: tScroll; value: INTEGER);
VAR
	pos, maxPos, n, m: INTEGER;
BEGIN
	IF scroll.vertical THEN
		maxPos := scroll.height
	ELSE
		maxPos := scroll.width
	END;
	maxPos := maxPos - scroll.btnSize*2 - scroll.sliderSize + 1;
	IF (value < 0) OR (scroll.maxVal <= 0) THEN
		value := 0;
		pos := 0
	ELSIF value > scroll.maxVal THEN
		value := scroll.maxVal;
		pos := maxPos
	ELSE
		IF (maxPos + 1) >= scroll.maxVal THEN
			n := (maxPos + 1) DIV scroll.maxVal;
			m := (maxPos + 1) MOD scroll.maxVal;
			pos := value*n + MIN(value, m)
		ELSE
			pos := value*(maxPos + 1) DIV scroll.maxVal
		END;
		IF pos > maxPos THEN
			pos := maxPos;
			value := scroll.maxVal
		END
	END;
	scroll.pos := pos;
	scroll.value := value
END setValue;
 
 
PROCEDURE change* (VAR scroll: tScroll);
BEGIN
	IF scroll.Inc THEN
		setValue(scroll, scroll.value + 1)
	ELSIF scroll.Dec THEN
		setValue(scroll, scroll.value - 1)
	END;
	paint(scroll)
END change;
 
 
PROCEDURE ceil (p, q: INTEGER): INTEGER;
	RETURN p DIV q + ORD(p MOD q # 0)
END ceil;
 
 
PROCEDURE setPos (VAR scroll: tScroll; pos: INTEGER);
VAR
	maxPos, value, n, m, x, x0, q: INTEGER;
BEGIN
	IF scroll.maxVal > 0 THEN
		IF scroll.vertical THEN
			maxPos := scroll.height
		ELSE
			maxPos := scroll.width
		END;
		maxPos := maxPos - scroll.btnSize*2 - scroll.sliderSize + 1;
		IF pos <= 0 THEN
			pos := 0;
			value := 0
		ELSIF pos >= maxPos THEN
			pos := maxPos;
			value := scroll.maxVal
		ELSE
			IF scroll.maxVal <= maxPos + 1 THEN
				n := (maxPos + 1) DIV scroll.maxVal;
				m := (maxPos + 1) MOD scroll.maxVal;
 
				q := m*(n + 1);
				IF q < pos THEN
					value := ceil(pos - m, n)
				ELSIF q > pos THEN
					value := ceil(pos, n + 1)
				ELSE
					value := m
				END;
 
				x := value*n + MIN(value, m);
				x0 := (value - 1)*n + MIN(value - 1, m);
 
				IF x - pos > pos - x0 THEN
					pos := x0;
					DEC(value)
				ELSE
					pos := x;
					IF pos > maxPos THEN
						pos := maxPos;
						value := scroll.maxVal
					END
				END
			ELSE
				value := scroll.maxVal*pos DIV (maxPos + 1)
			END
		END
	ELSE
		pos := 0;
		scroll.value := 0
	END;
	scroll.pos := pos;
	scroll.value := value
END setPos;
 
 
PROCEDURE isActive* (scroll: tScroll): BOOLEAN;
	RETURN scroll.Inc OR scroll.Dec OR (scroll.Slider # -1)
END isActive;
 
 
PROCEDURE MouseMove* (VAR scroll: tScroll; x, y: INTEGER);
VAR
	c: INTEGER;
BEGIN
	IF scroll.Slider # -1 THEN
		IF scroll.vertical THEN
			c := y - scroll.top
		ELSE
			c := x - scroll.left
		END;
		setPos(scroll, scroll.pos0 + c - scroll.Slider);
		paint(scroll)
	END
END MouseMove;
 
 
PROCEDURE between (a, b, c: INTEGER): BOOLEAN;
	RETURN (a <= b) & (b <= c)
END between;
 
 
PROCEDURE SendIPC*;
BEGIN
	K.SendIPC(K.ThreadID(), ScrollIPC)
END SendIPC;
 
 
PROCEDURE MouseDown* (VAR scroll: tScroll; x, y: INTEGER);
VAR
	c, size: INTEGER;
BEGIN
	x := x - scroll.left;
	y := y - scroll.top;
	scroll.mouse := TRUE;
	IF between(0, x, scroll.width - 1) & between(0, y, scroll.height - 1) THEN
		IF scroll.vertical THEN
			c := y;
			size := scroll.height
		ELSE
			c := x;
			size := scroll.width
		END;
		IF between(scroll.btnSize + scroll.pos - 1, c, scroll.btnSize + scroll.pos + scroll.sliderSize - 1) THEN
			scroll.pos0 := scroll.pos;
			scroll.Slider := c
		ELSE
			IF between(0, c, scroll.btnSize - 1) THEN
				scroll.Dec := TRUE;
				SendIPC
			ELSE
				IF between(size - scroll.btnSize, c, size - 1) THEN
					scroll.Inc := TRUE;
					SendIPC
				ELSE
					setPos(scroll, c - scroll.btnSize - scroll.sliderSize DIV 2);
					scroll.pos0 := scroll.pos;
					scroll.Slider := c;
					paint(scroll)
				END
			END
		END
	END
END MouseDown;
 
 
PROCEDURE MouseUp* (VAR scroll: tScroll);
BEGIN
	IF scroll.mouse THEN
		scroll.Slider := -1;
		scroll.Inc := FALSE;
		scroll.Dec := FALSE;
		scroll.mouse := FALSE;
		paint(scroll)
	END
END MouseUp;
 
 
END Scroll.

Rev 9174	Rev 9180
1	(*	1	(*
2	Copyright 2021 Anton Krotov	2	Copyright 2021 Anton Krotov
3		3
4	This file is part of CEdit.	4	This file is part of CEdit.
5		5
6	CEdit is free software: you can redistribute it and/or modify	6	CEdit is free software: you can redistribute it and/or modify
7	it under the terms of the GNU General Public License as published by	7	it under the terms of the GNU General Public License as published by
8	the Free Software Foundation, either version 3 of the License, or	8	the Free Software Foundation, either version 3 of the License, or
9	(at your option) any later version.	9	(at your option) any later version.
10		10
11	CEdit is distributed in the hope that it will be useful,	11	CEdit is distributed in the hope that it will be useful,
12	but WITHOUT ANY WARRANTY; without even the implied warranty of	12	but WITHOUT ANY WARRANTY; without even the implied warranty of
13	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the	13	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14	GNU General Public License for more details.	14	GNU General Public License for more details.
15		15
16	You should have received a copy of the GNU General Public License	16	You should have received a copy of the GNU General Public License
17	along with CEdit. If not, see .	17	along with CEdit. If not, see .
18	*)	18	*)
19		19
20	MODULE Scroll;	20	MODULE Scroll;
21		21
22	IMPORT G := Graph, K := KolibriOS;	22	IMPORT G := Graph, K := KolibriOS;
23		23
24	CONST	24	CONST
25		25
26	ScrollIPC* = 0;	26	ScrollIPC* = 0;
27		27
28	TYPE	28	TYPE
29		29
30	tScroll* = RECORD	30	tScroll* = RECORD
31	vertical, Inc, Dec, mouse*: BOOLEAN;	31	vertical, Inc, Dec, mouse*: BOOLEAN;
32	top, left,	32	top, left,
33	width, height: INTEGER; (* read only *)	33	width, height: INTEGER; (* read only *)
34	btnSize, sliderSize: INTEGER;	34	btnSize, sliderSize: INTEGER;
35	pos, Slider, pos0, maxVal, value: INTEGER;	35	pos, Slider, pos0, maxVal, value: INTEGER;
36	canvas*: G.tCanvas	36	canvas*: G.tCanvas
37	END;	37	END;
38		38
39		39
40	PROCEDURE create* (vertical: BOOLEAN; width, height: INTEGER; btnSize, sliderSize: INTEGER; VAR scroll: tScroll);	40	PROCEDURE create* (vertical: BOOLEAN; width, height: INTEGER; btnSize, sliderSize: INTEGER; VAR scroll: tScroll);
41	BEGIN	41	BEGIN
42	scroll.vertical := vertical;	42	scroll.vertical := vertical;
43	scroll.Inc := FALSE;	43	scroll.Inc := FALSE;
44	scroll.Dec := FALSE;	44	scroll.Dec := FALSE;
45	scroll.Slider := -1;	45	scroll.Slider := -1;
46	scroll.mouse := FALSE;	46	scroll.mouse := FALSE;
47	scroll.left := 0;	47	scroll.left := 0;
48	scroll.top := 0;	48	scroll.top := 0;
49	scroll.width := width;	49	scroll.width := width;
50	scroll.height := height;	50	scroll.height := height;
51	scroll.btnSize := btnSize;	51	scroll.btnSize := btnSize;
52	scroll.sliderSize := sliderSize;	52	scroll.sliderSize := sliderSize;
53	scroll.pos := 0;	53	scroll.pos := 0;
54	scroll.maxVal := 0;	54	scroll.maxVal := 0;
55	scroll.canvas := G.CreateCanvas(width, height)	55	scroll.canvas := G.CreateCanvas(width, height)
56	END create;	56	END create;
57		57
58		58
59	PROCEDURE Rect (canvas: G.tCanvas; left, top, right, bottom: INTEGER);	59	PROCEDURE Rect (canvas: G.tCanvas; left, top, right, bottom: INTEGER);
60	BEGIN	60	BEGIN
61	G.FillRect(canvas, left, top, right, bottom);	61	G.FillRect(canvas, left, top, right, bottom);
62	G.SetColor(canvas, K.borderColor);	62	G.SetColor(canvas, K.borderColor);
63	G.Rect(canvas, left, top, right, bottom);	63	G.Rect(canvas, left, top, right, bottom);
64	END Rect;	64	END Rect;
65		65
66		66
67	PROCEDURE _paint (scroll: tScroll);	67	PROCEDURE _paint (scroll: tScroll);
68	VAR	68	VAR
69	canvas: G.tCanvas;	69	canvas: G.tCanvas;
70	x, y, d, x1, x2, y1, y2,	70	x, y, d, x1, x2, y1, y2,
71	width, height, btn: INTEGER;	71	width, height, btn: INTEGER;
72		72
73		73
74	PROCEDURE SetColor (canvas: G.tCanvas; c: BOOLEAN);	74	PROCEDURE SetColor (canvas: G.tCanvas; c: BOOLEAN);
75	VAR	75	VAR
76	color: INTEGER;	76	color: INTEGER;
77	BEGIN	77	BEGIN
78	IF c THEN	78	IF c THEN
79	color := K.btnColor	79	color := K.btnColor
80	ELSE	80	ELSE
81	color := K.btnTextColor	81	color := K.btnTextColor
82	END;	82	END;
83	G.SetColor(canvas, color)	83	G.SetColor(canvas, color)
84	END SetColor;	84	END SetColor;
85		85
86		86
87	BEGIN	87	BEGIN
88	btn := scroll.btnSize;	88	btn := scroll.btnSize;
89	width := scroll.width;	89	width := scroll.width;
90	height := scroll.height;	90	height := scroll.height;
91	canvas := scroll.canvas;	91	canvas := scroll.canvas;
92	G.SetColor(canvas, K.winColor);	92	G.SetColor(canvas, K.winColor);
93	G.FillRect(canvas, 0, 0, width - 1, height - 1);	93	G.clear(canvas);
94	G.SetColor(canvas, K.borderColor);	94	G.SetColor(canvas, K.borderColor);
95	G.Rect(canvas, 0, 0, width - 1, height - 1);	95	G.Rect(canvas, 0, 0, width - 1, height - 1);
96	IF scroll.vertical THEN	96	IF scroll.vertical THEN
97	SetColor(canvas, ~scroll.Dec);	97	SetColor(canvas, ~scroll.Dec);
98	Rect(canvas, 0, 0, width - 1, btn - 1);	98	Rect(canvas, 0, 0, width - 1, btn - 1);
99	SetColor(canvas, ~scroll.Inc);	99	SetColor(canvas, ~scroll.Inc);
100	Rect(canvas, 0, height - btn, width - 1, height - 1);	100	Rect(canvas, 0, height - btn, width - 1, height - 1);
101	G.SetColor(canvas, K.btnColor);	101	G.SetColor(canvas, K.btnColor);
102	Rect(canvas, 0, btn + scroll.pos - 1, width - 1, btn + scroll.pos + scroll.sliderSize - 1);	102	Rect(canvas, 0, btn + scroll.pos - 1, width - 1, btn + scroll.pos + scroll.sliderSize - 1);
103		103
104	G.SetColor(canvas, K.btnTextColor);	104	G.SetColor(canvas, K.btnTextColor);
105		105
106	y := btn + scroll.pos + scroll.sliderSize DIV 2 - 1;	106	y := btn + scroll.pos + scroll.sliderSize DIV 2 - 1;
107	G.HLine(canvas, y, width DIV 4, 3*width DIV 4);	107	G.HLine(canvas, y, width DIV 4, 3*width DIV 4);
108	G.HLine(canvas, y - 3, width DIV 3, 2*width DIV 3);	108	G.HLine(canvas, y - 3, width DIV 3, 2*width DIV 3);
109	G.HLine(canvas, y + 3, width DIV 3, 2*width DIV 3);	109	G.HLine(canvas, y + 3, width DIV 3, 2*width DIV 3);
110		110
111	d := 4*width DIV 10;	111	d := 4*width DIV 10;
112	x1 := (width - d) DIV 2;	112	x1 := (width - d) DIV 2;
113	x2 := x1 + d;	113	x2 := x1 + d;
114		114
115	SetColor(canvas, scroll.Dec);	115	SetColor(canvas, scroll.Dec);
116	y := (btn - d DIV 2) DIV 2 + d DIV 2 - 1;	116	y := (btn - d DIV 2) DIV 2 + d DIV 2 - 1;
117	G.Triangle(canvas, x1 - 1, y, x2, y, G.triUp);	117	G.Triangle(canvas, x1 - 1, y, x2, y, G.triUp);
118		118
119	SetColor(canvas, scroll.Inc);	119	SetColor(canvas, scroll.Inc);
120	y := y + height - btn - d DIV 2 + 1;	120	y := y + height - btn - d DIV 2 + 1;
121	G.Triangle(canvas, x1 - 1, y, x2, y, G.triDown);	121	G.Triangle(canvas, x1 - 1, y, x2, y, G.triDown);
122	ELSE	122	ELSE
123	SetColor(canvas, ~scroll.Dec);	123	SetColor(canvas, ~scroll.Dec);
124	Rect(canvas, 0, 0, btn - 1, height - 1);	124	Rect(canvas, 0, 0, btn - 1, height - 1);
125	SetColor(canvas, ~scroll.Inc);	125	SetColor(canvas, ~scroll.Inc);
126	Rect(canvas, width - btn, 0, width - 1, height - 1);	126	Rect(canvas, width - btn, 0, width - 1, height - 1);
127	G.SetColor(canvas, K.btnColor);	127	G.SetColor(canvas, K.btnColor);
128	Rect(canvas, btn + scroll.pos - 1, 0, btn + scroll.pos + scroll.sliderSize - 1, height - 1);	128	Rect(canvas, btn + scroll.pos - 1, 0, btn + scroll.pos + scroll.sliderSize - 1, height - 1);
129		129
130	G.SetColor(canvas, K.btnTextColor);	130	G.SetColor(canvas, K.btnTextColor);
131		131
132	x := btn + scroll.pos + scroll.sliderSize DIV 2 - 1;	132	x := btn + scroll.pos + scroll.sliderSize DIV 2 - 1;
133	G.VLine(canvas, x, height DIV 4, 3*height DIV 4);	133	G.VLine(canvas, x, height DIV 4, 3*height DIV 4);
134	G.VLine(canvas, x - 3, height DIV 3, 2*height DIV 3);	134	G.VLine(canvas, x - 3, height DIV 3, 2*height DIV 3);
135	G.VLine(canvas, x + 3, height DIV 3, 2*height DIV 3);	135	G.VLine(canvas, x + 3, height DIV 3, 2*height DIV 3);
136		136
137	d := 4*height DIV 10;	137	d := 4*height DIV 10;
138	y1 := (height - d) DIV 2;	138	y1 := (height - d) DIV 2;
139	y2 := y1 + d;	139	y2 := y1 + d;
140		140
141	SetColor(canvas, scroll.Dec);	141	SetColor(canvas, scroll.Dec);
142	x := (btn - d DIV 2) DIV 2 + d DIV 2 - 1;	142	x := (btn - d DIV 2) DIV 2 + d DIV 2 - 1;
143	G.Triangle(canvas, x, y1 - 1, x, y2, G.triLeft);	143	G.Triangle(canvas, x, y1 - 1, x, y2, G.triLeft);
144		144
145	SetColor(canvas, scroll.Inc);	145	SetColor(canvas, scroll.Inc);
146	x := x + width - btn - d DIV 2 + 1;	146	x := x + width - btn - d DIV 2 + 1;
147	G.Triangle(canvas, x, y1 - 1, x, y2, G.triRight);	147	G.Triangle(canvas, x, y1 - 1, x, y2, G.triRight);
148	END;	148	END;
149	G.DrawCanvas(scroll.canvas, scroll.left, scroll.top)	149	G.DrawCanvas(scroll.canvas, scroll.left, scroll.top)
150	END _paint;	150	END _paint;
151		151
152		152
153	PROCEDURE paint* (scroll: tScroll);	153	PROCEDURE paint* (scroll: tScroll);
154	BEGIN	154	BEGIN
155	IF scroll.canvas # NIL THEN	155	IF scroll.canvas # NIL THEN
156	_paint(scroll)	156	_paint(scroll)
157	END	157	END
158	END paint;	158	END paint;
159		159
160		160
161	PROCEDURE resize* (VAR scroll: tScroll; width, height: INTEGER);	161	PROCEDURE resize* (VAR scroll: tScroll; width, height: INTEGER);
162	BEGIN	162	BEGIN
163	G.destroy(scroll.canvas);	163	G.destroy(scroll.canvas);
164	scroll.canvas := G.CreateCanvas(width, height);	164	scroll.canvas := G.CreateCanvas(width, height);
165	scroll.width := width;	165	scroll.width := width;
166	scroll.height := height;	166	scroll.height := height;
167	paint(scroll)	167	paint(scroll)
168	END resize;	168	END resize;
169		169
170		170
171	PROCEDURE setValue* (VAR scroll: tScroll; value: INTEGER);	171	PROCEDURE setValue* (VAR scroll: tScroll; value: INTEGER);
172	VAR	172	VAR
173	pos, maxPos, n, m: INTEGER;	173	pos, maxPos, n, m: INTEGER;
174	BEGIN	174	BEGIN
175	IF scroll.vertical THEN	175	IF scroll.vertical THEN
176	maxPos := scroll.height	176	maxPos := scroll.height
177	ELSE	177	ELSE
178	maxPos := scroll.width	178	maxPos := scroll.width
179	END;	179	END;
180	maxPos := maxPos - scroll.btnSize*2 - scroll.sliderSize + 1;	180	maxPos := maxPos - scroll.btnSize*2 - scroll.sliderSize + 1;
181	IF (value < 0) OR (scroll.maxVal <= 0) THEN	181	IF (value < 0) OR (scroll.maxVal <= 0) THEN
182	value := 0;	182	value := 0;
183	pos := 0	183	pos := 0
184	ELSIF value > scroll.maxVal THEN	184	ELSIF value > scroll.maxVal THEN
185	value := scroll.maxVal;	185	value := scroll.maxVal;
186	pos := maxPos	186	pos := maxPos
187	ELSE	187	ELSE
188	IF (maxPos + 1) >= scroll.maxVal THEN	188	IF (maxPos + 1) >= scroll.maxVal THEN
189	n := (maxPos + 1) DIV scroll.maxVal;	189	n := (maxPos + 1) DIV scroll.maxVal;
190	m := (maxPos + 1) MOD scroll.maxVal;	190	m := (maxPos + 1) MOD scroll.maxVal;
191	pos := value*n + MIN(value, m)	191	pos := value*n + MIN(value, m)
192	ELSE	192	ELSE
193	pos := value*(maxPos + 1) DIV scroll.maxVal	193	pos := value*(maxPos + 1) DIV scroll.maxVal
194	END;	194	END;
195	IF pos > maxPos THEN	195	IF pos > maxPos THEN
196	pos := maxPos;	196	pos := maxPos;
197	value := scroll.maxVal	197	value := scroll.maxVal
198	END	198	END
199	END;	199	END;
200	scroll.pos := pos;	200	scroll.pos := pos;
201	scroll.value := value	201	scroll.value := value
202	END setValue;	202	END setValue;
203		203
204		204
205	PROCEDURE change* (VAR scroll: tScroll);	205	PROCEDURE change* (VAR scroll: tScroll);
206	BEGIN	206	BEGIN
207	IF scroll.Inc THEN	207	IF scroll.Inc THEN
208	setValue(scroll, scroll.value + 1)	208	setValue(scroll, scroll.value + 1)
209	ELSIF scroll.Dec THEN	209	ELSIF scroll.Dec THEN
210	setValue(scroll, scroll.value - 1)	210	setValue(scroll, scroll.value - 1)
211	END;	211	END;
212	paint(scroll)	212	paint(scroll)
213	END change;	213	END change;
214		214
215		215
216	PROCEDURE ceil (p, q: INTEGER): INTEGER;	216	PROCEDURE ceil (p, q: INTEGER): INTEGER;
217	RETURN p DIV q + ORD(p MOD q # 0)	217	RETURN p DIV q + ORD(p MOD q # 0)
218	END ceil;	218	END ceil;
219		219
220		220
221	PROCEDURE setPos (VAR scroll: tScroll; pos: INTEGER);	221	PROCEDURE setPos (VAR scroll: tScroll; pos: INTEGER);
222	VAR	222	VAR
223	maxPos, value, n, m, x, x0, q: INTEGER;	223	maxPos, value, n, m, x, x0, q: INTEGER;
224	BEGIN	224	BEGIN
225	IF scroll.maxVal > 0 THEN	225	IF scroll.maxVal > 0 THEN
226	IF scroll.vertical THEN	226	IF scroll.vertical THEN
227	maxPos := scroll.height	227	maxPos := scroll.height
228	ELSE	228	ELSE
229	maxPos := scroll.width	229	maxPos := scroll.width
230	END;	230	END;
231	maxPos := maxPos - scroll.btnSize*2 - scroll.sliderSize + 1;	231	maxPos := maxPos - scroll.btnSize*2 - scroll.sliderSize + 1;
232	IF pos <= 0 THEN	232	IF pos <= 0 THEN
233	pos := 0;	233	pos := 0;
234	value := 0	234	value := 0
235	ELSIF pos >= maxPos THEN	235	ELSIF pos >= maxPos THEN
236	pos := maxPos;	236	pos := maxPos;
237	value := scroll.maxVal	237	value := scroll.maxVal
238	ELSE	238	ELSE
239	IF scroll.maxVal <= maxPos + 1 THEN	239	IF scroll.maxVal <= maxPos + 1 THEN
240	n := (maxPos + 1) DIV scroll.maxVal;	240	n := (maxPos + 1) DIV scroll.maxVal;
241	m := (maxPos + 1) MOD scroll.maxVal;	241	m := (maxPos + 1) MOD scroll.maxVal;
242		242
243	q := m*(n + 1);	243	q := m*(n + 1);
244	IF q < pos THEN	244	IF q < pos THEN
245	value := ceil(pos - m, n)	245	value := ceil(pos - m, n)
246	ELSIF q > pos THEN	246	ELSIF q > pos THEN
247	value := ceil(pos, n + 1)	247	value := ceil(pos, n + 1)
248	ELSE	248	ELSE
249	value := m	249	value := m
250	END;	250	END;
251		251
252	x := value*n + MIN(value, m);	252	x := value*n + MIN(value, m);
253	x0 := (value - 1)*n + MIN(value - 1, m);	253	x0 := (value - 1)*n + MIN(value - 1, m);
254		254
255	IF x - pos > pos - x0 THEN	255	IF x - pos > pos - x0 THEN
256	pos := x0;	256	pos := x0;
257	DEC(value)	257	DEC(value)
258	ELSE	258	ELSE
259	pos := x;	259	pos := x;
260	IF pos > maxPos THEN	260	IF pos > maxPos THEN
261	pos := maxPos;	261	pos := maxPos;
262	value := scroll.maxVal	262	value := scroll.maxVal
263	END	263	END
264	END	264	END
265	ELSE	265	ELSE
266	value := scroll.maxVal*pos DIV (maxPos + 1)	266	value := scroll.maxVal*pos DIV (maxPos + 1)
267	END	267	END
268	END	268	END
269	ELSE	269	ELSE
270	pos := 0;	270	pos := 0;
271	scroll.value := 0	271	scroll.value := 0
272	END;	272	END;
273	scroll.pos := pos;	273	scroll.pos := pos;
274	scroll.value := value	274	scroll.value := value
275	END setPos;	275	END setPos;
276		276
277		277
278	PROCEDURE isActive* (scroll: tScroll): BOOLEAN;	278	PROCEDURE isActive* (scroll: tScroll): BOOLEAN;
279	RETURN scroll.Inc OR scroll.Dec OR (scroll.Slider # -1)	279	RETURN scroll.Inc OR scroll.Dec OR (scroll.Slider # -1)
280	END isActive;	280	END isActive;
281		281
282		282
283	PROCEDURE MouseMove* (VAR scroll: tScroll; x, y: INTEGER);	283	PROCEDURE MouseMove* (VAR scroll: tScroll; x, y: INTEGER);
284	VAR	284	VAR
285	c: INTEGER;	285	c: INTEGER;
286	BEGIN	286	BEGIN
287	IF scroll.Slider # -1 THEN	287	IF scroll.Slider # -1 THEN
288	IF scroll.vertical THEN	288	IF scroll.vertical THEN
289	c := y - scroll.top	289	c := y - scroll.top
290	ELSE	290	ELSE
291	c := x - scroll.left	291	c := x - scroll.left
292	END;	292	END;
293	setPos(scroll, scroll.pos0 + c - scroll.Slider);	293	setPos(scroll, scroll.pos0 + c - scroll.Slider);
294	paint(scroll)	294	paint(scroll)
295	END	295	END
296	END MouseMove;	296	END MouseMove;
297		297
298		298
299	PROCEDURE between (a, b, c: INTEGER): BOOLEAN;	299	PROCEDURE between (a, b, c: INTEGER): BOOLEAN;
300	RETURN (a <= b) & (b <= c)	300	RETURN (a <= b) & (b <= c)
301	END between;	301	END between;
302		302
303		303
304	PROCEDURE SendIPC*;	304	PROCEDURE SendIPC*;
305	BEGIN	305	BEGIN
306	K.SendIPC(K.ThreadID(), ScrollIPC)	306	K.SendIPC(K.ThreadID(), ScrollIPC)
307	END SendIPC;	307	END SendIPC;
308		308
309		309
310	PROCEDURE MouseDown* (VAR scroll: tScroll; x, y: INTEGER);	310	PROCEDURE MouseDown* (VAR scroll: tScroll; x, y: INTEGER);
311	VAR	311	VAR
312	c, size: INTEGER;	312	c, size: INTEGER;
313	BEGIN	313	BEGIN
314	x := x - scroll.left;	314	x := x - scroll.left;
315	y := y - scroll.top;	315	y := y - scroll.top;
316	scroll.mouse := TRUE;	316	scroll.mouse := TRUE;
317	IF between(0, x, scroll.width - 1) & between(0, y, scroll.height - 1) THEN	317	IF between(0, x, scroll.width - 1) & between(0, y, scroll.height - 1) THEN
318	IF scroll.vertical THEN	318	IF scroll.vertical THEN
319	c := y;	319	c := y;
320	size := scroll.height	320	size := scroll.height
321	ELSE	321	ELSE
322	c := x;	322	c := x;
323	size := scroll.width	323	size := scroll.width
324	END;	324	END;
325	IF between(scroll.btnSize + scroll.pos - 1, c, scroll.btnSize + scroll.pos + scroll.sliderSize - 1) THEN	325	IF between(scroll.btnSize + scroll.pos - 1, c, scroll.btnSize + scroll.pos + scroll.sliderSize - 1) THEN
326	scroll.pos0 := scroll.pos;	326	scroll.pos0 := scroll.pos;
327	scroll.Slider := c	327	scroll.Slider := c
328	ELSE	328	ELSE
329	IF between(0, c, scroll.btnSize - 1) THEN	329	IF between(0, c, scroll.btnSize - 1) THEN
330	scroll.Dec := TRUE;	330	scroll.Dec := TRUE;
331	SendIPC	331	SendIPC
332	ELSE	332	ELSE
333	IF between(size - scroll.btnSize, c, size - 1) THEN	333	IF between(size - scroll.btnSize, c, size - 1) THEN
334	scroll.Inc := TRUE;	334	scroll.Inc := TRUE;
335	SendIPC	335	SendIPC
336	ELSE	336	ELSE
337	setPos(scroll, c - scroll.btnSize - scroll.sliderSize DIV 2);	337	setPos(scroll, c - scroll.btnSize - scroll.sliderSize DIV 2);
338	scroll.pos0 := scroll.pos;	338	scroll.pos0 := scroll.pos;
339	scroll.Slider := c;	339	scroll.Slider := c;
340	paint(scroll)	340	paint(scroll)
341	END	341	END
342	END	342	END
343	END	343	END
344	END	344	END
345	END MouseDown;	345	END MouseDown;
346		346
347		347
348	PROCEDURE MouseUp* (VAR scroll: tScroll);	348	PROCEDURE MouseUp* (VAR scroll: tScroll);
349	BEGIN	349	BEGIN
350	IF scroll.mouse THEN	350	IF scroll.mouse THEN
351	scroll.Slider := -1;	351	scroll.Slider := -1;
352	scroll.Inc := FALSE;	352	scroll.Inc := FALSE;
353	scroll.Dec := FALSE;	353	scroll.Dec := FALSE;
354	scroll.mouse := FALSE;	354	scroll.mouse := FALSE;
355	paint(scroll)	355	paint(scroll)
356	END	356	END
357	END MouseUp;	357	END MouseUp;
358		358
359		359
360	END Scroll.	360	END Scroll.

Subversion Repositories Kolibri OS

(root)/programs/develop/cedit/SRC/scroll.ob07 – Rev 9174 → 9180