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, U := Utils;
 
CONST
 
	ScrollIPC* = 0;
	DELAY = 40;
 
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;
 
	tProcedure* = PROCEDURE;
 
VAR
 
	ScrollChange: tProcedure;
	delay: INTEGER;
 
 
PROCEDURE MouseUp (VAR scroll: tScroll);
BEGIN
	scroll.Slider := -1;
	scroll.Inc := FALSE;
	scroll.Dec := FALSE;
	scroll.mouse := FALSE;
END MouseUp;
 
 
PROCEDURE create* (vertical: BOOLEAN; width, height: INTEGER; btnSize, sliderSize: INTEGER; VAR scroll: tScroll);
VAR
	res: tScroll;
BEGIN
	MouseUp(res);
	res.vertical := vertical;
	res.left := 0;
	res.top := 0;
	res.width := width;
	res.height := height;
	res.btnSize := btnSize;
	res.sliderSize := sliderSize;
	res.pos := 0;
	res.maxVal := 0;
	res.canvas := G.CreateCanvas(width, height);
	scroll := res
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.lightColor);
	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 := FLOOR(FLT(value)*FLT(maxPos + 1)/FLT(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 := FLOOR(FLT(scroll.maxVal)*FLT(pos)/FLT(maxPos + 1))
			END
		END
	ELSE
		pos := 0;
		scroll.value := 0
	END;
	scroll.pos := pos;
	scroll.value := value
END setPos;
 
 
PROCEDURE MouseMove (VAR scroll: tScroll; x, y: INTEGER);
VAR
	c: INTEGER;
BEGIN
	IF scroll.vertical THEN
		c := y - scroll.top
	ELSE
		c := x - scroll.left
	END;
	setPos(scroll, scroll.pos0 + c - scroll.Slider);
	paint(scroll)
END MouseMove;
 
 
PROCEDURE SendIPC;
VAR
	msg: ARRAY 2 OF INTEGER;
BEGIN
	msg[0] := ScrollIPC;
	msg[1] := 8;
	K.SendIPC(K.ThreadID(), msg)
END SendIPC;
 
 
PROCEDURE receiveIPC* (VAR IPC: ARRAY OF INTEGER; VAR scrollIPC: BOOLEAN);
BEGIN
	scrollIPC := FALSE;
	ScrollChange;
	IF 0 IN K.MouseState() THEN
		WHILE (0 IN K.MouseState()) & (delay > 0) DO
			K.Pause(1);
    		DEC(delay)
		END;
		IF delay = 0 THEN
			IPC[0] := 0;
			IPC[1] := 0;
			scrollIPC := TRUE;
    		SendIPC;
    		delay := 4
		ELSE
			delay := DELAY
		END
	ELSE
		delay := DELAY
	END
END receiveIPC;
 
 
PROCEDURE MouseDown (VAR scroll: tScroll; x, y: INTEGER);
VAR
	c, size: INTEGER;
BEGIN
	DEC(x, scroll.left);
	DEC(y, scroll.top);
	scroll.mouse := TRUE;
	IF U.between(1, x, scroll.width - 2) & U.between(1, y, scroll.height - 2) THEN
		IF scroll.vertical THEN
			c := y;
			size := scroll.height
		ELSE
			c := x;
			size := scroll.width
		END;
		IF U.between(scroll.btnSize + scroll.pos - 1, c, scroll.btnSize + scroll.pos + scroll.sliderSize - 1) THEN
			scroll.pos0 := scroll.pos;
			scroll.Slider := c
		ELSIF U.between(0, c, scroll.btnSize - 1) THEN
			scroll.Dec := TRUE;
			SendIPC
		ELSIF U.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 MouseDown;
 
 
PROCEDURE mouse* (VAR scroll: tScroll);
VAR
	msState: SET;
	x, y: INTEGER;
BEGIN
	K.mouse(msState, x, y);
	IF 0 IN msState THEN
		IF ~scroll.mouse THEN
			MouseDown(scroll, x, y)
		ELSIF scroll.Slider # -1 THEN
			MouseMove(scroll, x, y)
		END
	ELSIF scroll.mouse THEN
		MouseUp(scroll);
		paint(scroll)
	END
END mouse;
 
 
PROCEDURE init* (_ScrollChange: tProcedure);
BEGIN
	delay := DELAY;
	ScrollChange := _ScrollChange
END init;
 
 
END Scroll.

Rev 9210	Rev 9431
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, U := Utils;	22	IMPORT G := Graph, K := KolibriOS, U := Utils;
23		23
24	CONST	24	CONST
25		25
26	ScrollIPC* = 0;	26	ScrollIPC* = 0;
27	DELAY = 40;	27	DELAY = 40;
28		28
29	TYPE	29	TYPE
30		30
31	tScroll* = RECORD	31	tScroll* = RECORD
32	vertical, Inc, Dec, mouse: BOOLEAN;	32	vertical, Inc, Dec, mouse: BOOLEAN;
33	top, left,	33	top, left,
34	width, height: INTEGER; (* read only *)	34	width, height: INTEGER; (* read only *)
35	btnSize, sliderSize: INTEGER;	35	btnSize, sliderSize: INTEGER;
36	pos, Slider, pos0, maxVal, value: INTEGER;	36	pos, Slider, pos0, maxVal, value: INTEGER;
37	canvas*: G.tCanvas	37	canvas*: G.tCanvas
38	END;	38	END;
39		39
40	tProcedure* = PROCEDURE;	40	tProcedure* = PROCEDURE;
41		41
42	VAR	42	VAR
43		43
44	ScrollChange: tProcedure;	44	ScrollChange: tProcedure;
45	delay: INTEGER;	45	delay: INTEGER;
46		46
47		47
48	PROCEDURE MouseUp (VAR scroll: tScroll);	48	PROCEDURE MouseUp (VAR scroll: tScroll);
49	BEGIN	49	BEGIN
50	scroll.Slider := -1;	50	scroll.Slider := -1;
51	scroll.Inc := FALSE;	51	scroll.Inc := FALSE;
52	scroll.Dec := FALSE;	52	scroll.Dec := FALSE;
53	scroll.mouse := FALSE;	53	scroll.mouse := FALSE;
54	END MouseUp;	54	END MouseUp;
55		55
56		56
57	PROCEDURE create* (vertical: BOOLEAN; width, height: INTEGER; btnSize, sliderSize: INTEGER; VAR scroll: tScroll);	57	PROCEDURE create* (vertical: BOOLEAN; width, height: INTEGER; btnSize, sliderSize: INTEGER; VAR scroll: tScroll);
58	VAR	58	VAR
59	res: tScroll;	59	res: tScroll;
60	BEGIN	60	BEGIN
61	MouseUp(res);	61	MouseUp(res);
62	res.vertical := vertical;	62	res.vertical := vertical;
63	res.left := 0;	63	res.left := 0;
64	res.top := 0;	64	res.top := 0;
65	res.width := width;	65	res.width := width;
66	res.height := height;	66	res.height := height;
67	res.btnSize := btnSize;	67	res.btnSize := btnSize;
68	res.sliderSize := sliderSize;	68	res.sliderSize := sliderSize;
69	res.pos := 0;	69	res.pos := 0;
70	res.maxVal := 0;	70	res.maxVal := 0;
71	res.canvas := G.CreateCanvas(width, height);	71	res.canvas := G.CreateCanvas(width, height);
72	scroll := res	72	scroll := res
73	END create;	73	END create;
74		74
75		75
76	PROCEDURE Rect (canvas: G.tCanvas; left, top, right, bottom: INTEGER);	76	PROCEDURE Rect (canvas: G.tCanvas; left, top, right, bottom: INTEGER);
77	BEGIN	77	BEGIN
78	G.FillRect(canvas, left, top, right, bottom);	78	G.FillRect(canvas, left, top, right, bottom);
79	G.SetColor(canvas, K.borderColor);	79	G.SetColor(canvas, K.borderColor);
80	G.Rect(canvas, left, top, right, bottom);	80	G.Rect(canvas, left, top, right, bottom);
81	END Rect;	81	END Rect;
82		82
83		83
84	PROCEDURE _paint (scroll: tScroll);	84	PROCEDURE _paint (scroll: tScroll);
85	VAR	85	VAR
86	canvas: G.tCanvas;	86	canvas: G.tCanvas;
87	x, y, d, x1, x2, y1, y2,	87	x, y, d, x1, x2, y1, y2,
88	width, height, btn: INTEGER;	88	width, height, btn: INTEGER;
89		89
90		90
91	PROCEDURE SetColor (canvas: G.tCanvas; c: BOOLEAN);	91	PROCEDURE SetColor (canvas: G.tCanvas; c: BOOLEAN);
92	VAR	92	VAR
93	color: INTEGER;	93	color: INTEGER;
94	BEGIN	94	BEGIN
95	IF c THEN	95	IF c THEN
96	color := K.btnColor	96	color := K.btnColor
97	ELSE	97	ELSE
98	color := K.btnTextColor	98	color := K.btnTextColor
99	END;	99	END;
100	G.SetColor(canvas, color)	100	G.SetColor(canvas, color)
101	END SetColor;	101	END SetColor;
102		102
103		103
104	BEGIN	104	BEGIN
105	btn := scroll.btnSize;	105	btn := scroll.btnSize;
106	width := scroll.width;	106	width := scroll.width;
107	height := scroll.height;	107	height := scroll.height;
108	canvas := scroll.canvas;	108	canvas := scroll.canvas;
109	G.SetColor(canvas, K.winColor);	109	G.SetColor(canvas, K.lightColor);
110	G.clear(canvas);	110	G.clear(canvas);
111	G.SetColor(canvas, K.borderColor);	111	G.SetColor(canvas, K.borderColor);
112	G.Rect(canvas, 0, 0, width - 1, height - 1);	112	G.Rect(canvas, 0, 0, width - 1, height - 1);
113	IF scroll.vertical THEN	113	IF scroll.vertical THEN
114	SetColor(canvas, ~scroll.Dec);	114	SetColor(canvas, ~scroll.Dec);
115	Rect(canvas, 0, 0, width - 1, btn - 1);	115	Rect(canvas, 0, 0, width - 1, btn - 1);
116	SetColor(canvas, ~scroll.Inc);	116	SetColor(canvas, ~scroll.Inc);
117	Rect(canvas, 0, height - btn, width - 1, height - 1);	117	Rect(canvas, 0, height - btn, width - 1, height - 1);
118	G.SetColor(canvas, K.btnColor);	118	G.SetColor(canvas, K.btnColor);
119	Rect(canvas, 0, btn + scroll.pos - 1, width - 1, btn + scroll.pos + scroll.sliderSize - 1);	119	Rect(canvas, 0, btn + scroll.pos - 1, width - 1, btn + scroll.pos + scroll.sliderSize - 1);
120		120
121	G.SetColor(canvas, K.btnTextColor);	121	G.SetColor(canvas, K.btnTextColor);
122		122
123	y := btn + scroll.pos + scroll.sliderSize DIV 2 - 1;	123	y := btn + scroll.pos + scroll.sliderSize DIV 2 - 1;
124	G.HLine(canvas, y, width DIV 4, 3*width DIV 4);	124	G.HLine(canvas, y, width DIV 4, 3*width DIV 4);
125	G.HLine(canvas, y - 3, width DIV 3, 2*width DIV 3);	125	G.HLine(canvas, y - 3, width DIV 3, 2*width DIV 3);
126	G.HLine(canvas, y + 3, width DIV 3, 2*width DIV 3);	126	G.HLine(canvas, y + 3, width DIV 3, 2*width DIV 3);
127		127
128	d := 4*width DIV 10;	128	d := 4*width DIV 10;
129	x1 := (width - d) DIV 2;	129	x1 := (width - d) DIV 2;
130	x2 := x1 + d;	130	x2 := x1 + d;
131		131
132	SetColor(canvas, scroll.Dec);	132	SetColor(canvas, scroll.Dec);
133	y := (btn - d DIV 2) DIV 2 + d DIV 2 - 1;	133	y := (btn - d DIV 2) DIV 2 + d DIV 2 - 1;
134	G.Triangle(canvas, x1 - 1, y, x2, y, G.triUp);	134	G.Triangle(canvas, x1 - 1, y, x2, y, G.triUp);
135		135
136	SetColor(canvas, scroll.Inc);	136	SetColor(canvas, scroll.Inc);
137	y := y + height - btn - d DIV 2 + 1;	137	y := y + height - btn - d DIV 2 + 1;
138	G.Triangle(canvas, x1 - 1, y, x2, y, G.triDown);	138	G.Triangle(canvas, x1 - 1, y, x2, y, G.triDown);
139	ELSE	139	ELSE
140	SetColor(canvas, ~scroll.Dec);	140	SetColor(canvas, ~scroll.Dec);
141	Rect(canvas, 0, 0, btn - 1, height - 1);	141	Rect(canvas, 0, 0, btn - 1, height - 1);
142	SetColor(canvas, ~scroll.Inc);	142	SetColor(canvas, ~scroll.Inc);
143	Rect(canvas, width - btn, 0, width - 1, height - 1);	143	Rect(canvas, width - btn, 0, width - 1, height - 1);
144	G.SetColor(canvas, K.btnColor);	144	G.SetColor(canvas, K.btnColor);
145	Rect(canvas, btn + scroll.pos - 1, 0, btn + scroll.pos + scroll.sliderSize - 1, height - 1);	145	Rect(canvas, btn + scroll.pos - 1, 0, btn + scroll.pos + scroll.sliderSize - 1, height - 1);
146		146
147	G.SetColor(canvas, K.btnTextColor);	147	G.SetColor(canvas, K.btnTextColor);
148		148
149	x := btn + scroll.pos + scroll.sliderSize DIV 2 - 1;	149	x := btn + scroll.pos + scroll.sliderSize DIV 2 - 1;
150	G.VLine(canvas, x, height DIV 4, 3*height DIV 4);	150	G.VLine(canvas, x, height DIV 4, 3*height DIV 4);
151	G.VLine(canvas, x - 3, height DIV 3, 2*height DIV 3);	151	G.VLine(canvas, x - 3, height DIV 3, 2*height DIV 3);
152	G.VLine(canvas, x + 3, height DIV 3, 2*height DIV 3);	152	G.VLine(canvas, x + 3, height DIV 3, 2*height DIV 3);
153		153
154	d := 4*height DIV 10;	154	d := 4*height DIV 10;
155	y1 := (height - d) DIV 2;	155	y1 := (height - d) DIV 2;
156	y2 := y1 + d;	156	y2 := y1 + d;
157		157
158	SetColor(canvas, scroll.Dec);	158	SetColor(canvas, scroll.Dec);
159	x := (btn - d DIV 2) DIV 2 + d DIV 2 - 1;	159	x := (btn - d DIV 2) DIV 2 + d DIV 2 - 1;
160	G.Triangle(canvas, x, y1 - 1, x, y2, G.triLeft);	160	G.Triangle(canvas, x, y1 - 1, x, y2, G.triLeft);
161		161
162	SetColor(canvas, scroll.Inc);	162	SetColor(canvas, scroll.Inc);
163	x := x + width - btn - d DIV 2 + 1;	163	x := x + width - btn - d DIV 2 + 1;
164	G.Triangle(canvas, x, y1 - 1, x, y2, G.triRight);	164	G.Triangle(canvas, x, y1 - 1, x, y2, G.triRight);
165	END;	165	END;
166	G.DrawCanvas(scroll.canvas, scroll.left, scroll.top)	166	G.DrawCanvas(scroll.canvas, scroll.left, scroll.top)
167	END _paint;	167	END _paint;
168		168
169		169
170	PROCEDURE paint* (scroll: tScroll);	170	PROCEDURE paint* (scroll: tScroll);
171	BEGIN	171	BEGIN
172	IF scroll.canvas # NIL THEN	172	IF scroll.canvas # NIL THEN
173	_paint(scroll)	173	_paint(scroll)
174	END	174	END
175	END paint;	175	END paint;
176		176
177		177
178	PROCEDURE resize* (VAR scroll: tScroll; width, height: INTEGER);	178	PROCEDURE resize* (VAR scroll: tScroll; width, height: INTEGER);
179	BEGIN	179	BEGIN
180	G.destroy(scroll.canvas);	180	G.destroy(scroll.canvas);
181	scroll.canvas := G.CreateCanvas(width, height);	181	scroll.canvas := G.CreateCanvas(width, height);
182	scroll.width := width;	182	scroll.width := width;
183	scroll.height := height;	183	scroll.height := height;
184	paint(scroll)	184	paint(scroll)
185	END resize;	185	END resize;
186		186
187		187
188	PROCEDURE setValue* (VAR scroll: tScroll; value: INTEGER);	188	PROCEDURE setValue* (VAR scroll: tScroll; value: INTEGER);
189	VAR	189	VAR
190	pos, maxPos, n, m: INTEGER;	190	pos, maxPos, n, m: INTEGER;
191	BEGIN	191	BEGIN
192	IF scroll.vertical THEN	192	IF scroll.vertical THEN
193	maxPos := scroll.height	193	maxPos := scroll.height
194	ELSE	194	ELSE
195	maxPos := scroll.width	195	maxPos := scroll.width
196	END;	196	END;
197	maxPos := maxPos - scroll.btnSize*2 - scroll.sliderSize + 1;	197	maxPos := maxPos - scroll.btnSize*2 - scroll.sliderSize + 1;
198	IF (value < 0) OR (scroll.maxVal <= 0) THEN	198	IF (value < 0) OR (scroll.maxVal <= 0) THEN
199	value := 0;	199	value := 0;
200	pos := 0	200	pos := 0
201	ELSIF value > scroll.maxVal THEN	201	ELSIF value > scroll.maxVal THEN
202	value := scroll.maxVal;	202	value := scroll.maxVal;
203	pos := maxPos	203	pos := maxPos
204	ELSE	204	ELSE
205	IF (maxPos + 1) >= scroll.maxVal THEN	205	IF (maxPos + 1) >= scroll.maxVal THEN
206	n := (maxPos + 1) DIV scroll.maxVal;	206	n := (maxPos + 1) DIV scroll.maxVal;
207	m := (maxPos + 1) MOD scroll.maxVal;	207	m := (maxPos + 1) MOD scroll.maxVal;
208	pos := value*n + MIN(value, m)	208	pos := value*n + MIN(value, m)
209	ELSE	209	ELSE
210	pos := FLOOR(FLT(value)*FLT(maxPos + 1)/FLT(scroll.maxVal))	210	pos := FLOOR(FLT(value)*FLT(maxPos + 1)/FLT(scroll.maxVal))
211	END;	211	END;
212	IF pos > maxPos THEN	212	IF pos > maxPos THEN
213	pos := maxPos;	213	pos := maxPos;
214	value := scroll.maxVal	214	value := scroll.maxVal
215	END	215	END
216	END;	216	END;
217	scroll.pos := pos;	217	scroll.pos := pos;
218	scroll.value := value	218	scroll.value := value
219	END setValue;	219	END setValue;
220		220
221		221
222	PROCEDURE change* (VAR scroll: tScroll);	222	PROCEDURE change* (VAR scroll: tScroll);
223	BEGIN	223	BEGIN
224	IF scroll.Inc THEN	224	IF scroll.Inc THEN
225	setValue(scroll, scroll.value + 1)	225	setValue(scroll, scroll.value + 1)
226	ELSIF scroll.Dec THEN	226	ELSIF scroll.Dec THEN
227	setValue(scroll, scroll.value - 1)	227	setValue(scroll, scroll.value - 1)
228	END;	228	END;
229	paint(scroll)	229	paint(scroll)
230	END change;	230	END change;
231		231
232		232
233	PROCEDURE ceil (p, q: INTEGER): INTEGER;	233	PROCEDURE ceil (p, q: INTEGER): INTEGER;
234	RETURN p DIV q + ORD(p MOD q # 0)	234	RETURN p DIV q + ORD(p MOD q # 0)
235	END ceil;	235	END ceil;
236		236
237		237
238	PROCEDURE setPos (VAR scroll: tScroll; pos: INTEGER);	238	PROCEDURE setPos (VAR scroll: tScroll; pos: INTEGER);
239	VAR	239	VAR
240	maxPos, value, n, m, x, x0, q: INTEGER;	240	maxPos, value, n, m, x, x0, q: INTEGER;
241	BEGIN	241	BEGIN
242	IF scroll.maxVal > 0 THEN	242	IF scroll.maxVal > 0 THEN
243	IF scroll.vertical THEN	243	IF scroll.vertical THEN
244	maxPos := scroll.height	244	maxPos := scroll.height
245	ELSE	245	ELSE
246	maxPos := scroll.width	246	maxPos := scroll.width
247	END;	247	END;
248	maxPos := maxPos - scroll.btnSize*2 - scroll.sliderSize + 1;	248	maxPos := maxPos - scroll.btnSize*2 - scroll.sliderSize + 1;
249	IF pos <= 0 THEN	249	IF pos <= 0 THEN
250	pos := 0;	250	pos := 0;
251	value := 0	251	value := 0
252	ELSIF pos >= maxPos THEN	252	ELSIF pos >= maxPos THEN
253	pos := maxPos;	253	pos := maxPos;
254	value := scroll.maxVal	254	value := scroll.maxVal
255	ELSE	255	ELSE
256	IF scroll.maxVal <= maxPos + 1 THEN	256	IF scroll.maxVal <= maxPos + 1 THEN
257	n := (maxPos + 1) DIV scroll.maxVal;	257	n := (maxPos + 1) DIV scroll.maxVal;
258	m := (maxPos + 1) MOD scroll.maxVal;	258	m := (maxPos + 1) MOD scroll.maxVal;
259		259
260	q := m*(n + 1);	260	q := m*(n + 1);
261	IF q < pos THEN	261	IF q < pos THEN
262	value := ceil(pos - m, n)	262	value := ceil(pos - m, n)
263	ELSIF q > pos THEN	263	ELSIF q > pos THEN
264	value := ceil(pos, n + 1)	264	value := ceil(pos, n + 1)
265	ELSE	265	ELSE
266	value := m	266	value := m
267	END;	267	END;
268		268
269	x := value*n + MIN(value, m);	269	x := value*n + MIN(value, m);
270	x0 := (value - 1)*n + MIN(value - 1, m);	270	x0 := (value - 1)*n + MIN(value - 1, m);
271		271
272	IF x - pos > pos - x0 THEN	272	IF x - pos > pos - x0 THEN
273	pos := x0;	273	pos := x0;
274	DEC(value)	274	DEC(value)
275	ELSE	275	ELSE
276	pos := x;	276	pos := x;
277	IF pos > maxPos THEN	277	IF pos > maxPos THEN
278	pos := maxPos;	278	pos := maxPos;
279	value := scroll.maxVal	279	value := scroll.maxVal
280	END	280	END
281	END	281	END
282	ELSE	282	ELSE
283	value := FLOOR(FLT(scroll.maxVal)*FLT(pos)/FLT(maxPos + 1))	283	value := FLOOR(FLT(scroll.maxVal)*FLT(pos)/FLT(maxPos + 1))
284	END	284	END
285	END	285	END
286	ELSE	286	ELSE
287	pos := 0;	287	pos := 0;
288	scroll.value := 0	288	scroll.value := 0
289	END;	289	END;
290	scroll.pos := pos;	290	scroll.pos := pos;
291	scroll.value := value	291	scroll.value := value
292	END setPos;	292	END setPos;
293		293
294		294
295	PROCEDURE MouseMove (VAR scroll: tScroll; x, y: INTEGER);	295	PROCEDURE MouseMove (VAR scroll: tScroll; x, y: INTEGER);
296	VAR	296	VAR
297	c: INTEGER;	297	c: INTEGER;
298	BEGIN	298	BEGIN
299	IF scroll.vertical THEN	299	IF scroll.vertical THEN
300	c := y - scroll.top	300	c := y - scroll.top
301	ELSE	301	ELSE
302	c := x - scroll.left	302	c := x - scroll.left
303	END;	303	END;
304	setPos(scroll, scroll.pos0 + c - scroll.Slider);	304	setPos(scroll, scroll.pos0 + c - scroll.Slider);
305	paint(scroll)	305	paint(scroll)
306	END MouseMove;	306	END MouseMove;
307		307
308		308
309	PROCEDURE SendIPC;	309	PROCEDURE SendIPC;
310	VAR	310	VAR
311	msg: ARRAY 2 OF INTEGER;	311	msg: ARRAY 2 OF INTEGER;
312	BEGIN	312	BEGIN
313	msg[0] := ScrollIPC;	313	msg[0] := ScrollIPC;
314	msg[1] := 8;	314	msg[1] := 8;
315	K.SendIPC(K.ThreadID(), msg)	315	K.SendIPC(K.ThreadID(), msg)
316	END SendIPC;	316	END SendIPC;
317		317
318		318
319	PROCEDURE receiveIPC* (VAR IPC: ARRAY OF INTEGER; VAR scrollIPC: BOOLEAN);	319	PROCEDURE receiveIPC* (VAR IPC: ARRAY OF INTEGER; VAR scrollIPC: BOOLEAN);
320	BEGIN	320	BEGIN
321	scrollIPC := FALSE;	321	scrollIPC := FALSE;
322	ScrollChange;	322	ScrollChange;
323	IF 0 IN K.MouseState() THEN	323	IF 0 IN K.MouseState() THEN
324	WHILE (0 IN K.MouseState()) & (delay > 0) DO	324	WHILE (0 IN K.MouseState()) & (delay > 0) DO
325	K.Pause(1);	325	K.Pause(1);
326	DEC(delay)	326	DEC(delay)
327	END;	327	END;
328	IF delay = 0 THEN	328	IF delay = 0 THEN
329	IPC[0] := 0;	329	IPC[0] := 0;
330	IPC[1] := 0;	330	IPC[1] := 0;
331	scrollIPC := TRUE;	331	scrollIPC := TRUE;
332	SendIPC;	332	SendIPC;
333	delay := 4	333	delay := 4
334	ELSE	334	ELSE
335	delay := DELAY	335	delay := DELAY
336	END	336	END
337	ELSE	337	ELSE
338	delay := DELAY	338	delay := DELAY
339	END	339	END
340	END receiveIPC;	340	END receiveIPC;
341		341
342		342
343	PROCEDURE MouseDown (VAR scroll: tScroll; x, y: INTEGER);	343	PROCEDURE MouseDown (VAR scroll: tScroll; x, y: INTEGER);
344	VAR	344	VAR
345	c, size: INTEGER;	345	c, size: INTEGER;
346	BEGIN	346	BEGIN
347	DEC(x, scroll.left);	347	DEC(x, scroll.left);
348	DEC(y, scroll.top);	348	DEC(y, scroll.top);
349	scroll.mouse := TRUE;	349	scroll.mouse := TRUE;
350	IF U.between(1, x, scroll.width - 2) & U.between(1, y, scroll.height - 2) THEN	350	IF U.between(1, x, scroll.width - 2) & U.between(1, y, scroll.height - 2) THEN
351	IF scroll.vertical THEN	351	IF scroll.vertical THEN
352	c := y;	352	c := y;
353	size := scroll.height	353	size := scroll.height
354	ELSE	354	ELSE
355	c := x;	355	c := x;
356	size := scroll.width	356	size := scroll.width
357	END;	357	END;
358	IF U.between(scroll.btnSize + scroll.pos - 1, c, scroll.btnSize + scroll.pos + scroll.sliderSize - 1) THEN	358	IF U.between(scroll.btnSize + scroll.pos - 1, c, scroll.btnSize + scroll.pos + scroll.sliderSize - 1) THEN
359	scroll.pos0 := scroll.pos;	359	scroll.pos0 := scroll.pos;
360	scroll.Slider := c	360	scroll.Slider := c
361	ELSIF U.between(0, c, scroll.btnSize - 1) THEN	361	ELSIF U.between(0, c, scroll.btnSize - 1) THEN
362	scroll.Dec := TRUE;	362	scroll.Dec := TRUE;
363	SendIPC	363	SendIPC
364	ELSIF U.between(size - scroll.btnSize, c, size - 1) THEN	364	ELSIF U.between(size - scroll.btnSize, c, size - 1) THEN
365	scroll.Inc := TRUE;	365	scroll.Inc := TRUE;
366	SendIPC	366	SendIPC
367	ELSE	367	ELSE
368	setPos(scroll, c - scroll.btnSize - scroll.sliderSize DIV 2);	368	setPos(scroll, c - scroll.btnSize - scroll.sliderSize DIV 2);
369	scroll.pos0 := scroll.pos;	369	scroll.pos0 := scroll.pos;
370	scroll.Slider := c;	370	scroll.Slider := c;
371	paint(scroll)	371	paint(scroll)
372	END	372	END
373	END	373	END
374	END MouseDown;	374	END MouseDown;
375		375
376		376
377	PROCEDURE mouse* (VAR scroll: tScroll);	377	PROCEDURE mouse* (VAR scroll: tScroll);
378	VAR	378	VAR
379	msState: SET;	379	msState: SET;
380	x, y: INTEGER;	380	x, y: INTEGER;
381	BEGIN	381	BEGIN
382	K.mouse(msState, x, y);	382	K.mouse(msState, x, y);
383	IF 0 IN msState THEN	383	IF 0 IN msState THEN
384	IF ~scroll.mouse THEN	384	IF ~scroll.mouse THEN
385	MouseDown(scroll, x, y)	385	MouseDown(scroll, x, y)
386	ELSIF scroll.Slider # -1 THEN	386	ELSIF scroll.Slider # -1 THEN
387	MouseMove(scroll, x, y)	387	MouseMove(scroll, x, y)
388	END	388	END
389	ELSIF scroll.mouse THEN	389	ELSIF scroll.mouse THEN
390	MouseUp(scroll);	390	MouseUp(scroll);
391	paint(scroll)	391	paint(scroll)
392	END	392	END
393	END mouse;	393	END mouse;
394		394
395		395
396	PROCEDURE init* (_ScrollChange: tProcedure);	396	PROCEDURE init* (_ScrollChange: tProcedure);
397	BEGIN	397	BEGIN
398	delay := DELAY;	398	delay := DELAY;
399	ScrollChange := _ScrollChange	399	ScrollChange := _ScrollChange
400	END init;	400	END init;
401		401
402		402
403	END Scroll.	403	END Scroll.

Subversion Repositories Kolibri OS

(root)/programs/develop/cedit/SRC/scroll.ob07 – Rev 9210 → 9431