1 (* Copyright (C) DooM 2D:Forever Developers
2 *
3 * This program is free software: you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation, either version 3 of the License, or
6 * (at your option) any later version.
7 *
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
12 *
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
15 *)
16 // ////////////////////////////////////////////////////////////////////////// //
17 type
18 THControl = class
19 private
20 mParent: THControl;
21 mX, mY: Integer;
22 mWidth, mHeight: Integer;
23 mFrameWidth, mFrameHeight: Integer;
24 mEnabled: Boolean;
25 mCanFocus: Boolean;
26 mChildren: array of THControl;
27 mFocused: THControl; // valid only for top-level controls
28 mGrab: THControl; // valid only for top-level controls
29 mEscClose: Boolean; // valid only for top-level controls
30 mEatKeys: Boolean;
31 mDrawShadow: Boolean;
33 private
34 scallowed: Boolean;
35 scxywh: array[0..3] of GLint;
37 protected
38 function getEnabled (): Boolean;
39 procedure setEnabled (v: Boolean); inline;
41 function getFocused (): Boolean; inline;
42 procedure setFocused (v: Boolean); inline;
44 function isMyChild (ctl: THControl): Boolean;
46 function findFirstFocus (): THControl;
47 function findLastFocus (): THControl;
49 function findNextFocus (cur: THControl): THControl;
50 function findPrevFocus (cur: THControl): THControl;
52 procedure activated (); virtual;
53 procedure blurred (); virtual;
55 //WARNING! do not call scissor functions outside `.draw*()` API!
56 // reset scissor to whole control
57 procedure resetScissor ();
58 // set scissor to this internal rect (in local coords)
59 procedure setScissor (lx, ly, lw, lh: Integer);
61 // DO NOT USE!
62 procedure setScissorGLInternal (x, y, w, h: Integer);
64 public
65 // return `false` if destination rect is empty
66 // modifies rect0
67 class function intersectRect (var x0, y0, w0, h0: Integer; const x1, y1, w1, h1: Integer): Boolean;
69 public
70 constructor Create (ax, ay, aw, ah: Integer; aparent: THControl=nil);
71 destructor Destroy (); override;
73 // `sx` and `sy` are screen coordinates
74 procedure drawControl (sx, sy: Integer); virtual;
76 // called after all children drawn
77 procedure drawControlPost (sx, sy: Integer); virtual;
79 procedure draw (); virtual;
81 function topLevel (): THControl; inline;
83 // returns `true` if global coords are inside this control
84 function toLocal (var x, y: Integer): Boolean;
85 procedure toGlobal (var x, y: Integer);
87 // x and y are global coords
88 function controlAtXY (x, y: Integer): THControl;
90 function mouseEvent (var ev: THMouseEvent): Boolean; virtual; // returns `true` if event was eaten
91 function keyEvent (var ev: THKeyEvent): Boolean; virtual; // returns `true` if event was eaten
93 function prevSibling (): THControl;
94 function nextSibling (): THControl;
95 function firstChild (): THControl; inline;
96 function lastChild (): THControl; inline;
98 procedure appendChild (ctl: THControl); virtual;
100 public
101 property x0: Integer read mX;
102 property y0: Integer read mY;
103 property height: Integer read mHeight;
104 property width: Integer read mWidth;
105 property enabled: Boolean read getEnabled write setEnabled;
106 property parent: THControl read mParent;
107 property focused: Boolean read getFocused write setFocused;
108 property escClose: Boolean read mEscClose write mEscClose;
109 property eatKeys: Boolean read mEatKeys write mEatKeys;
110 end;
113 THTopWindow = class(THControl)
114 private
115 mTitle: AnsiString;
116 mDragging: Boolean;
117 mDragStartX, mDragStartY: Integer;
119 protected
120 procedure blurred (); override;
122 public
123 constructor Create (const atitle: AnsiString; ax, ay: Integer; aw: Integer=-1; ah: Integer=-1);
125 // `sx` and `sy` are screen coordinates
126 procedure drawControl (sx, sy: Integer); override;
127 procedure drawControlPost (sx, sy: Integer); override;
129 function keyEvent (var ev: THKeyEvent): Boolean; override; // returns `true` if event was eaten
130 function mouseEvent (var ev: THMouseEvent): Boolean; override; // returns `true` if event was eaten
131 end;
134 THCtlCBListBox = class(THControl)
135 private
136 mItems: array of AnsiString;
137 mChecks: array of PBoolean;
138 mCurIndex: Integer;
140 public
141 constructor Create (ax, ay: Integer; aparent: THControl=nil);
142 destructor Destroy (); override;
144 procedure appendItem (const atext: AnsiString; bv: PBoolean);
146 procedure drawControl (sx, sy: Integer); override;
148 function mouseEvent (var ev: THMouseEvent): Boolean; override;
149 function keyEvent (var ev: THKeyEvent): Boolean; override;
150 end;
152 // ////////////////////////////////////////////////////////////////////////// //
153 var
154 uiTopList: array of THControl = nil;
157 function uiMouseEvent (var ev: THMouseEvent): Boolean;
158 var
159 f, c: Integer;
160 lx, ly: Integer;
161 ctmp: THControl;
162 begin
163 if (Length(uiTopList) = 0) then result := false else result := uiTopList[High(uiTopList)].mouseEvent(ev);
164 if not result and (ev.kind = ev.Press) then
165 begin
166 for f := High(uiTopList) downto 0 do
167 begin
168 lx := ev.x;
169 ly := ev.y;
170 if uiTopList[f].toLocal(lx, ly) then
171 begin
172 result := true;
173 if uiTopList[f].mEnabled and (f <> High(uiTopList)) then
174 begin
175 uiTopList[High(uiTopList)].blurred();
176 ctmp := uiTopList[f];
177 ctmp.mGrab := nil;
178 for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
179 uiTopList[High(uiTopList)] := ctmp;
180 ctmp.activated();
181 result := ctmp.mouseEvent(ev);
182 end;
183 exit;
184 end;
185 end;
186 end;
187 end;
190 function uiKeyEvent (var ev: THKeyEvent): Boolean;
191 begin
192 if (Length(uiTopList) = 0) then result := false else result := uiTopList[High(uiTopList)].keyEvent(ev);
193 if (ev.kind = ev.Release) then begin result := true; exit; end;
194 end;
197 procedure uiDraw ();
198 var
199 f: Integer;
200 ctl: THControl;
201 begin
202 for f := 0 to High(uiTopList) do
203 begin
204 ctl := uiTopList[f];
205 ctl.draw();
206 if (f <> High(uiTopList)) then darkenRect(ctl.x0, ctl.y0, ctl.width, ctl.height, 128);
207 end;
208 end;
211 procedure uiAddWindow (ctl: THControl);
212 var
213 f, c: Integer;
214 begin
215 if (ctl = nil) then exit;
216 ctl := ctl.topLevel;
217 for f := 0 to High(uiTopList) do
218 begin
219 if (uiTopList[f] = ctl) then
220 begin
221 if (f <> High(uiTopList)) then
222 begin
223 uiTopList[High(uiTopList)].blurred();
224 for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
225 uiTopList[High(uiTopList)] := ctl;
226 ctl.activated();
227 end;
228 exit;
229 end;
230 end;
231 if (Length(uiTopList) > 0) then uiTopList[High(uiTopList)].blurred();
232 SetLength(uiTopList, Length(uiTopList)+1);
233 uiTopList[High(uiTopList)] := ctl;
234 ctl.activated();
235 end;
238 // won't free object
239 procedure uiRemoveWindow (ctl: THControl);
240 var
241 f, c: Integer;
242 begin
243 if (ctl = nil) then exit;
244 ctl := ctl.topLevel;
245 for f := 0 to High(uiTopList) do
246 begin
247 if (uiTopList[f] = ctl) then
248 begin
249 ctl.blurred();
250 for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
251 SetLength(uiTopList, Length(uiTopList)-1);
252 exit;
253 end;
254 end;
255 end;
258 function uiVisibleWindow (ctl: THControl): Boolean;
259 var
260 f: Integer;
261 begin
262 result := false;
263 if (ctl = nil) then exit;
264 ctl := ctl.topLevel;
265 for f := 0 to High(uiTopList) do
266 begin
267 if (uiTopList[f] = ctl) then begin result := true; exit; end;
268 end;
269 end;
272 // ////////////////////////////////////////////////////////////////////////// //
273 constructor THControl.Create (ax, ay, aw, ah: Integer; aparent: THControl=nil);
274 begin
275 mParent := aparent;
276 mX := ax;
277 mY := ay;
278 mWidth := aw;
279 mHeight := ah;
280 mFrameWidth := 0;
281 mFrameHeight := 0;
282 mEnabled := true;
283 mCanFocus := true;
284 mChildren := nil;
285 mFocused := nil;
286 mGrab := nil;
287 mEscClose := false;
288 mEatKeys := false;
289 scallowed := false;
290 mDrawShadow := false;
291 end;
294 destructor THControl.Destroy ();
295 var
296 f, c: Integer;
297 begin
298 if (mParent <> nil) then
299 begin
300 setFocused(false);
301 for f := 0 to High(mParent.mChildren) do
302 begin
303 if (mParent.mChildren[f] = self) then
304 begin
305 for c := f+1 to High(mParent.mChildren) do mParent.mChildren[c-1] := mParent.mChildren[c];
306 SetLength(mParent.mChildren, Length(mParent.mChildren)-1);
307 end;
308 end;
309 end;
310 for f := 0 to High(mChildren) do
311 begin
312 mChildren[f].mParent := nil;
313 mChildren[f].Free();
314 end;
315 mChildren := nil;
316 end;
319 procedure THControl.activated ();
320 begin
321 end;
324 procedure THControl.blurred ();
325 begin
326 mGrab := nil;
327 end;
330 function THControl.topLevel (): THControl; inline;
331 begin
332 result := self;
333 while (result.mParent <> nil) do result := result.mParent;
334 end;
337 function THControl.getEnabled (): Boolean;
338 var
339 ctl: THControl;
340 begin
341 result := false;
342 if (not mEnabled) or (mWidth < 1) or (mHeight < 1) then exit;
343 ctl := mParent;
344 while (ctl <> nil) do
345 begin
346 if (not ctl.mEnabled) or (ctl.mWidth < 1) or (ctl.mHeight < 1) then exit;
347 ctl := ctl.mParent;
348 end;
349 result := true;
350 end;
353 procedure THControl.setEnabled (v: Boolean); inline;
354 begin
355 if (mEnabled = v) then exit;
356 mEnabled := v;
357 if not v and focused then setFocused(false);
358 end;
361 function THControl.getFocused (): Boolean; inline;
362 begin
363 if (mParent = nil) then result := (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)] = self) else result := (topLevel.mFocused = self);
364 end;
367 procedure THControl.setFocused (v: Boolean); inline;
368 var
369 tl: THControl;
370 begin
371 tl := topLevel;
372 if not v then
373 begin
374 if (tl.mFocused = self) then
375 begin
376 tl.blurred();
377 tl.mFocused := tl.findNextFocus(self);
378 if (tl.mFocused = self) then tl.mFocused := nil;
379 end;
380 exit;
381 end;
382 if (not mEnabled) or (not mCanFocus) then exit;
383 if (tl.mFocused <> self) then
384 begin
385 tl.mFocused.blurred();
386 tl.mFocused := self;
387 if (tl.mGrab <> self) then tl.mGrab := nil;
388 activated();
389 end;
390 end;
393 function THControl.isMyChild (ctl: THControl): Boolean;
394 begin
395 result := true;
396 while (ctl <> nil) do
397 begin
398 if (ctl.mParent = self) then exit;
399 ctl := ctl.mParent;
400 end;
401 result := false;
402 end;
405 // returns `true` if global coords are inside this control
406 function THControl.toLocal (var x, y: Integer): Boolean;
407 var
408 ctl: THControl;
409 begin
410 ctl := self;
411 while (ctl <> nil) do
412 begin
413 Dec(x, ctl.mX);
414 Dec(y, ctl.mY);
415 ctl := ctl.mParent;
416 end;
417 result := (x >= 0) and (y >= 0) and (x < mWidth) and (y < mHeight);
418 end;
421 procedure THControl.toGlobal (var x, y: Integer);
422 var
423 ctl: THControl;
424 begin
425 ctl := self;
426 while (ctl <> nil) do
427 begin
428 Inc(x, ctl.mX);
429 Inc(y, ctl.mY);
430 ctl := ctl.mParent;
431 end;
432 end;
435 // x and y are global coords
436 function THControl.controlAtXY (x, y: Integer): THControl;
437 var
438 lx, ly: Integer;
439 f: Integer;
440 begin
441 result := nil;
442 if (not mEnabled) or (mWidth < 1) or (mHeight < 1) then exit;
443 lx := x;
444 ly := y;
445 if not toLocal(lx, ly) then exit;
446 for f := High(mChildren) downto 0 do
447 begin
448 result := mChildren[f].controlAtXY(x, y);
449 if (result <> nil) then exit;
450 end;
451 result := self;
452 end;
455 function THControl.prevSibling (): THControl;
456 var
457 f: Integer;
458 begin
459 if (mParent <> nil) then
460 begin
461 for f := 1 to High(mParent.mChildren) do
462 begin
463 if (mParent.mChildren[f] = self) then begin result := mParent.mChildren[f-1]; exit; end;
464 end;
465 end;
466 result := nil;
467 end;
469 function THControl.nextSibling (): THControl;
470 var
471 f: Integer;
472 begin
473 if (mParent <> nil) then
474 begin
475 for f := 0 to High(mParent.mChildren)-1 do
476 begin
477 if (mParent.mChildren[f] = self) then begin result := mParent.mChildren[f+1]; exit; end;
478 end;
479 end;
480 result := nil;
481 end;
483 function THControl.firstChild (): THControl; inline;
484 begin
485 if (Length(mChildren) <> 0) then result := mChildren[0] else result := nil;
486 end;
488 function THControl.lastChild (): THControl; inline;
489 begin
490 if (Length(mChildren) <> 0) then result := mChildren[High(mChildren)] else result := nil;
491 end;
494 function THControl.findFirstFocus (): THControl;
495 var
496 f: Integer;
497 begin
498 result := nil;
499 if enabled then
500 begin
501 for f := 0 to High(mChildren) do
502 begin
503 result := mChildren[f].findFirstFocus();
504 if (result <> nil) then exit;
505 end;
506 if mCanFocus then result := self;
507 end;
508 end;
511 function THControl.findLastFocus (): THControl;
512 var
513 f: Integer;
514 begin
515 result := nil;
516 if enabled then
517 begin
518 for f := High(mChildren) downto 0 do
519 begin
520 result := mChildren[f].findLastFocus();
521 if (result <> nil) then exit;
522 end;
523 if mCanFocus then result := self;
524 end;
525 end;
528 function THControl.findNextFocus (cur: THControl): THControl;
529 begin
530 result := nil;
531 if enabled then
532 begin
533 if not isMyChild(cur) then cur := nil;
534 if (cur = nil) then begin result := findFirstFocus(); exit; end;
535 result := cur.findFirstFocus();
536 if (result <> nil) and (result <> cur) then exit;
537 while true do
538 begin
539 cur := cur.nextSibling;
540 if (cur = nil) then break;
541 result := cur.findFirstFocus();
542 if (result <> nil) then exit;
543 end;
544 result := findFirstFocus();
545 end;
546 end;
549 function THControl.findPrevFocus (cur: THControl): THControl;
550 begin
551 result := nil;
552 if enabled then
553 begin
554 if not isMyChild(cur) then cur := nil;
555 if (cur = nil) then begin result := findLastFocus(); exit; end;
556 //FIXME!
557 result := cur.findLastFocus();
558 if (result <> nil) and (result <> cur) then exit;
559 while true do
560 begin
561 cur := cur.prevSibling;
562 if (cur = nil) then break;
563 result := cur.findLastFocus();
564 if (result <> nil) then exit;
565 end;
566 result := findLastFocus();
567 end;
568 end;
571 procedure THControl.appendChild (ctl: THControl);
572 begin
573 if (ctl = nil) then exit;
574 if (ctl.mParent <> nil) then exit;
575 SetLength(mChildren, Length(mChildren)+1);
576 mChildren[High(mChildren)] := ctl;
577 ctl.mParent := self;
578 Inc(ctl.mX, mFrameWidth);
579 Inc(ctl.mY, mFrameHeight);
580 if (ctl.mWidth > 0) and (ctl.mHeight > 0) and
581 (ctl.mX+ctl.mWidth > mFrameWidth) and (ctl.mY+ctl.mHeight > mFrameHeight) then
582 begin
583 if (mWidth+mFrameWidth < ctl.mX+ctl.mWidth) then mWidth := ctl.mX+ctl.mWidth+mFrameWidth;
584 if (mHeight+mFrameHeight < ctl.mY+ctl.mHeight) then mHeight := ctl.mY+ctl.mHeight+mFrameHeight;
585 end;
586 if (mFocused = nil) and ctl.mEnabled and ctl.mCanFocus and (ctl.mWidth > 0) and (ctl.mHeight > 0) then mFocused := ctl;
587 end;
590 //TODO: overflow checks
591 class function THControl.intersectRect (var x0, y0, w0, h0: Integer; const x1, y1, w1, h1: Integer): Boolean;
592 var
593 ex0, ey0: Integer;
594 begin
595 result := false;
596 if (w0 < 1) or (h0 < 1) or (w1 < 1) or (h1 < 1) then exit;
597 // check for intersection
598 if (x0+w0 <= x1) or (y0+h0 <= y1) or (x1+w1 <= x0) or (y1+h1 <= y0) then exit;
599 if (x0 >= x1+w1) or (y0 >= y1+h1) or (x1 >= x0+h0) or (y1 >= y0+h0) then exit;
600 // ok, intersects
601 ex0 := x0+w0;
602 ey0 := y0+h0;
603 if (x0 < x1) then x0 := x1;
604 if (y0 < y1) then y0 := y1;
605 if (ex0 > x1+w1) then ex0 := x1+w1;
606 if (ey0 > y1+h1) then ey0 := y1+h1;
607 w0 := ex0-x0;
608 h0 := ey0-y0;
609 result := (w0 > 0) and (h0 > 0);
610 end;
613 procedure THControl.setScissorGLInternal (x, y, w, h: Integer);
614 begin
615 if not scallowed then exit;
616 y := gWinSizeY-(y+h);
617 if not intersectRect(x, y, w, h, scxywh[0], scxywh[1], scxywh[2], scxywh[3]) then glScissor(0, 0, 0, 0) else glScissor(x, y, w, h);
618 end;
621 procedure THControl.resetScissor ();
622 var
623 x, y: Integer;
624 begin
625 if not scallowed then exit;
626 x := 0;
627 y := 0;
628 toGlobal(x, y);
629 setScissorGLInternal(x, y, mWidth, mHeight);
630 end;
633 procedure THControl.setScissor (lx, ly, lw, lh: Integer);
634 var
635 x, y: Integer;
636 begin
637 if not scallowed then exit;
638 if not intersectRect(lx, ly, lw, lh, 0, 0, mWidth, mHeight) then begin glScissor(0, 0, 0, 0); exit; end;
639 x := lx;
640 y := ly;
641 toGlobal(x, y);
642 setScissorGLInternal(x, y, lw, lh);
643 end;
646 procedure THControl.draw ();
647 var
648 f: Integer;
649 x, y: Integer;
650 wassc: Boolean;
651 begin
652 if (mWidth < 1) or (mHeight < 1) then exit;
653 x := 0;
654 y := 0;
655 toGlobal(x, y);
656 //conwritefln('[%s]: (%d,%d)-(%d,%d) (%d,%d)', [ClassName, mX, mY, mWidth, mHeight, x, y]);
658 scxywh[0] := 0;
659 scxywh[1] := 0;
660 scxywh[2] := 0;
661 scxywh[3] := 0;
663 wassc := (glIsEnabled(GL_SCISSOR_TEST) <> 0);
664 if wassc then glGetIntegerv(GL_SCISSOR_BOX, @scxywh[0]) else glGetIntegerv(GL_VIEWPORT, @scxywh[0]);
665 //conwritefln('(%d,%d)-(%d,%d)', [scxywh[0], scxywh[1], scxywh[2], scxywh[3]]);
666 glEnable(GL_SCISSOR_TEST);
667 scallowed := true;
669 resetScissor();
670 drawControl(x, y);
671 if (mFrameWidth <> 0) or (mFrameHeight <> 0) then setScissor(mFrameWidth, mFrameHeight, mWidth-mFrameWidth*2, mHeight-mFrameHeight*2);
672 for f := 0 to High(mChildren) do mChildren[f].draw();
673 if (mFrameWidth <> 0) or (mFrameHeight <> 0) then resetScissor();
674 drawControlPost(x, y);
675 glScissor(scxywh[0], scxywh[1], scxywh[2], scxywh[3]);
677 if wassc then glEnable(GL_SCISSOR_TEST) else glDisable(GL_SCISSOR_TEST);
678 scallowed := false;
679 end;
682 procedure THControl.drawControl (sx, sy: Integer);
683 begin
684 if (mParent = nil) then darkenRect(sx, sy, mWidth, mHeight, 64);
685 end;
688 procedure THControl.drawControlPost (sx, sy: Integer);
689 begin
690 if mDrawShadow and (mWidth > 0) and (mHeight > 0) then
691 begin
692 setScissorGLInternal(sx+8, sy+8, mWidth, mHeight);
693 darkenRect(sx+mWidth, sy+8, 8, mHeight, 128);
694 darkenRect(sx+8, sy+mHeight, mWidth-8, 8, 128);
695 end;
696 end;
699 function THControl.mouseEvent (var ev: THMouseEvent): Boolean;
700 var
701 ctl: THControl;
702 begin
703 result := false;
704 if not mEnabled then exit;
705 if (mParent = nil) then
706 begin
707 if (mGrab <> nil) then
708 begin
709 result := mGrab.mouseEvent(ev);
710 if (ev.kind = ev.Release) then mGrab := nil;
711 exit;
712 end;
713 end;
714 if (mWidth < 1) or (mHeight < 1) then exit;
715 ctl := controlAtXY(ev.x, ev.y);
716 if (ctl <> nil) and (ctl <> self) then
717 begin
718 if (ctl <> topLevel.mFocused) then ctl.setFocused(true);
719 result := ctl.mouseEvent(ev);
720 end;
721 end;
724 function THControl.keyEvent (var ev: THKeyEvent): Boolean;
725 var
726 ctl: THControl;
727 begin
728 result := false;
729 if not mEnabled then exit;
730 if (topLevel.mFocused <> self) and isMyChild(topLevel.mFocused) and topLevel.mFocused.mEnabled then result := topLevel.mFocused.keyEvent(ev);
731 if (mParent = nil) then
732 begin
733 if (ev.kstate = THKeyEvent.ModShift) and (ev.scan = SDL_SCANCODE_TAB) then
734 begin
735 result := true;
736 if (ev.kind = ev.Press) then
737 begin
738 ctl := findPrevFocus(mFocused);
739 if (ctl <> mFocused) then
740 begin
741 mGrab := nil;
742 mFocused := ctl;
743 end;
744 end;
745 exit;
746 end;
747 if (ev.kstate = 0) and (ev.scan = SDL_SCANCODE_TAB) then
748 begin
749 result := true;
750 if (ev.kind = ev.Press) then
751 begin
752 ctl := findNextFocus(mFocused);
753 if (ctl <> mFocused) then
754 begin
755 mGrab := nil;
756 mFocused := ctl;
757 end;
758 end;
759 exit;
760 end;
761 if mEscClose and (ev.kind = ev.Press) and (ev.kstate = 0) and (ev.scan = SDL_SCANCODE_ESCAPE) then
762 begin
763 result := true;
764 uiRemoveWindow(self);
765 exit;
766 end;
767 end;
768 if mEatKeys then result := true;
769 end;
772 // ////////////////////////////////////////////////////////////////////////// //
773 constructor THTopWindow.Create (const atitle: AnsiString; ax, ay: Integer; aw: Integer=-1; ah: Integer=-1);
774 begin
775 inherited Create(ax, ay, aw, ah, nil);
776 mFrameWidth := 8;
777 mFrameHeight := 8;
778 mTitle := atitle;
779 if (mWidth < mFrameWidth*2) then mWidth := mFrameWidth*2;
780 if (mHeight < mFrameHeight*2) then mHeight := mFrameHeight*2;
781 if (Length(mTitle) > 0) then
782 begin
783 if (mWidth < Length(mTitle)*8+mFrameWidth*2) then mWidth := Length(mTitle)*8+mFrameWidth*2;
784 end;
785 mDragging := false;
786 mDrawShadow := true;
787 end;
790 procedure THTopWindow.drawControl (sx, sy: Integer);
791 begin
792 fillRect(sx, sy, mWidth, mHeight, 0, 0, 128);
793 end;
796 procedure THTopWindow.drawControlPost (sx, sy: Integer);
797 const r = 255;
798 const g = 255;
799 const b = 255;
800 var
801 tx: Integer;
802 begin
803 if mDragging then
804 begin
805 drawRect(mX+4, mY+4, mWidth-8, mHeight-8, r, g, b);
806 end
807 else
808 begin
809 drawRect(mX+3, mY+3, mWidth-6, mHeight-6, r, g, b);
810 drawRect(mX+5, mY+5, mWidth-10, mHeight-10, r, g, b);
811 end;
812 if (Length(mTitle) > 0) then
813 begin
814 setScissor(mFrameWidth, 0, mWidth-mFrameWidth*2, 8);
815 tx := (mWidth-Length(mTitle)*8) div 2;
816 fillRect(mX+tx-3, mY, Length(mTitle)*8+3+2, 8, 0, 0, 128);
817 drawText8(mX+tx, mY, mTitle, r, g, b);
818 end;
819 inherited drawControlPost(sx, sy);
820 end;
823 procedure THTopWindow.blurred ();
824 begin
825 mDragging := false;
826 inherited;
827 end;
830 function THTopWindow.keyEvent (var ev: THKeyEvent): Boolean;
831 begin
832 result := inherited keyEvent(ev);
833 if not getFocused then exit;
834 if (ev.kstate = ev.ModAlt) and (ev.kind = ev.Press) and (ev.scan = SDL_SCANCODE_F3) then
835 begin
836 uiRemoveWindow(self);
837 result := true;
838 exit;
839 end;
840 end;
843 function THTopWindow.mouseEvent (var ev: THMouseEvent): Boolean;
844 var
845 lx, ly: Integer;
846 begin
847 result := false;
848 if not mEnabled then exit;
849 if (mWidth < 1) or (mHeight < 1) then exit;
851 if mDragging then
852 begin
853 mX += ev.x-mDragStartX;
854 mY += ev.y-mDragStartY;
855 mDragStartX := ev.x;
856 mDragStartY := ev.y;
857 if (ev.kind = ev.Release) then mDragging := false;
858 result := true;
859 exit;
860 end;
862 if (ev.kind = ev.Press) and (ev.but = ev.Left) then
863 begin
864 lx := ev.x;
865 ly := ev.y;
866 if toLocal(lx, ly) then
867 begin
868 if (ly < 8) then
869 begin
870 mDragging := true;
871 mDragStartX := ev.x;
872 mDragStartY := ev.y;
873 result := true;
874 exit;
875 end;
876 end;
877 end;
879 if (ev.kind = ev.Press) and (ev.but = ev.Right) then
880 begin
881 lx := ev.x;
882 ly := ev.y;
883 if toLocal(lx, ly) then
884 begin
885 if (ly < 8) then
886 begin
887 uiRemoveWindow(self);
888 result := true;
889 exit;
890 end;
891 end;
892 end;
894 result := inherited mouseEvent(ev);
895 end;
898 // ////////////////////////////////////////////////////////////////////////// //
899 constructor THCtlCBListBox.Create (ax, ay: Integer; aparent: THControl=nil);
900 begin
901 mItems := nil;
902 mChecks := nil;
903 mCurIndex := -1;
904 inherited Create(ax, ay, 4, 4);
905 end;
908 destructor THCtlCBListBox.Destroy ();
909 begin
910 mItems := nil;
911 mChecks := nil;
912 inherited;
913 end;
916 procedure THCtlCBListBox.appendItem (const atext: AnsiString; bv: PBoolean);
917 begin
918 if (Length(atext)*8+4+3*8+2 > mWidth) then mWidth := Length(atext)*8+4+3*8+2;
919 SetLength(mItems, Length(mItems)+1);
920 mItems[High(mItems)] := atext;
921 SetLength(mChecks, Length(mChecks)+1);
922 mChecks[High(mChecks)] := bv;
923 if (Length(mItems)*8+4 > mHeight) then mHeight := Length(mItems)*8+4;
924 if (mCurIndex < 0) then mCurIndex := 0;
925 end;
928 procedure THCtlCBListBox.drawControl (sx, sy: Integer);
929 var
930 f, tx: Integer;
931 begin
932 //fillRect(sx, sy, mWidth, mHeight, 0, 128, 0);
933 Inc(sx, 2);
934 Inc(sy, 2);
935 for f := 0 to High(mItems) do
936 begin
937 if (mCurIndex = f) then fillRect(sx-2, sy, mWidth, 8, 0, 128, 0);
938 if (mChecks[f] <> nil) then
939 begin
940 //drawText8(sx, sy, '[ ]', 255, 255, 255);
941 //if mChecks[f]^ then drawText8(sx+6, sy, 'x', 255, 255, 255);
942 if mChecks[f]^ then drawText8(sx, sy, '[x]', 255, 255, 255) else drawText8(sx, sy, '[ ]', 255, 255, 255);
943 drawText8(sx+3*8+2, sy, mItems[f], 255, 255, 0);
944 end
945 else if (Length(mItems[f]) > 0) then
946 begin
947 tx := sx+(mWidth-Length(mItems[f])*8) div 2;
948 if (tx-3 > sx+4) then
949 begin
950 drawLine(sx+4, sy+3, tx-3, sy+3, 255, 255, 255);
951 drawLine(tx+Length(mItems[f])*8, sy+3, sx+mWidth-4, sy+3, 255, 255, 255);
952 end;
953 drawText8(sx+(mWidth-Length(mItems[f])*8) div 2, sy, mItems[f], 255, 255, 255);
954 end
955 else
956 begin
957 drawLine(sx+4, sy+3, sx+mWidth-8, sy+3, 255, 255, 255);
958 end;
959 Inc(sy, 8);
960 end;
961 end;
964 function THCtlCBListBox.mouseEvent (var ev: THMouseEvent): Boolean;
965 var
966 lx, ly: Integer;
967 begin
968 result := inherited mouseEvent(ev);
969 if not result and (Length(mItems) > 0) and (ev.kind = ev.Press) then
970 begin
971 lx := ev.x;
972 ly := ev.y;
973 if toLocal(lx, ly) then
974 begin
975 if (ly < 2) then ly := 2;
976 ly := ly div 8;
977 if (ly < 0) then ly := 0 else if (ly > High(mItems)) then ly := High(mItems);
978 if (mChecks[ly] <> nil) then
979 begin
980 mCurIndex := ly;
981 if (mChecks[ly] <> nil) then mChecks[ly]^ := not mChecks[ly]^;
982 end;
983 end;
984 end;
985 end;
988 function THCtlCBListBox.keyEvent (var ev: THKeyEvent): Boolean;
989 begin
990 result := inherited keyEvent(ev);
991 if not getFocused then exit;
992 //result := true;
993 if (ev.kstate = 0) and (ev.kind = ev.Press) then
994 begin
995 case ev.scan of
996 SDL_SCANCODE_HOME,
997 SDL_SCANCODE_PAGEUP:
998 begin
999 result := true;
1000 mCurIndex := 0;
1001 end;
1002 SDL_SCANCODE_END,
1003 SDL_SCANCODE_PAGEDOWN:
1004 begin
1005 result := true;
1006 mCurIndex := High(mItems);
1007 end;
1008 SDL_SCANCODE_UP:
1009 begin
1010 result := true;
1011 if (Length(mItems) > 0) then
1012 begin
1013 if (mCurIndex < 0) then mCurIndex := Length(mItems);
1014 while (mCurIndex > 0) do
1015 begin
1016 Dec(mCurIndex);
1017 if (mChecks[mCurIndex] <> nil) then break;
1018 end;
1019 end
1020 else
1021 begin
1022 mCurIndex := -1;
1023 end;
1024 end;
1025 SDL_SCANCODE_DOWN:
1026 begin
1027 result := true;
1028 if (Length(mItems) > 0) then
1029 begin
1030 if (mCurIndex < 0) then mCurIndex := -1;
1031 while (mCurIndex < High(mItems)) do
1032 begin
1033 Inc(mCurIndex);
1034 if (mChecks[mCurIndex] <> nil) then break;
1035 end;
1036 end
1037 else
1038 begin
1039 mCurIndex := -1;
1040 end;
1041 end;
1042 SDL_SCANCODE_SPACE,
1043 SDL_SCANCODE_RETURN:
1044 begin
1045 result := true;
1046 if (mCurIndex >= 0) and (mCurIndex < Length(mChecks)) and (mChecks[mCurIndex] <> nil) then mChecks[mCurIndex]^ := not mChecks[mCurIndex]^;
1047 end;
1048 end;
1049 end;
1050 end;