WebSVN – Kolibri OS – Diff – /programs/develop/cedit/SRC/Tabs.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 Tabs;
 
IMPORT List, K := KolibriOS, RW;
 
CONST
 
    btnID* = 100;
    tabHeight* = 22;
    curTabHeight = 26;
    scrWidth = 10;
 
 
TYPE
 
    tItem = POINTER TO RECORD (List.tItem)
 
        val: RW.tFileName
 
    END;
 
    tTabs* = POINTER TO RECORD
 
        strings: List.tList;
        first, current: INTEGER;
        width, height: INTEGER;
        x, y: INTEGER
 
    END;
 
 
PROCEDURE drawTab (t: tTabs; id, x, y, width, height: INTEGER; s: ARRAY OF CHAR);
VAR
    x2, y2, color: INTEGER;
BEGIN
    IF id = t.current THEN
        INC(height, curTabHeight - tabHeight);
        DEC(y, curTabHeight - tabHeight);
        (*color := K.lightColor
    ELSE
        color := K.darkColor*)
    END;
    color := K.winColor;
    DEC(x); INC(width);
    x2 := x + width - 1;
    y2 := y + height - 1;
 
    K.DrawRect(x, y, width, height,color);
    K.DrawLine(x, y, x2, y, K.borderColor);
    K.DrawLine(x2, y, x2, y2, K.borderColor);
    IF id # t.current THEN
        K.DrawLine(x2 - 1, y2, x, y2, K.borderColor);
    END;
    K.DrawLine(x, y2, x, y, K.borderColor);
    K.DrawText866bk(x + K.fontWidth, y + (height - K.fontHeight) DIV 2, K.textColor, color, s);
    K.CreateButton(id + ORD({30}) + btnID, x + 1, y - 1, width - 1, height - 1, color, "");
END drawTab;
 
 
PROCEDURE tabWidth (tab: tItem): INTEGER;
    RETURN (LENGTH(tab.val) + 2)*K.fontWidth
END tabWidth;
 
 
PROCEDURE Width (t: tTabs; pos, n: INTEGER): INTEGER;
VAR
    res, i: INTEGER;
    item: List.tItem;
