forked from KolibriOS/kolibrios
403 lines
9.1 KiB
Plaintext
403 lines
9.1 KiB
Plaintext
(*
|
|
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 <http://www.gnu.org/licenses/>.
|
|
*)
|
|
|
|
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. |