(* 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(1, x, scroll.width - 2) & between(1, y, scroll.height - 2) 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.