BEGIN
    res := 0;
    i := pos;
    item := List.getItem(t.strings, i);
    WHILE (item # NIL) & (i <= n) DO
        INC(res, tabWidth(item(tItem)));
        item := item.next;
        INC(i)
    END
    RETURN res
END Width;
 
 
PROCEDURE draw* (t: tTabs);
VAR
    x, y, xmax, n, width: INTEGER;
    item: List.tItem;
    scroll: BOOLEAN;
BEGIN
    y := t.y;
    x := t.x;
    K.DrawRect(x, y - (curTabHeight - tabHeight), t.width + 2*scrWidth, t.height + (curTabHeight - tabHeight) - 1, K.winColor);
    IF Width(t, 0, t.strings.count - 1) > t.width THEN
        INC(x, 2*scrWidth);
        K.CreateButton(btnID - 1, t.x, t.y, scrWidth, t.height - 1, K.btnColor, "<");
        K.CreateButton(btnID - 2, t.x + scrWidth, t.y, scrWidth, t.height - 1, K.btnColor, ">");
        scroll := TRUE
    ELSE
        t.first := 0;
        scroll := FALSE
    END;
    xmax := x + t.width - 1;
 
    n := t.strings.count - 1;
    WHILE (n >= 0) & (Width(t, n, t.strings.count - 1) <= t.width) DO
        DEC(n)
    END;
    IF n < 0 THEN
        n := 0
    ELSE
        INC(n)
    END;
    IF n < t.first THEN
        t.first := n
    END;
 
    K.DrawRect(x, y, t.width, t.height - 1, K.winColor);
    K.DrawLine(x, y + tabHeight - 1, x + t.width - 1 + 2*scrWidth*(1 - ORD(scroll)), y + tabHeight - 1, K.borderColor);
    item := List.getItem(t.strings, t.first);
    n := t.first;
    WHILE (item # NIL) & (x <= xmax) DO
        width := tabWidth(item(tItem));
        IF x + width - 1 <= xmax THEN
            drawTab(t, n, x + 1, y, width, t.height, item(tItem).val)
        END;
        INC(n);
        INC(x, width);
        item := item.next
    END
END draw;
 
 
PROCEDURE add* (t: tTabs; s: ARRAY OF CHAR);
VAR
    item: tItem;
BEGIN
    NEW(item);
    item.val := s;
    List.append(t.strings, item);
END add;
 
 
PROCEDURE rename* (t: tTabs; n: INTEGER; s: ARRAY OF CHAR);
VAR
    item: List.tItem;
BEGIN
    item := List.getItem(t.strings, n);
    item(tItem).val := s
END rename;
 
 
PROCEDURE delete* (t: tTabs; n: INTEGER);
VAR
    item: List.tItem;
BEGIN
    item := List.getItem(t.strings, n);
    List.delete(t.strings, item)
END delete;
 
 
PROCEDURE scroll* (t: tTabs; n: INTEGER);
VAR
    pos: INTEGER;
BEGIN
    pos := t.first + n;
    IF pos < 0 THEN
        pos := 0
    ELSIF pos >= t.strings.count THEN
        pos := t.strings.count - 1
    END;
    t.first := pos
END scroll;
 
 
PROCEDURE switch* (t: tTabs; n: INTEGER);
BEGIN
    IF (0 <= n) & (n < t.strings.count) THEN
        t.current := n;
        IF n < t.first THEN
            t.first := 0
        END;
        WHILE Width(t, t.first, n) > t.width DO
            INC(t.first)
        END
    END
END switch;
 
 
PROCEDURE setArea* (t: tTabs; x, y, width, height: INTEGER);
BEGIN
    t.x := x;
    t.y := y;
    t.width := width - 2*scrWidth;
    t.height := height
END setArea;
 
 
PROCEDURE create* (): tTabs;
VAR
    res: tTabs;
BEGIN
    NEW(res);
    res.strings := List.create(NIL);
    res.current := 0;
    res.first := 0
    RETURN res
END create;
 
 
END Tabs.
>

Rev 9060	Rev 9073
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 Tabs;	20	MODULE Tabs;
21		21
22	IMPORT List, K := KolibriOS, RW;	22	IMPORT List, K := KolibriOS, RW;
23		23
24	CONST	24	CONST
25		25
26	btnID* = 100;	26	btnID* = 100;
27	tabHeight* = 22;	27	tabHeight* = 22;
28	curTabHeight = 26;	28	curTabHeight = 26;
29	scrWidth = 10;	29	scrWidth = 10;
30		30
31		31
32	TYPE	32	TYPE
33		33
34	tItem = POINTER TO RECORD (List.tItem)	34	tItem = POINTER TO RECORD (List.tItem)
35		35
36	val: RW.tFileName	36	val: RW.tFileName
37		37
38	END;	38	END;
39		39
40	tTabs* = POINTER TO RECORD	40	tTabs* = POINTER TO RECORD
41		41
42	strings: List.tList;	42	strings: List.tList;
43	first, current: INTEGER;	43	first, current: INTEGER;
44	width, height: INTEGER;	44	width, height: INTEGER;
45	x, y: INTEGER	45	x, y: INTEGER
46		46
47	END;	47	END;
48		48
49		49
50	PROCEDURE drawTab (t: tTabs; id, x, y, width, height: INTEGER; s: ARRAY OF CHAR);	50	PROCEDURE drawTab (t: tTabs; id, x, y, width, height: INTEGER; s: ARRAY OF CHAR);
51	VAR	51	VAR
52	x2, y2, color: INTEGER;	52	x2, y2, color: INTEGER;
53	BEGIN	53	BEGIN
54	IF id = t.current THEN	54	IF id = t.current THEN
55	INC(height, curTabHeight - tabHeight);	55	INC(height, curTabHeight - tabHeight);
56	DEC(y, curTabHeight - tabHeight);	56	DEC(y, curTabHeight - tabHeight);
57	(*color := K.lightColor	57	(*color := K.lightColor
58	ELSE	58	ELSE
59	color := K.darkColor*)	59	color := K.darkColor*)
60	END;	60	END;
61	color := K.winColor;	61	color := K.winColor;
62	DEC(x); INC(width);	62	DEC(x); INC(width);
63	x2 := x + width - 1;	63	x2 := x + width - 1;
64	y2 := y + height - 1;	64	y2 := y + height - 1;
65		65
66	K.DrawRect(x, y, width, height,color);	66	K.DrawRect(x, y, width, height,color);
67	K.DrawLine(x, y, x2, y, K.borderColor);	67	K.DrawLine(x, y, x2, y, K.borderColor);
68	K.DrawLine(x2, y, x2, y2, K.borderColor);	68	K.DrawLine(x2, y, x2, y2, K.borderColor);
69	IF id # t.current THEN	69	IF id # t.current THEN
70	K.DrawLine(x2 - 1, y2, x, y2, K.borderColor);	70	K.DrawLine(x2 - 1, y2, x, y2, K.borderColor);
71	END;	71	END;
72	K.DrawLine(x, y2, x, y, K.borderColor);	72	K.DrawLine(x, y2, x, y, K.borderColor);
73	K.DrawText866bk(x + K.fontWidth, y + (height - K.fontHeight) DIV 2, K.textColor, color, s);	73	K.DrawText866bk(x + K.fontWidth, y + (height - K.fontHeight) DIV 2, K.textColor, color, s);
74	K.CreateButton(id + ORD({30}) + btnID, x, y - 1, width, height - 1, color, "");	74	K.CreateButton(id + ORD({30}) + btnID, x + 1, y - 1, width - 1, height - 1, color, "");
75	END drawTab;	75	END drawTab;
76		76
77		77
78	PROCEDURE tabWidth (tab: tItem): INTEGER;	78	PROCEDURE tabWidth (tab: tItem): INTEGER;
79	RETURN (LENGTH(tab.val) + 2)*K.fontWidth	79	RETURN (LENGTH(tab.val) + 2)*K.fontWidth
80	END tabWidth;	80	END tabWidth;
81		81
82		82
83	PROCEDURE Width (t: tTabs; pos, n: INTEGER): INTEGER;	83	PROCEDURE Width (t: tTabs; pos, n: INTEGER): INTEGER;
84	VAR	84	VAR
85	res, i: INTEGER;	85	res, i: INTEGER;
86	item: List.tItem;	86	item: List.tItem;
87	BEGIN	87	BEGIN
88	res := 0;	88	res := 0;
89	i := pos;	89	i := pos;
90	item := List.getItem(t.strings, i);	90	item := List.getItem(t.strings, i);
91	WHILE (item # NIL) & (i <= n) DO	91	WHILE (item # NIL) & (i <= n) DO
92	INC(res, tabWidth(item(tItem)));	92	INC(res, tabWidth(item(tItem)));
93	item := item.next;	93	item := item.next;
94	INC(i)	94	INC(i)
95	END	95	END
96	RETURN res	96	RETURN res
97	END Width;	97	END Width;
98		98
99		99
100	PROCEDURE draw* (t: tTabs);	100	PROCEDURE draw* (t: tTabs);
101	VAR	101	VAR
102	x, y, xmax, n, width: INTEGER;	102	x, y, xmax, n, width: INTEGER;
103	item: List.tItem;	103	item: List.tItem;
104	scroll: BOOLEAN;	104	scroll: BOOLEAN;
105	BEGIN	105	BEGIN
106	y := t.y;	106	y := t.y;
107	x := t.x;	107	x := t.x;
108	K.DrawRect(x, y - (curTabHeight - tabHeight), t.width + 2*scrWidth, t.height + (curTabHeight - tabHeight) - 1, K.winColor);	108	K.DrawRect(x, y - (curTabHeight - tabHeight), t.width + 2*scrWidth, t.height + (curTabHeight - tabHeight) - 1, K.winColor);
109	IF Width(t, 0, t.strings.count - 1) > t.width THEN	109	IF Width(t, 0, t.strings.count - 1) > t.width THEN
110	INC(x, 2*scrWidth);	110	INC(x, 2*scrWidth);
111	K.CreateButton(btnID - 1, t.x, t.y, scrWidth, t.height - 1, K.btnColor, "<");	111	K.CreateButton(btnID - 1, t.x, t.y, scrWidth, t.height - 1, K.btnColor, "<");
112	K.CreateButton(btnID - 2, t.x + scrWidth, t.y, scrWidth, t.height - 1, K.btnColor, ">");	112	K.CreateButton(btnID - 2, t.x + scrWidth, t.y, scrWidth, t.height - 1, K.btnColor, ">");
113	scroll := TRUE	113	scroll := TRUE
114	ELSE	114	ELSE
115	t.first := 0;	115	t.first := 0;
116	scroll := FALSE	116	scroll := FALSE
117	END;	117	END;
118	xmax := x + t.width - 1;	118	xmax := x + t.width - 1;
119		119
120	n := t.strings.count - 1;	120	n := t.strings.count - 1;
121	WHILE (n >= 0) & (Width(t, n, t.strings.count - 1) <= t.width) DO	121	WHILE (n >= 0) & (Width(t, n, t.strings.count - 1) <= t.width) DO
122	DEC(n)	122	DEC(n)
123	END;	123	END;
124	IF n < 0 THEN	124	IF n < 0 THEN
125	n := 0	125	n := 0
126	ELSE	126	ELSE
127	INC(n)	127	INC(n)
128	END;	128	END;
129	IF n < t.first THEN	129	IF n < t.first THEN
130	t.first := n	130	t.first := n
131	END;	131	END;
132		132
133	K.DrawRect(x, y, t.width, t.height - 1, K.winColor);	133	K.DrawRect(x, y, t.width, t.height - 1, K.winColor);
134	K.DrawLine(x, y + tabHeight - 1, x + t.width - 1 + 2scrWidth(1 - ORD(scroll)), y + tabHeight - 1, K.borderColor);	134	K.DrawLine(x, y + tabHeight - 1, x + t.width - 1 + 2scrWidth(1 - ORD(scroll)), y + tabHeight - 1, K.borderColor);
135	item := List.getItem(t.strings, t.first);	135	item := List.getItem(t.strings, t.first);
136	n := t.first;	136	n := t.first;
137	WHILE (item # NIL) & (x <= xmax) DO	137	WHILE (item # NIL) & (x <= xmax) DO
138	width := tabWidth(item(tItem));	138	width := tabWidth(item(tItem));
139	IF x + width - 1 <= xmax THEN	139	IF x + width - 1 <= xmax THEN
140	drawTab(t, n, x + 1, y, width, t.height, item(tItem).val)	140	drawTab(t, n, x + 1, y, width, t.height, item(tItem).val)
141	END;	141	END;
142	INC(n);	142	INC(n);
143	INC(x, width);	143	INC(x, width);
144	item := item.next	144	item := item.next
145	END	145	END
146	END draw;	146	END draw;
147		147
148		148
149	PROCEDURE add* (t: tTabs; s: ARRAY OF CHAR);	149	PROCEDURE add* (t: tTabs; s: ARRAY OF CHAR);
150	VAR	150	VAR
151	item: tItem;	151	item: tItem;
152	BEGIN	152	BEGIN
153	NEW(item);	153	NEW(item);
154	item.val := s;	154	item.val := s;
155	List.append(t.strings, item);	155	List.append(t.strings, item);
156	END add;	156	END add;
157		157
158		158
159	PROCEDURE rename* (t: tTabs; n: INTEGER; s: ARRAY OF CHAR);	159	PROCEDURE rename* (t: tTabs; n: INTEGER; s: ARRAY OF CHAR);
160	VAR	160	VAR
161	item: List.tItem;	161	item: List.tItem;
162	BEGIN	162	BEGIN
163	item := List.getItem(t.strings, n);	163	item := List.getItem(t.strings, n);
164	item(tItem).val := s	164	item(tItem).val := s
165	END rename;	165	END rename;
166		166
167		167
168	PROCEDURE delete* (t: tTabs; n: INTEGER);	168	PROCEDURE delete* (t: tTabs; n: INTEGER);
169	VAR	169	VAR
170	item: List.tItem;	170	item: List.tItem;
171	BEGIN	171	BEGIN
172	item := List.getItem(t.strings, n);	172	item := List.getItem(t.strings, n);
173	List.delete(t.strings, item)	173	List.delete(t.strings, item)
174	END delete;	174	END delete;
175		175
176		176
177	PROCEDURE scroll* (t: tTabs; n: INTEGER);	177	PROCEDURE scroll* (t: tTabs; n: INTEGER);
178	VAR	178	VAR
179	pos: INTEGER;	179	pos: INTEGER;
180	BEGIN	180	BEGIN
181	pos := t.first + n;	181	pos := t.first + n;
182	IF pos < 0 THEN	182	IF pos < 0 THEN
183	pos := 0	183	pos := 0
184	ELSIF pos >= t.strings.count THEN	184	ELSIF pos >= t.strings.count THEN
185	pos := t.strings.count - 1	185	pos := t.strings.count - 1
186	END;	186	END;
187	t.first := pos	187	t.first := pos
188	END scroll;	188	END scroll;
189		189
190		190
191	PROCEDURE switch* (t: tTabs; n: INTEGER);	191	PROCEDURE switch* (t: tTabs; n: INTEGER);
192	BEGIN	192	BEGIN
193	IF (0 <= n) & (n < t.strings.count) THEN	193	IF (0 <= n) & (n < t.strings.count) THEN
194	t.current := n;	194	t.current := n;
195	IF n < t.first THEN	195	IF n < t.first THEN
196	t.first := 0	196	t.first := 0
197	END;	197	END;
198	WHILE Width(t, t.first, n) > t.width DO	198	WHILE Width(t, t.first, n) > t.width DO
199	INC(t.first)	199	INC(t.first)
200	END	200	END
201	END	201	END
202	END switch;	202	END switch;
203		203
204		204
205	PROCEDURE setArea* (t: tTabs; x, y, width, height: INTEGER);	205	PROCEDURE setArea* (t: tTabs; x, y, width, height: INTEGER);
206	BEGIN	206	BEGIN
207	t.x := x;	207	t.x := x;
208	t.y := y;	208	t.y := y;
209	t.width := width - 2*scrWidth;	209	t.width := width - 2*scrWidth;
210	t.height := height	210	t.height := height
211	END setArea;	211	END setArea;
212		212
213		213
214	PROCEDURE create* (): tTabs;	214	PROCEDURE create* (): tTabs;
215	VAR	215	VAR
216	res: tTabs;	216	res: tTabs;
217	BEGIN	217	BEGIN
218	NEW(res);	218	NEW(res);
219	res.strings := List.create(NIL);	219	res.strings := List.create(NIL);
220	res.current := 0;	220	res.current := 0;
221	res.first := 0	221	res.first := 0
222	RETURN res	222	RETURN res
223	END create;	223	END create;
224		224
225		225
226	END Tabs.	226	END Tabs.
227	>	227	>

Subversion Repositories Kolibri OS

(root)/programs/develop/cedit/SRC/Tabs.ob07 – Rev 9060 → 9073