Rev 746 | Rev 748 | Go to most recent revision | Only display areas with differences | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed
Rev 746 | Rev 747 | ||
---|---|---|---|
1 | unit VTSCUI; |
1 | unit VTSCUI; |
2 | 2 | ||
3 | (************************************************) |
3 | (************************************************) |
4 | (* VTSCUI.PAS *) |
4 | (* VTSCUI.PAS *) |
5 | (* Author: Daniel Marschall *) |
5 | (* Author: Daniel Marschall *) |
6 | (* Revision: 2022-02-14 *) |
6 | (* Revision: 2022-02-16 *) |
7 | (* License: Apache 2.0 *) |
7 | (* License: Apache 2.0 *) |
8 | (* This file contains: *) |
8 | (* This file contains: *) |
9 | (* - ViaThinkSoft CUI (Console User Interface) *) |
9 | (* - ViaThinkSoft CUI (Console User Interface) *) |
10 | (************************************************) |
10 | (************************************************) |
11 | 11 | ||
12 | interface |
12 | interface |
13 | 13 | ||
14 | uses |
14 | uses |
15 | StrList; |
15 | StrList; |
16 | 16 | ||
17 | const |
17 | const |
18 | (* These are available in DRIVERS.TPU, but require a call of InitVideo |
18 | (* These are available in DRIVERS.TPU, but require a call of InitVideo |
19 | ScreenWidth = 80; |
19 | ScreenWidth = 80; |
20 | ScreenHeight = 25; |
20 | ScreenHeight = 25; |
21 | *) |
21 | *) |
22 | SINGLE_LINE_BOX_PADDING = 3; |
22 | SINGLE_LINE_BOX_PADDING = 3; |
23 | SINGLE_LINE_BOX_PADDING_INNER = 10; |
23 | SINGLE_LINE_BOX_PADDING_INNER = 10; |
24 | 24 | ||
25 | procedure DrawThinBorder(x, y, width, height: integer); |
25 | procedure DrawThinBorder(x, y, width, height: integer); |
26 | procedure DrawDoubleBorder(x, y, width, height: integer); |
26 | procedure DrawDoubleBorder(x, y, width, height: integer); |
27 | procedure DrawTextBar(str: string; line: integer); |
27 | procedure DrawTextBar(str: string; line: integer); |
28 | procedure DrawTitleBar(center, left, right: string); |
28 | procedure DrawTitleBar(center, left, right: string); |
29 | procedure DrawStatusBar(str: string); |
29 | procedure DrawStatusBar(str: string); |
30 | function DrawSelectionList(X, Y, ListWidth, ListHeight: integer; |
30 | function DrawSelectionList(X, Y, ListWidth, ListHeight: integer; |
31 | items: PStringList; allowESC: boolean; |
31 | items: PStringList; allowESC: boolean; |
32 | Title: string; borderStrength: integer): integer; |
32 | Title: string; borderStrength: integer): integer; |
33 | procedure ClearSection(x, y, width, height: integer); |
33 | procedure ClearSection(x, y, width, height: integer); |
34 | function QueryVal(var s: string; initX, initY, width, height: integer; |
34 | function QueryVal(var s: string; initX, initY, width, height: integer; |
35 | Title: string; borderStrength: integer): boolean; |
35 | Title: string; borderStrength: integer): boolean; |
36 | procedure ShowMessage(msg: string; title: string; dobeep: boolean); |
36 | procedure ShowMessage(msg: string; title: string; dobeep: boolean); |
37 | procedure CursorOn; |
37 | procedure CursorOn; |
38 | procedure CursorOff; |
38 | procedure CursorOff; |
- | 39 | procedure ResetDefaultDosColors; |
|
39 | 40 | ||
40 | implementation |
41 | implementation |
41 | 42 | ||
42 | uses |
43 | uses |
43 | Crt, Drivers, VtsFuncs; |
44 | Crt, Drivers, VtsFuncs; |
44 | 45 | ||
45 | type |
46 | type |
46 | TCharDefs = array[0..7] of char; |
47 | TCharDefs = array[0..7] of char; |
47 | 48 | ||
48 | const |
49 | const |
49 | ThinLineChars: TCharDefs = |
50 | ThinLineChars: TCharDefs = |
50 | ( #$DA, #$C4, #$BF, |
51 | ( #$DA, #$C4, #$BF, |
51 | #$B3, #$B3, |
52 | #$B3, #$B3, |
52 | #$C0, #$C4, #$D9 |
53 | #$C0, #$C4, #$D9 |
53 | ); |
54 | ); |
54 | DoubleLineChars: TCharDefs = |
55 | DoubleLineChars: TCharDefs = |
55 | ( #$C9, #$CD, #$BB, |
56 | ( #$C9, #$CD, #$BB, |
56 | #$BA, #$BA, |
57 | #$BA, #$BA, |
57 | #$C8, #$CD, #$BC |
58 | #$C8, #$CD, #$BC |
58 | ); |
59 | ); |
59 | 60 | ||
60 | function FillRight(str: string; len: integer; c: char): string; |
61 | function FillRight(str: string; len: integer; c: char): string; |
61 | var |
62 | var |
62 | s: string; |
63 | s: string; |
63 | i: integer; |
64 | i: integer; |
64 | begin |
65 | begin |
65 | s := str; |
66 | s := str; |
66 | for i := Length(str) to len-1 do |
67 | for i := Length(str) to len-1 do |
67 | begin |
68 | begin |
68 | s := s + c; |
69 | s := s + c; |
69 | end; |
70 | end; |
70 | FillRight := s; |
71 | FillRight := s; |
71 | end; |
72 | end; |
72 | 73 | ||
73 | procedure DrawBorder(x, y, width, height, thickness: integer); |
74 | procedure DrawBorder(x, y, width, height, thickness: integer); |
74 | var |
75 | var |
75 | ix,iy: integer; |
76 | ix,iy: integer; |
76 | chars: TCharDefs; |
77 | chars: TCharDefs; |
77 | begin |
78 | begin |
78 | if thickness = 1 then |
79 | if thickness = 1 then |
79 | chars := ThinLineChars; |
80 | chars := ThinLineChars; |
80 | if thickness = 2 then |
81 | if thickness = 2 then |
81 | chars := DoubleLineChars; |
82 | chars := DoubleLineChars; |
82 | 83 | ||
83 | (* Top line *) |
84 | (* Top line *) |
84 | if y >= 1 then |
85 | if y >= 1 then |
85 | begin |
86 | begin |
86 | (* Top left corner *) |
87 | (* Top left corner *) |
87 | if x >= 1 then |
88 | if x >= 1 then |
88 | begin |
89 | begin |
89 | GotoXY(x,y); |
90 | GotoXY(x,y); |
90 | Write(chars[0]); |
91 | Write(chars[0]); |
91 | end |
92 | end |
92 | else |
93 | else |
93 | begin |
94 | begin |
94 | GotoXY(1,y); |
95 | GotoXY(1,y); |
95 | end; |
96 | end; |
96 | 97 | ||
97 | (* Top edge *) |
98 | (* Top edge *) |
98 | for ix := 1 to width-2 do |
99 | for ix := 1 to width-2 do |
99 | Write(chars[1]); |
100 | Write(chars[1]); |
100 | 101 | ||
101 | (* Top right corner *) |
102 | (* Top right corner *) |
102 | if x+width-1 <= ScreenWidth then |
103 | if x+width-1 <= ScreenWidth then |
103 | Write(chars[2]); |
104 | Write(chars[2]); |
104 | end; |
105 | end; |
105 | 106 | ||
106 | (* Left edge *) |
107 | (* Left edge *) |
107 | for iy := 1 to height-2 do |
108 | for iy := 1 to height-2 do |
108 | begin |
109 | begin |
109 | if (x >= 1) and (x <= ScreenWidth) and |
110 | if (x >= 1) and (x <= ScreenWidth) and |
110 | (y+iy >= 1) and (y+iy <= ScreenHeight) then |
111 | (y+iy >= 1) and (y+iy <= ScreenHeight) then |
111 | begin |
112 | begin |
112 | GotoXY(x,y+iy); |
113 | GotoXY(x,y+iy); |
113 | Write(chars[3]); |
114 | Write(chars[3]); |
114 | end; |
115 | end; |
115 | end; |
116 | end; |
116 | 117 | ||
117 | (* Right edge *) |
118 | (* Right edge *) |
118 | for iy := 1 to height-2 do |
119 | for iy := 1 to height-2 do |
119 | begin |
120 | begin |
120 | if (x+width-1 >= 1) and (x+width-1 <= ScreenWidth) and |
121 | if (x+width-1 >= 1) and (x+width-1 <= ScreenWidth) and |
121 | (y+iy >= 1) and (y+iy <= ScreenHeight) then |
122 | (y+iy >= 1) and (y+iy <= ScreenHeight) then |
122 | begin |
123 | begin |
123 | GotoXY(x+width-1,y+iy); |
124 | GotoXY(x+width-1,y+iy); |
124 | Write(chars[4]); |
125 | Write(chars[4]); |
125 | end; |
126 | end; |
126 | end; |
127 | end; |
127 | 128 | ||
128 | (* Bottom line *) |
129 | (* Bottom line *) |
129 | if y+height-1 <= ScreenHeight then |
130 | if y+height-1 <= ScreenHeight then |
130 | begin |
131 | begin |
131 | (* Bottom left corner *) |
132 | (* Bottom left corner *) |
132 | if x >= 1 then |
133 | if x >= 1 then |
133 | begin |
134 | begin |
134 | GotoXY(x,y+height-1); |
135 | GotoXY(x,y+height-1); |
135 | Write(chars[5]); |
136 | Write(chars[5]); |
136 | end |
137 | end |
137 | else |
138 | else |
138 | begin |
139 | begin |
139 | GotoXY(1,y+height-1); |
140 | GotoXY(1,y+height-1); |
140 | end; |
141 | end; |
141 | 142 | ||
142 | (* Bottom edge *) |
143 | (* Bottom edge *) |
143 | for ix := 1 to width-2 do |
144 | for ix := 1 to width-2 do |
144 | Write(chars[6]); |
145 | Write(chars[6]); |
145 | 146 | ||
146 | (* Bottom right corner *) |
147 | (* Bottom right corner *) |
147 | if x+width-1 <= ScreenWidth then |
148 | if x+width-1 <= ScreenWidth then |
148 | Write(chars[7]); |
149 | Write(chars[7]); |
149 | end; |
150 | end; |
150 | end; |
151 | end; |
151 | 152 | ||
152 | procedure DrawThinBorder(x, y, width, height: integer); |
153 | procedure DrawThinBorder(x, y, width, height: integer); |
153 | begin |
154 | begin |
154 | DrawBorder(x, y, width, height, 1); |
155 | DrawBorder(x, y, width, height, 1); |
155 | end; |
156 | end; |
156 | 157 | ||
157 | procedure DrawDoubleBorder(x, y, width, height: integer); |
158 | procedure DrawDoubleBorder(x, y, width, height: integer); |
158 | begin |
159 | begin |
159 | DrawBorder(x, y, width, height, 2); |
160 | DrawBorder(x, y, width, height, 2); |
160 | end; |
161 | end; |
161 | 162 | ||
162 | procedure DrawTextBar(str: string; line: integer); |
163 | procedure DrawTextBar(str: string; line: integer); |
163 | var |
164 | var |
164 | i, left, right: integer; |
165 | i, left, right: integer; |
165 | len: integer; |
166 | len: integer; |
166 | begin |
167 | begin |
167 | GotoXY(1,line); |
168 | GotoXY(1,line); |
168 | 169 | ||
169 | TextBackground(White); |
170 | TextBackground(White); |
170 | TextColor(Black); |
171 | TextColor(Black); |
171 | len := Length(str); |
172 | len := Length(str); |
172 | 173 | ||
173 | left := round((ScreenWidth-len)/2); |
174 | left := round((ScreenWidth-len)/2); |
174 | right := ScreenWidth - left - len; |
175 | right := ScreenWidth - left - len; |
175 | 176 | ||
176 | for i := 1 to left do |
177 | for i := 1 to left do |
177 | begin |
178 | begin |
178 | Write(' '); |
179 | Write(' '); |
179 | end; |
180 | end; |
180 | 181 | ||
181 | Write(str); |
182 | Write(str); |
182 | 183 | ||
183 | (* TODO: If we do "for i := 1 to right", then the console will scroll *) |
184 | (* TODO: If we do "for i := 1 to right", then the console will scroll *) |
184 | (* since the char in the right bottom corner is written! *) |
185 | (* since the char in the right bottom corner is written! *) |
185 | for i := 1 to right-1 do |
186 | for i := 1 to right-1 do |
186 | begin |
187 | begin |
187 | Write(' '); |
188 | Write(' '); |
188 | end; |
189 | end; |
189 | GoToXY(1,1); |
190 | GoToXY(1,1); |
190 | 191 | ||
191 | TextBackground(Black); |
192 | TextBackground(Black); |
192 | TextColor(White); |
193 | TextColor(White); |
193 | end; |
194 | end; |
194 | 195 | ||
195 | procedure DrawTitleBar(center, left, right: string); |
196 | procedure DrawTitleBar(center, left, right: string); |
196 | var |
197 | var |
197 | bakx, baky: integer; |
198 | bakx, baky: integer; |
198 | begin |
199 | begin |
199 | bakx := WhereX; |
200 | bakx := WhereX; |
200 | baky := WhereY; |
201 | baky := WhereY; |
201 | 202 | ||
202 | DrawTextBar(center, 1); |
203 | DrawTextBar(center, 1); |
203 | 204 | ||
204 | (* Put left text into the title bar *) |
205 | (* Put left text into the title bar *) |
205 | GoToXY(1,1); |
206 | GoToXY(1,1); |
206 | TextBackground(White); |
207 | TextBackground(White); |
207 | TextColor(Black); |
208 | TextColor(Black); |
208 | WriteLn(left); |
209 | WriteLn(left); |
209 | TextBackground(Black); |
210 | TextBackground(Black); |
210 | TextColor(White); |
211 | TextColor(White); |
211 | 212 | ||
212 | (* Put right text into the title bar *) |
213 | (* Put right text into the title bar *) |
213 | GotoXY(ScreenWidth-Length(right)+1,1); |
214 | GotoXY(ScreenWidth-Length(right)+1,1); |
214 | TextBackground(White); |
215 | TextBackground(White); |
215 | TextColor(Black); |
216 | TextColor(Black); |
216 | WriteLn(right); |
217 | WriteLn(right); |
217 | TextBackground(Black); |
218 | TextBackground(Black); |
218 | TextColor(White); |
219 | TextColor(White); |
219 | 220 | ||
220 | GoToXY(bakx, baky); |
221 | GoToXY(bakx, baky); |
221 | end; |
222 | end; |
222 | 223 | ||
223 | procedure DrawStatusBar(str: string); |
224 | procedure DrawStatusBar(str: string); |
224 | var |
225 | var |
225 | bakx, baky: integer; |
226 | bakx, baky: integer; |
226 | begin |
227 | begin |
227 | bakx := WhereX; |
228 | bakx := WhereX; |
228 | baky := WhereY; |
229 | baky := WhereY; |
229 | DrawTextBar(str, ScreenHeight); |
230 | DrawTextBar(str, ScreenHeight); |
230 | GoToXY(bakx, baky); |
231 | GoToXY(bakx, baky); |
231 | end; |
232 | end; |
232 | 233 | ||
233 | function DrawSelectionList(X, Y, ListWidth, ListHeight: integer; |
234 | function DrawSelectionList(X, Y, ListWidth, ListHeight: integer; |
234 | items: PStringList; allowESC: boolean; |
235 | items: PStringList; allowESC: boolean; |
235 | Title: string; borderStrength: integer): integer; |
236 | Title: string; borderStrength: integer): integer; |
236 | var |
237 | var |
237 | i: integer; |
238 | i: integer; |
238 | itemIndex: integer; |
239 | itemIndex: integer; |
239 | sc: char; |
240 | sc: char; |
240 | iStartScope, iEndScope: integer; |
241 | iStartScope, iEndScope: integer; |
241 | sTmp: string; |
242 | sTmp: string; |
242 | label |
243 | label |
243 | doAgain; |
244 | doAgain; |
244 | begin |
245 | begin |
245 | if borderStrength = 1 then |
246 | if borderStrength = 1 then |
246 | begin |
247 | begin |
247 | DrawThinBorder(X-1, Y-1, ListWidth+2, ListHeight+2); |
248 | DrawThinBorder(X-1, Y-1, ListWidth+2, ListHeight+2); |
248 | end; |
249 | end; |
249 | 250 | ||
250 | if borderStrength = 2 then |
251 | if borderStrength = 2 then |
251 | begin |
252 | begin |
252 | DrawDoubleBorder(X-1, Y-1, ListWidth+2, ListHeight+2); |
253 | DrawDoubleBorder(X-1, Y-1, ListWidth+2, ListHeight+2); |
253 | end; |
254 | end; |
254 | 255 | ||
255 | if Title <> '' then |
256 | if Title <> '' then |
256 | begin |
257 | begin |
257 | if borderStrength > 0 then |
258 | if borderStrength > 0 then |
258 | GoToXY(X+1, Y-1) |
259 | GoToXY(X+1, Y-1) |
259 | else |
260 | else |
260 | GoToXY(X, Y-1); |
261 | GoToXY(X, Y-1); |
261 | Write(Title); |
262 | Write(Title); |
262 | end; |
263 | end; |
263 | 264 | ||
264 | (*CursorOff;*) |
265 | (*CursorOff;*) |
265 | 266 | ||
266 | itemIndex := 0; |
267 | itemIndex := 0; |
267 | iStartScope := itemIndex; |
268 | iStartScope := itemIndex; |
268 | iEndScope := itemIndex + ListHeight; |
269 | iEndScope := itemIndex + ListHeight; |
269 | 270 | ||
270 | doAgain: |
271 | doAgain: |
271 | 272 | ||
272 | if itemIndex < 0 then |
273 | if itemIndex < 0 then |
273 | itemIndex := 0; |
274 | itemIndex := 0; |
274 | if itemIndex > ListCount(items)-1 then |
275 | if itemIndex > ListCount(items)-1 then |
275 | itemIndex := ListCount(items)-1; |
276 | itemIndex := ListCount(items)-1; |
276 | 277 | ||
277 | if itemIndex < iStartScope then |
278 | if itemIndex < iStartScope then |
278 | begin |
279 | begin |
279 | Dec(iEndScope); |
280 | Dec(iEndScope); |
280 | Dec(iStartScope); |
281 | Dec(iStartScope); |
281 | end; |
282 | end; |
282 | 283 | ||
283 | if itemIndex > iEndScope-1 then |
284 | if itemIndex > iEndScope-1 then |
284 | begin |
285 | begin |
285 | Inc(iEndScope); |
286 | Inc(iEndScope); |
286 | Inc(iStartScope); |
287 | Inc(iStartScope); |
287 | end; |
288 | end; |
288 | 289 | ||
289 | if borderStrength > 0 then |
290 | if borderStrength > 0 then |
290 | begin |
291 | begin |
291 | (* Show scroll arrows *) |
292 | (* Show scroll arrows *) |
292 | GotoXY(X+ListWidth, Y); |
293 | GotoXY(X+ListWidth, Y); |
293 | if iStartScope > 0 then |
294 | if iStartScope > 0 then |
294 | begin |
295 | begin |
295 | TextBackground(White); |
296 | TextBackground(White); |
296 | TextColor(Black); |
297 | TextColor(Black); |
297 | WriteLn(#$18(*ArrowUp*)); |
298 | WriteLn(#$18(*ArrowUp*)); |
298 | TextBackground(Black); |
299 | TextBackground(Black); |
299 | TextColor(White); |
300 | TextColor(White); |
300 | end |
301 | end |
301 | else if borderStrength = 1 then |
302 | else if borderStrength = 1 then |
302 | WriteLn(ThinLineChars[4]) |
303 | WriteLn(ThinLineChars[4]) |
303 | else if borderStrength = 2 then |
304 | else if borderStrength = 2 then |
304 | WriteLn(DoubleLineChars[4]); |
305 | WriteLn(DoubleLineChars[4]); |
305 | 306 | ||
306 | GotoXY(X+ListWidth, Y+ListHeight-1); |
307 | GotoXY(X+ListWidth, Y+ListHeight-1); |
307 | if ListCount(items) > iEndScope then |
308 | if ListCount(items) > iEndScope then |
308 | begin |
309 | begin |
309 | TextBackground(White); |
310 | TextBackground(White); |
310 | TextColor(Black); |
311 | TextColor(Black); |
311 | WriteLn(#$19(*ArrowDown*)); |
312 | WriteLn(#$19(*ArrowDown*)); |
312 | TextBackground(Black); |
313 | TextBackground(Black); |
313 | TextColor(White); |
314 | TextColor(White); |
314 | end |
315 | end |
315 | else if borderStrength = 1 then |
316 | else if borderStrength = 1 then |
316 | WriteLn(ThinLineChars[4]) |
317 | WriteLn(ThinLineChars[4]) |
317 | else if borderStrength = 2 then |
318 | else if borderStrength = 2 then |
318 | WriteLn(DoubleLineChars[4]); |
319 | WriteLn(DoubleLineChars[4]); |
319 | end; |
320 | end; |
320 | 321 | ||
321 | for i := iStartScope to iEndScope-1 do |
322 | for i := iStartScope to iEndScope-1 do |
322 | begin |
323 | begin |
323 | if itemIndex = i then |
324 | if itemIndex = i then |
324 | begin |
325 | begin |
325 | TextColor(Black); |
326 | TextColor(Black); |
326 | TextBackground(White); |
327 | TextBackground(White); |
327 | end |
328 | end |
328 | else |
329 | else |
329 | begin |
330 | begin |
330 | TextColor(White); |
331 | TextColor(White); |
331 | TextBackground(Black); |
332 | TextBackground(Black); |
332 | end; |
333 | end; |
333 | GotoXY(x,y+i-iStartScope); |
334 | GotoXY(x,y+i-iStartScope); |
334 | if i > ListCount(items)-1 then |
335 | if i > ListCount(items)-1 then |
335 | Write(FillRight('', ListWidth, ' ')) |
336 | Write(FillRight('', ListWidth, ' ')) |
336 | else |
337 | else |
337 | begin |
338 | begin |
338 | sTmp := ListGetElement(items, i); |
339 | sTmp := ListGetElement(items, i); |
339 | sTmp := TrimLineToWidth(sTmp, ListWidth); |
340 | sTmp := TrimLineToWidth(sTmp, ListWidth); |
340 | Write(FillRight(sTmp, ListWidth, ' ')); |
341 | Write(FillRight(sTmp, ListWidth, ' ')); |
341 | end; |
342 | end; |
342 | TextColor(White); |
343 | TextColor(White); |
343 | TextBackground(Black); |
344 | TextBackground(Black); |
344 | end; |
345 | end; |
345 | 346 | ||
346 | repeat |
347 | repeat |
347 | GotoXY(ScreenWidth, ScreenHeight); |
348 | GotoXY(ScreenWidth, ScreenHeight); |
348 | 349 | ||
349 | sc := ReadKey; |
350 | sc := ReadKey; |
350 | if sc = #$00(*ExtendedKeyCode*) then |
351 | if sc = #$00(*ExtendedKeyCode*) then |
351 | begin |
352 | begin |
352 | sc := ReadKey; |
353 | sc := ReadKey; |
353 | if sc = #$48(*UpKey*) then |
354 | if sc = #$48(*UpKey*) then |
354 | begin |
355 | begin |
355 | dec(itemIndex); |
356 | dec(itemIndex); |
356 | goto doAgain; |
357 | goto doAgain; |
357 | end |
358 | end |
358 | else if sc = #$50(*DownKey*) then |
359 | else if sc = #$50(*DownKey*) then |
359 | begin |
360 | begin |
360 | inc(itemIndex); |
361 | inc(itemIndex); |
361 | goto doAgain; |
362 | goto doAgain; |
362 | end |
363 | end |
363 | else if sc = #$47(*POS1*) then |
364 | else if sc = #$47(*POS1*) then |
364 | begin |
365 | begin |
365 | itemIndex := 0; |
366 | itemIndex := 0; |
366 | iStartScope := 0; |
367 | iStartScope := 0; |
367 | iEndScope := iStartScope + ListHeight; |
368 | iEndScope := iStartScope + ListHeight; |
368 | goto doAgain; |
369 | goto doAgain; |
369 | end |
370 | end |
370 | else if sc = #$4F(*END*) then |
371 | else if sc = #$4F(*END*) then |
371 | begin |
372 | begin |
372 | itemIndex := ListCount(items)-1; |
373 | itemIndex := ListCount(items)-1; |
373 | iStartScope := itemIndex - Min(ListHeight,ListCount(items)); |
374 | iStartScope := itemIndex - Min(ListHeight,ListCount(items)); |
374 | iEndScope := itemIndex; |
375 | iEndScope := itemIndex; |
375 | goto doAgain; |
376 | goto doAgain; |
376 | end; |
377 | end; |
- | 378 | (* TODO: Implement PgUp and PgDown keys *) |
|
377 | end; |
379 | end; |
378 | 380 | ||
379 | if sc = #13(*Return*) then |
381 | if sc = #13(*Return*) then |
380 | begin |
382 | begin |
381 | DrawSelectionList := itemIndex; |
383 | DrawSelectionList := itemIndex; |
382 | break; |
384 | break; |
383 | end; |
385 | end; |
384 | 386 | ||
385 | if allowESC and (sc = #27(*ESC*)) then |
387 | if allowESC and (sc = #27(*ESC*)) then |
386 | begin |
388 | begin |
387 | DrawSelectionList := -1; |
389 | DrawSelectionList := -1; |
388 | break; |
390 | break; |
389 | end; |
391 | end; |
390 | until false; |
392 | until false; |
391 | 393 | ||
392 | (*CursorOn;*) |
394 | (*CursorOn;*) |
393 | end; |
395 | end; |
394 | 396 | ||
395 | procedure ClearSection(x, y, width, height: integer); |
397 | procedure ClearSection(x, y, width, height: integer); |
396 | var |
398 | var |
397 | ix, iy: integer; |
399 | ix, iy: integer; |
398 | begin |
400 | begin |
399 | for iy := y to y+height-1 do |
401 | for iy := y to y+height-1 do |
400 | begin |
402 | begin |
401 | for ix := x to x+width-1 do |
403 | for ix := x to x+width-1 do |
402 | begin |
404 | begin |
403 | GoToXY(ix,iy); |
405 | GoToXY(ix,iy); |
404 | Write(' '); |
406 | Write(' '); |
405 | end; |
407 | end; |
406 | end; |
408 | end; |
407 | end; |
409 | end; |
408 | 410 | ||
409 | function QueryVal(var s: string; initX, initY, width, height: integer; |
411 | function QueryVal(var s: string; initX, initY, width, height: integer; |
410 | Title: string; borderStrength: integer): boolean; |
412 | Title: string; borderStrength: integer): boolean; |
411 | var |
413 | var |
412 | x, y: integer; |
414 | x, y: integer; |
413 | i, j: integer; |
415 | i, j: integer; |
414 | sc: char; |
416 | sc: char; |
415 | stmp: string; |
417 | stmp: string; |
416 | begin |
418 | begin |
417 | if borderStrength = 1 then |
419 | if borderStrength = 1 then |
418 | DrawThinBorder(initX-1,initY-1,width+2,height+2); |
420 | DrawThinBorder(initX-1,initY-1,width+2,height+2); |
419 | if borderStrength = 2 then |
421 | if borderStrength = 2 then |
420 | DrawDoubleBorder(initX-1,initY-1,width+2,height+2); |
422 | DrawDoubleBorder(initX-1,initY-1,width+2,height+2); |
421 | if title <> '' then |
423 | if title <> '' then |
422 | begin |
424 | begin |
423 | if borderStrength > 0 then |
425 | if borderStrength > 0 then |
424 | GoToXY(initX+1, initY-1) |
426 | GoToXY(initX+1, initY-1) |
425 | else |
427 | else |
426 | GoToXY(initX, initY-1); |
428 | GoToXY(initX, initY-1); |
427 | Write(title); |
429 | Write(title); |
428 | end; |
430 | end; |
429 | ClearSection(initX,initY,width,height); |
431 | ClearSection(initX,initY,width,height); |
430 | 432 | ||
431 | x := initX; |
433 | x := initX; |
432 | y := initY; |
434 | y := initY; |
433 | 435 | ||
434 | (* Write existing string value and set cursor *) |
436 | (* Write existing string value and set cursor *) |
435 | stmp := s; |
437 | stmp := s; |
436 | s := ''; |
438 | s := ''; |
437 | for i := 1 to Length(stmp) do |
439 | for i := 1 to Length(stmp) do |
438 | begin |
440 | begin |
439 | if stmp[i] = #10 then |
441 | if stmp[i] = #10 then |
440 | begin |
442 | begin |
441 | s := s + stmp[i]; |
443 | s := s + stmp[i]; |
442 | continue; |
444 | continue; |
443 | end; |
445 | end; |
444 | 446 | ||
445 | GoToXY(x,y); |
447 | GoToXY(x,y); |
446 | s := s + stmp[i]; |
448 | s := s + stmp[i]; |
447 | Write(stmp[i]); |
449 | Write(stmp[i]); |
448 | Inc(x); |
450 | Inc(x); |
449 | 451 | ||
450 | if (x=initX+width-1) and (y=initY+height-1) then |
452 | if (x=initX+width-1) and (y=initY+height-1) then |
451 | begin |
453 | begin |
452 | (* Attention: Data following after this will be lost! *) |
454 | (* Attention: Data following after this will be lost! *) |
453 | break; |
455 | break; |
454 | end; |
456 | end; |
455 | 457 | ||
456 | if stmp[i] = #13 then |
458 | if stmp[i] = #13 then |
457 | begin |
459 | begin |
458 | if y=initY+height-1 then |
460 | if y=initY+height-1 then |
459 | begin |
461 | begin |
460 | (* Attention: Data following after this will be lost! *) |
462 | (* Attention: Data following after this will be lost! *) |
461 | s := Copy(s, 1, Length(s)-1); |
463 | s := Copy(s, 1, Length(s)-1); |
462 | Dec(x); |
464 | Dec(x); |
463 | break; |
465 | break; |
464 | end; |
466 | end; |
465 | x := initX; |
467 | x := initX; |
466 | Inc(y); |
468 | Inc(y); |
467 | continue; |
469 | continue; |
468 | end; |
470 | end; |
469 | 471 | ||
470 | if x=initX+width then |
472 | if x=initX+width then |
471 | begin |
473 | begin |
472 | Inc(y); |
474 | Inc(y); |
473 | x := initX; |
475 | x := initX; |
474 | end; |
476 | end; |
475 | end; |
477 | end; |
476 | 478 | ||
477 | repeat |
479 | repeat |
478 | GotoXY(x, y); |
480 | GotoXY(x, y); |
479 | sc := ReadKey; |
481 | sc := ReadKey; |
480 | 482 | ||
481 | if sc = #0 then |
483 | if sc = #0 then |
482 | begin |
484 | begin |
483 | (* Extended key code *) |
485 | (* Extended key code *) |
484 | sc := ReadKey; |
486 | sc := ReadKey; |
485 | (* TODO: Implement keys like DEL, END, POS1, and ArrowKeys *) |
487 | (* TODO: Implement keys like DEL, END, POS1, and ArrowKeys *) |
486 | Beep; |
488 | Beep; |
487 | continue; |
489 | continue; |
488 | end |
490 | end |
489 | else if sc = #8(*Backspace*) then |
491 | else if sc = #8(*Backspace*) then |
490 | begin |
492 | begin |
491 | if x <= initX then |
493 | if x <= initX then |
492 | begin |
494 | begin |
493 | if y = initY then |
495 | if y = initY then |
494 | begin |
496 | begin |
495 | Beep; |
497 | Beep; |
496 | continue; |
498 | continue; |
497 | end; |
499 | end; |
498 | Dec(y); |
500 | Dec(y); |
499 | 501 | ||
500 | (* Find out length of previous line *) |
502 | (* Find out length of previous line *) |
501 | j := Length(s)-2(*CRLF*); |
503 | j := Length(s)-2(*CRLF*); |
502 | while (j >= 0) do |
504 | while (j >= 0) do |
503 | begin |
505 | begin |
504 | if (s[j]=#13) or (s[j]=#10) then break; |
506 | if (s[j]=#13) or (s[j]=#10) then break; |
505 | Dec(j); |
507 | Dec(j); |
506 | end; |
508 | end; |
507 | j := Length(s)-2(*CRLF*)-j; |
509 | j := Length(s)-2(*CRLF*)-j; |
508 | x := initX + j; |
510 | x := initX + j; |
509 | s := Copy(s, 1, Length(s)-1); (* Remove #10 now. #13 will be removed below *) |
511 | s := Copy(s, 1, Length(s)-1); (* Remove #10 now. #13 will be removed below *) |
510 | end |
512 | end |
511 | else |
513 | else |
512 | begin |
514 | begin |
513 | Dec(x); |
515 | Dec(x); |
514 | end; |
516 | end; |
515 | GotoXY(x, y); |
517 | GotoXY(x, y); |
516 | Write(' '); |
518 | Write(' '); |
517 | GotoXY(x, y); |
519 | GotoXY(x, y); |
518 | s := Copy(s, 1, Length(s)-1); |
520 | s := Copy(s, 1, Length(s)-1); |
519 | continue; |
521 | continue; |
520 | end |
522 | end |
521 | else if sc = #13(*Return*) then |
523 | else if sc = #13(*Return*) then |
522 | begin |
524 | begin |
523 | if GetShiftState and kbRightShift <> 0 then |
525 | if GetShiftState and kbRightShift <> 0 then |
524 | begin |
526 | begin |
525 | if y=initY+height-1 then |
527 | if y=initY+height-1 then |
526 | begin |
528 | begin |
527 | Beep; |
529 | Beep; |
528 | continue; |
530 | continue; |
529 | end; |
531 | end; |
530 | s := s + #13 + #10; |
532 | s := s + #13 + #10; |
531 | x := initX; |
533 | x := initX; |
532 | Inc(y); |
534 | Inc(y); |
533 | end |
535 | end |
534 | else |
536 | else |
535 | begin |
537 | begin |
536 | QueryVal := true; |
538 | QueryVal := true; |
537 | exit; |
539 | exit; |
538 | end; |
540 | end; |
539 | end |
541 | end |
540 | else if sc = #27(*ESC*) then |
542 | else if sc = #27(*ESC*) then |
541 | begin |
543 | begin |
542 | QueryVal := false; |
544 | QueryVal := false; |
543 | exit; |
545 | exit; |
544 | end |
546 | end |
545 | else |
547 | else |
546 | begin |
548 | begin |
547 | if (x=initX+width-1) and (y=initY+height-1) then |
549 | if (x=initX+width-1) and (y=initY+height-1) then |
548 | begin |
550 | begin |
549 | Beep; |
551 | Beep; |
550 | continue; |
552 | continue; |
551 | end; |
553 | end; |
552 | s := s + sc; |
554 | s := s + sc; |
553 | Write(sc); |
555 | Write(sc); |
554 | Inc(x); |
556 | Inc(x); |
555 | if x >= initX+width then |
557 | if x >= initX+width then |
556 | begin |
558 | begin |
557 | Inc(y); |
559 | Inc(y); |
558 | x := initX; |
560 | x := initX; |
559 | end; |
561 | end; |
560 | end; |
562 | end; |
561 | until false; |
563 | until false; |
562 | end; |
564 | end; |
563 | 565 | ||
564 | procedure ShowMessage(msg: string; title: string; dobeep: boolean); |
566 | procedure ShowMessage(msg: string; title: string; dobeep: boolean); |
565 | var |
567 | var |
566 | x, y, w, h: integer; |
568 | x, y, w, h: integer; |
567 | begin |
569 | begin |
568 | x := SINGLE_LINE_BOX_PADDING_INNER; |
570 | x := SINGLE_LINE_BOX_PADDING_INNER; |
569 | y := ScreenHeight div 2 - 1; |
571 | y := ScreenHeight div 2 - 1; |
570 | w := ScreenWidth - (SINGLE_LINE_BOX_PADDING_INNER-1)*2; |
572 | w := ScreenWidth - (SINGLE_LINE_BOX_PADDING_INNER-1)*2; |
571 | h := 1; |
573 | h := 1; |
572 | DrawDoubleBorder(x-1, y, w+2, h+2); |
574 | DrawDoubleBorder(x-1, y, w+2, h+2); |
573 | ClearSection(x, y+1, w-2, h); |
575 | ClearSection(x, y+1, w-2, h); |
574 | if title <> '' then |
576 | if title <> '' then |
575 | begin |
577 | begin |
576 | GoToXY(x+1, y); |
578 | GoToXY(x+1, y); |
577 | Write(title); |
579 | Write(title); |
578 | end; |
580 | end; |
579 | GoToXY(x, y+1); |
581 | GoToXY(x, y+1); |
580 | Write(msg); |
582 | Write(msg); |
581 | if DoBeep then Beep; |
583 | if DoBeep then Beep; |
582 | end; |
584 | end; |
583 | 585 | ||
584 | procedure CursorOn; assembler; |
586 | procedure CursorOn; assembler; |
585 | asm |
587 | asm |
586 | mov ah,1 (* Set text-mode cursor shape *) |
588 | mov ah,1 (* Set text-mode cursor shape *) |
587 | mov cx,0607h (* normal underline cursor *) |
589 | mov cx,0607h (* normal underline cursor *) |
588 | int 10h |
590 | int 10h |
589 | end; |
591 | end; |
590 | 592 | ||
591 | procedure CursorOff; assembler; |
593 | procedure CursorOff; assembler; |
592 | asm |
594 | asm |
593 | mov ah,1 (* Set text-mode cursor shape *) |
595 | mov ah,1 (* Set text-mode cursor shape *) |
594 | mov cx,2607h (* hide cursor (Start>End) *) |
596 | mov cx,2607h (* hide cursor (Start>End) *) |
595 | int 10h |
597 | int 10h |
596 | end; |
598 | end; |
- | 599 | ||
- | 600 | procedure ResetDefaultDosColors; |
|
- | 601 | begin |
|
- | 602 | TextBackground(Black); |
|
- | 603 | TextColor(LightGray); |
|
- | 604 | end; |
|
597 | 605 | ||
598 | end. |
606 | end. |
599 | 607 |