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 public
20 type TActionCB = procedure (me: THControl; uinfo: Integer);
22 private
23 mParent: THControl;
24 mX, mY: Integer;
25 mWidth, mHeight: Integer;
26 mFrameWidth, mFrameHeight: Integer;
27 mEnabled: Boolean;
28 mCanFocus: Boolean;
29 mChildren: array of THControl;
30 mFocused: THControl; // valid only for top-level controls
31 mGrab: THControl; // valid only for top-level controls
32 mEscClose: Boolean; // valid only for top-level controls
33 mEatKeys: Boolean;
34 mDrawShadow: Boolean;
36 private
37 scallowed: Boolean;
38 scxywh: array[0..3] of GLint;
40 protected
41 function getEnabled (): Boolean;
42 procedure setEnabled (v: Boolean); inline;
44 function getFocused (): Boolean; inline;
45 procedure setFocused (v: Boolean); inline;
47 function isMyChild (ctl: THControl): Boolean;
49 function findFirstFocus (): THControl;
50 function findLastFocus (): THControl;
52 function findNextFocus (cur: THControl): THControl;
53 function findPrevFocus (cur: THControl): THControl;
55 procedure activated (); virtual;
56 procedure blurred (); virtual;
58 //WARNING! do not call scissor functions outside `.draw*()` API!
59 // reset scissor to whole control
60 procedure resetScissor ();
61 // set scissor to this internal rect (in local coords)
62 procedure setScissor (lx, ly, lw, lh: Integer);
64 // DO NOT USE!
65 procedure setScissorGLInternal (x, y, w, h: Integer);
67 public
68 // return `false` if destination rect is empty
69 // modifies rect0
70 class function intersectRect (var x0, y0, w0, h0: Integer; const x1, y1, w1, h1: Integer): Boolean;
72 public
73 actionCB: TActionCB;
75 public
76 constructor Create (ax, ay, aw, ah: Integer; aparent: THControl=nil);
77 destructor Destroy (); override;
79 // `sx` and `sy` are screen coordinates
80 procedure drawControl (sx, sy: Integer); virtual;
82 // called after all children drawn
83 procedure drawControlPost (sx, sy: Integer); virtual;
85 procedure draw (); virtual;
87 function topLevel (): THControl; inline;
89 // returns `true` if global coords are inside this control
90 function toLocal (var x, y: Integer): Boolean;
91 procedure toGlobal (var x, y: Integer);
93 // x and y are global coords
94 function controlAtXY (x, y: Integer): THControl;
96 function mouseEvent (var ev: THMouseEvent): Boolean; virtual; // returns `true` if event was eaten
97 function keyEvent (var ev: THKeyEvent): Boolean; virtual; // returns `true` if event was eaten
99 function prevSibling (): THControl;
100 function nextSibling (): THControl;
101 function firstChild (): THControl; inline;
102 function lastChild (): THControl; inline;
104 procedure appendChild (ctl: THControl); virtual;
106 public
107 property x0: Integer read mX;
108 property y0: Integer read mY;
109 property height: Integer read mHeight;
110 property width: Integer read mWidth;
111 property enabled: Boolean read getEnabled write setEnabled;
112 property parent: THControl read mParent;
113 property focused: Boolean read getFocused write setFocused;
114 property escClose: Boolean read mEscClose write mEscClose;
115 property eatKeys: Boolean read mEatKeys write mEatKeys;
116 end;
119 THTopWindow = class(THControl)
120 private
121 mTitle: AnsiString;
122 mDragging: Boolean;
123 mDragStartX, mDragStartY: Integer;
124 mWaitingClose: Boolean;
125 mInClose: Boolean;
127 protected
128 procedure blurred (); override;
130 public
131 closeCB: TActionCB; // called after window was removed from ui window list
133 public
134 constructor Create (const atitle: AnsiString; ax, ay: Integer; aw: Integer=-1; ah: Integer=-1);
136 procedure centerInScreen ();
138 // `sx` and `sy` are screen coordinates
139 procedure drawControl (sx, sy: Integer); override;
140 procedure drawControlPost (sx, sy: Integer); override;
142 function keyEvent (var ev: THKeyEvent): Boolean; override; // returns `true` if event was eaten
143 function mouseEvent (var ev: THMouseEvent): Boolean; override; // returns `true` if event was eaten
144 end;
147 THCtlSimpleText = class(THControl)
148 private
149 type
150 PItem = ^TItem;
151 TItem = record
152 title: AnsiString;
153 centered: Boolean;
154 hline: Boolean;
155 end;
156 private
157 mItems: array of TItem;
159 public
160 constructor Create (ax, ay: Integer; aparent: THControl=nil);
161 destructor Destroy (); override;
163 procedure appendItem (const atext: AnsiString; acentered: Boolean=false; ahline: Boolean=false);
165 procedure drawControl (sx, sy: Integer); override;
167 function mouseEvent (var ev: THMouseEvent): Boolean; override;
168 function keyEvent (var ev: THKeyEvent): Boolean; override;
169 end;
172 THCtlCBListBox = class(THControl)
173 private
174 type
175 PItem = ^TItem;
176 TItem = record
177 title: AnsiString;
178 varp: PBoolean;
179 actionCB: TActionCB;
180 end;
181 private
182 mItems: array of TItem;
183 mCurIndex: Integer;
185 public
186 constructor Create (ax, ay: Integer; aparent: THControl=nil);
187 destructor Destroy (); override;
189 procedure appendItem (const atext: AnsiString; bv: PBoolean; aaction: TActionCB=nil);
191 procedure drawControl (sx, sy: Integer); override;
193 function mouseEvent (var ev: THMouseEvent): Boolean; override;
194 function keyEvent (var ev: THKeyEvent): Boolean; override;
195 end;
198 // ////////////////////////////////////////////////////////////////////////// //
199 var
200 uiTopList: array of THControl = nil;
203 function uiMouseEvent (var ev: THMouseEvent): Boolean;
204 var
205 f, c: Integer;
206 lx, ly: Integer;
207 ctmp: THControl;
208 begin
209 if (Length(uiTopList) = 0) then result := false else result := uiTopList[High(uiTopList)].mouseEvent(ev);
210 if not result and (ev.kind = ev.Press) then
211 begin
212 for f := High(uiTopList) downto 0 do
213 begin
214 lx := ev.x;
215 ly := ev.y;
216 if uiTopList[f].toLocal(lx, ly) then
217 begin
218 result := true;
219 if uiTopList[f].mEnabled and (f <> High(uiTopList)) then
220 begin
221 uiTopList[High(uiTopList)].blurred();
222 ctmp := uiTopList[f];
223 ctmp.mGrab := nil;
224 for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
225 uiTopList[High(uiTopList)] := ctmp;
226 ctmp.activated();
227 result := ctmp.mouseEvent(ev);
228 end;
229 exit;
230 end;
231 end;
232 end;
233 end;
236 function uiKeyEvent (var ev: THKeyEvent): Boolean;
237 begin
238 if (Length(uiTopList) = 0) then result := false else result := uiTopList[High(uiTopList)].keyEvent(ev);
239 if (ev.kind = ev.Release) then begin result := true; exit; end;
240 end;
243 procedure uiDraw ();
244 var
245 f: Integer;
246 ctl: THControl;
247 begin
248 for f := 0 to High(uiTopList) do
249 begin
250 ctl := uiTopList[f];
251 ctl.draw();
252 if (f <> High(uiTopList)) then darkenRect(ctl.x0, ctl.y0, ctl.width, ctl.height, 128);
253 end;
254 end;
257 procedure uiAddWindow (ctl: THControl);
258 var
259 f, c: Integer;
260 begin
261 if (ctl = nil) then exit;
262 ctl := ctl.topLevel;
263 for f := 0 to High(uiTopList) do
264 begin
265 if (uiTopList[f] = ctl) then
266 begin
267 if (f <> High(uiTopList)) then
268 begin
269 uiTopList[High(uiTopList)].blurred();
270 for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
271 uiTopList[High(uiTopList)] := ctl;
272 ctl.activated();
273 end;
274 exit;
275 end;
276 end;
277 if (Length(uiTopList) > 0) then uiTopList[High(uiTopList)].blurred();
278 SetLength(uiTopList, Length(uiTopList)+1);
279 uiTopList[High(uiTopList)] := ctl;
280 ctl.activated();
281 end;
284 // won't free object
285 procedure uiRemoveWindow (ctl: THControl);
286 var
287 f, c: Integer;
288 begin
289 if (ctl = nil) then exit;
290 ctl := ctl.topLevel;
291 for f := 0 to High(uiTopList) do
292 begin
293 if (uiTopList[f] = ctl) then
294 begin
295 ctl.blurred();
296 for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
297 SetLength(uiTopList, Length(uiTopList)-1);
298 if (ctl is THTopWindow) then
299 begin
300 if assigned(THTopWindow(ctl).closeCB) then THTopWindow(ctl).closeCB(ctl, 0);
301 end;
302 exit;
303 end;
304 end;
305 end;
308 function uiVisibleWindow (ctl: THControl): Boolean;
309 var
310 f: Integer;
311 begin
312 result := false;
313 if (ctl = nil) then exit;
314 ctl := ctl.topLevel;
315 for f := 0 to High(uiTopList) do
316 begin
317 if (uiTopList[f] = ctl) then begin result := true; exit; end;
318 end;
319 end;
322 // ////////////////////////////////////////////////////////////////////////// //
323 constructor THControl.Create (ax, ay, aw, ah: Integer; aparent: THControl=nil);
324 begin
325 mParent := aparent;
326 mX := ax;
327 mY := ay;
328 mWidth := aw;
329 mHeight := ah;
330 mFrameWidth := 0;
331 mFrameHeight := 0;
332 mEnabled := true;
333 mCanFocus := true;
334 mChildren := nil;
335 mFocused := nil;
336 mGrab := nil;
337 mEscClose := false;
338 mEatKeys := false;
339 scallowed := false;
340 mDrawShadow := false;
341 actionCB := nil;
342 end;
345 destructor THControl.Destroy ();
346 var
347 f, c: Integer;
348 begin
349 if (mParent <> nil) then
350 begin
351 setFocused(false);
352 for f := 0 to High(mParent.mChildren) do
353 begin
354 if (mParent.mChildren[f] = self) then
355 begin
356 for c := f+1 to High(mParent.mChildren) do mParent.mChildren[c-1] := mParent.mChildren[c];
357 SetLength(mParent.mChildren, Length(mParent.mChildren)-1);
358 end;
359 end;
360 end;
361 for f := 0 to High(mChildren) do
362 begin
363 mChildren[f].mParent := nil;
364 mChildren[f].Free();
365 end;
366 mChildren := nil;
367 end;
370 procedure THControl.activated ();
371 begin
372 end;
375 procedure THControl.blurred ();
376 begin
377 mGrab := nil;
378 end;
381 function THControl.topLevel (): THControl; inline;
382 begin
383 result := self;
384 while (result.mParent <> nil) do result := result.mParent;
385 end;
388 function THControl.getEnabled (): Boolean;
389 var
390 ctl: THControl;
391 begin
392 result := false;
393 if (not mEnabled) or (mWidth < 1) or (mHeight < 1) then exit;
394 ctl := mParent;
395 while (ctl <> nil) do
396 begin
397 if (not ctl.mEnabled) or (ctl.mWidth < 1) or (ctl.mHeight < 1) then exit;
398 ctl := ctl.mParent;
399 end;
400 result := true;
401 end;
404 procedure THControl.setEnabled (v: Boolean); inline;
405 begin
406 if (mEnabled = v) then exit;
407 mEnabled := v;
408 if not v and focused then setFocused(false);
409 end;
412 function THControl.getFocused (): Boolean; inline;
413 begin
414 if (mParent = nil) then result := (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)] = self) else result := (topLevel.mFocused = self);
415 end;
418 procedure THControl.setFocused (v: Boolean); inline;
419 var
420 tl: THControl;
421 begin
422 tl := topLevel;
423 if not v then
424 begin
425 if (tl.mFocused = self) then
426 begin
427 tl.blurred();
428 tl.mFocused := tl.findNextFocus(self);
429 if (tl.mFocused = self) then tl.mFocused := nil;
430 end;
431 exit;
432 end;
433 if (not mEnabled) or (not mCanFocus) then exit;
434 if (tl.mFocused <> self) then
435 begin
436 tl.mFocused.blurred();
437 tl.mFocused := self;
438 if (tl.mGrab <> self) then tl.mGrab := nil;
439 activated();
440 end;
441 end;
444 function THControl.isMyChild (ctl: THControl): Boolean;
445 begin
446 result := true;
447 while (ctl <> nil) do
448 begin
449 if (ctl.mParent = self) then exit;
450 ctl := ctl.mParent;
451 end;
452 result := false;
453 end;
456 // returns `true` if global coords are inside this control
457 function THControl.toLocal (var x, y: Integer): Boolean;
458 var
459 ctl: THControl;
460 begin
461 ctl := self;
462 while (ctl <> nil) do
463 begin
464 Dec(x, ctl.mX);
465 Dec(y, ctl.mY);
466 ctl := ctl.mParent;
467 end;
468 result := (x >= 0) and (y >= 0) and (x < mWidth) and (y < mHeight);
469 end;
472 procedure THControl.toGlobal (var x, y: Integer);
473 var
474 ctl: THControl;
475 begin
476 ctl := self;
477 while (ctl <> nil) do
478 begin
479 Inc(x, ctl.mX);
480 Inc(y, ctl.mY);
481 ctl := ctl.mParent;
482 end;
483 end;
486 // x and y are global coords
487 function THControl.controlAtXY (x, y: Integer): THControl;
488 var
489 lx, ly: Integer;
490 f: Integer;
491 begin
492 result := nil;
493 if (not mEnabled) or (mWidth < 1) or (mHeight < 1) then exit;
494 lx := x;
495 ly := y;
496 if not toLocal(lx, ly) then exit;
497 for f := High(mChildren) downto 0 do
498 begin
499 result := mChildren[f].controlAtXY(x, y);
500 if (result <> nil) then exit;
501 end;
502 result := self;
503 end;
506 function THControl.prevSibling (): THControl;
507 var
508 f: Integer;
509 begin
510 if (mParent <> nil) then
511 begin
512 for f := 1 to High(mParent.mChildren) do
513 begin
514 if (mParent.mChildren[f] = self) then begin result := mParent.mChildren[f-1]; exit; end;
515 end;
516 end;
517 result := nil;
518 end;
520 function THControl.nextSibling (): THControl;
521 var
522 f: Integer;
523 begin
524 if (mParent <> nil) then
525 begin
526 for f := 0 to High(mParent.mChildren)-1 do
527 begin
528 if (mParent.mChildren[f] = self) then begin result := mParent.mChildren[f+1]; exit; end;
529 end;
530 end;
531 result := nil;
532 end;
534 function THControl.firstChild (): THControl; inline;
535 begin
536 if (Length(mChildren) <> 0) then result := mChildren[0] else result := nil;
537 end;
539 function THControl.lastChild (): THControl; inline;
540 begin
541 if (Length(mChildren) <> 0) then result := mChildren[High(mChildren)] else result := nil;
542 end;
545 function THControl.findFirstFocus (): THControl;
546 var
547 f: Integer;
548 begin
549 result := nil;
550 if enabled then
551 begin
552 for f := 0 to High(mChildren) do
553 begin
554 result := mChildren[f].findFirstFocus();
555 if (result <> nil) then exit;
556 end;
557 if mCanFocus then result := self;
558 end;
559 end;
562 function THControl.findLastFocus (): THControl;
563 var
564 f: Integer;
565 begin
566 result := nil;
567 if enabled then
568 begin
569 for f := High(mChildren) downto 0 do
570 begin
571 result := mChildren[f].findLastFocus();
572 if (result <> nil) then exit;
573 end;
574 if mCanFocus then result := self;
575 end;
576 end;
579 function THControl.findNextFocus (cur: THControl): THControl;
580 begin
581 result := nil;
582 if enabled then
583 begin
584 if not isMyChild(cur) then cur := nil;
585 if (cur = nil) then begin result := findFirstFocus(); exit; end;
586 result := cur.findFirstFocus();
587 if (result <> nil) and (result <> cur) then exit;
588 while true do
589 begin
590 cur := cur.nextSibling;
591 if (cur = nil) then break;
592 result := cur.findFirstFocus();
593 if (result <> nil) then exit;
594 end;
595 result := findFirstFocus();
596 end;
597 end;
600 function THControl.findPrevFocus (cur: THControl): THControl;
601 begin
602 result := nil;
603 if enabled then
604 begin
605 if not isMyChild(cur) then cur := nil;
606 if (cur = nil) then begin result := findLastFocus(); exit; end;
607 //FIXME!
608 result := cur.findLastFocus();
609 if (result <> nil) and (result <> cur) then exit;
610 while true do
611 begin
612 cur := cur.prevSibling;
613 if (cur = nil) then break;
614 result := cur.findLastFocus();
615 if (result <> nil) then exit;
616 end;
617 result := findLastFocus();
618 end;
619 end;
622 procedure THControl.appendChild (ctl: THControl);
623 begin
624 if (ctl = nil) then exit;
625 if (ctl.mParent <> nil) then exit;
626 SetLength(mChildren, Length(mChildren)+1);
627 mChildren[High(mChildren)] := ctl;
628 ctl.mParent := self;
629 Inc(ctl.mX, mFrameWidth);
630 Inc(ctl.mY, mFrameHeight);
631 if (ctl.mWidth > 0) and (ctl.mHeight > 0) and
632 (ctl.mX+ctl.mWidth > mFrameWidth) and (ctl.mY+ctl.mHeight > mFrameHeight) then
633 begin
634 if (mWidth+mFrameWidth < ctl.mX+ctl.mWidth) then mWidth := ctl.mX+ctl.mWidth+mFrameWidth;
635 if (mHeight+mFrameHeight < ctl.mY+ctl.mHeight) then mHeight := ctl.mY+ctl.mHeight+mFrameHeight;
636 end;
637 if (mFocused = nil) and ctl.mEnabled and ctl.mCanFocus and (ctl.mWidth > 0) and (ctl.mHeight > 0) then mFocused := ctl;
638 end;
641 //TODO: overflow checks
642 class function THControl.intersectRect (var x0, y0, w0, h0: Integer; const x1, y1, w1, h1: Integer): Boolean;
643 var
644 ex0, ey0: Integer;
645 begin
646 result := false;
647 if (w0 < 1) or (h0 < 1) or (w1 < 1) or (h1 < 1) then exit;
648 // check for intersection
649 if (x0+w0 <= x1) or (y0+h0 <= y1) or (x1+w1 <= x0) or (y1+h1 <= y0) then exit;
650 if (x0 >= x1+w1) or (y0 >= y1+h1) or (x1 >= x0+h0) or (y1 >= y0+h0) then exit;
651 // ok, intersects
652 ex0 := x0+w0;
653 ey0 := y0+h0;
654 if (x0 < x1) then x0 := x1;
655 if (y0 < y1) then y0 := y1;
656 if (ex0 > x1+w1) then ex0 := x1+w1;
657 if (ey0 > y1+h1) then ey0 := y1+h1;
658 w0 := ex0-x0;
659 h0 := ey0-y0;
660 result := (w0 > 0) and (h0 > 0);
661 end;
664 procedure THControl.setScissorGLInternal (x, y, w, h: Integer);
665 begin
666 if not scallowed then exit;
667 x := trunc(x*g_holmes_ui_scale);
668 y := trunc(y*g_holmes_ui_scale);
669 w := trunc(w*g_holmes_ui_scale);
670 h := trunc(h*g_holmes_ui_scale);
671 y := gWinSizeY-(y+h);
672 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);
673 end;
676 procedure THControl.resetScissor ();
677 var
678 x, y: Integer;
679 begin
680 if not scallowed then exit;
681 x := 0;
682 y := 0;
683 toGlobal(x, y);
684 setScissorGLInternal(x, y, mWidth, mHeight);
685 end;
688 procedure THControl.setScissor (lx, ly, lw, lh: Integer);
689 var
690 x, y: Integer;
691 begin
692 if not scallowed then exit;
693 if not intersectRect(lx, ly, lw, lh, 0, 0, mWidth, mHeight) then begin glScissor(0, 0, 0, 0); exit; end;
694 x := lx;
695 y := ly;
696 toGlobal(x, y);
697 setScissorGLInternal(x, y, lw, lh);
698 end;
701 procedure THControl.draw ();
702 var
703 f: Integer;
704 x, y: Integer;
705 wassc: Boolean;
706 begin
707 if (mWidth < 1) or (mHeight < 1) then exit;
708 x := 0;
709 y := 0;
710 toGlobal(x, y);
711 //conwritefln('[%s]: (%d,%d)-(%d,%d) (%d,%d)', [ClassName, mX, mY, mWidth, mHeight, x, y]);
713 scxywh[0] := 0;
714 scxywh[1] := 0;
715 scxywh[2] := 0;
716 scxywh[3] := 0;
718 wassc := (glIsEnabled(GL_SCISSOR_TEST) <> 0);
719 if wassc then glGetIntegerv(GL_SCISSOR_BOX, @scxywh[0]) else glGetIntegerv(GL_VIEWPORT, @scxywh[0]);
720 //conwritefln('(%d,%d)-(%d,%d)', [scxywh[0], scxywh[1], scxywh[2], scxywh[3]]);
721 glEnable(GL_SCISSOR_TEST);
722 scallowed := true;
724 resetScissor();
725 drawControl(x, y);
726 if (mFrameWidth <> 0) or (mFrameHeight <> 0) then setScissor(mFrameWidth, mFrameHeight, mWidth-mFrameWidth*2, mHeight-mFrameHeight*2);
727 for f := 0 to High(mChildren) do mChildren[f].draw();
728 if (mFrameWidth <> 0) or (mFrameHeight <> 0) then resetScissor();
729 drawControlPost(x, y);
730 glScissor(scxywh[0], scxywh[1], scxywh[2], scxywh[3]);
732 if wassc then glEnable(GL_SCISSOR_TEST) else glDisable(GL_SCISSOR_TEST);
733 scallowed := false;
734 end;
737 procedure THControl.drawControl (sx, sy: Integer);
738 begin
739 if (mParent = nil) then darkenRect(sx, sy, mWidth, mHeight, 64);
740 end;
743 procedure THControl.drawControlPost (sx, sy: Integer);
744 begin
745 if mDrawShadow and (mWidth > 0) and (mHeight > 0) then
746 begin
747 setScissorGLInternal(sx+8, sy+8, mWidth, mHeight);
748 darkenRect(sx+mWidth, sy+8, 8, mHeight, 128);
749 darkenRect(sx+8, sy+mHeight, mWidth-8, 8, 128);
750 end;
751 end;
754 function THControl.mouseEvent (var ev: THMouseEvent): Boolean;
755 var
756 ctl: THControl;
757 begin
758 result := false;
759 if not mEnabled then exit;
760 if (mParent = nil) then
761 begin
762 if (mGrab <> nil) then
763 begin
764 result := mGrab.mouseEvent(ev);
765 if (ev.kind = ev.Release) then mGrab := nil;
766 exit;
767 end;
768 end;
769 if (mWidth < 1) or (mHeight < 1) then exit;
770 ctl := controlAtXY(ev.x, ev.y);
771 if (ctl <> nil) and (ctl <> self) then
772 begin
773 if (ctl <> topLevel.mFocused) then ctl.setFocused(true);
774 result := ctl.mouseEvent(ev);
775 end
776 else if (ctl = self) and assigned(actionCB) then
777 begin
778 actionCB(self, 0);
779 end;
780 end;
783 function THControl.keyEvent (var ev: THKeyEvent): Boolean;
784 var
785 ctl: THControl;
786 begin
787 result := false;
788 if not mEnabled then exit;
789 if (topLevel.mFocused <> self) and isMyChild(topLevel.mFocused) and topLevel.mFocused.mEnabled then result := topLevel.mFocused.keyEvent(ev);
790 if (mParent = nil) then
791 begin
792 if (ev.kind = ev.Press) and (ev = 'S-Tab') then
793 begin
794 result := true;
795 if (ev.kind = ev.Press) then
796 begin
797 ctl := findPrevFocus(mFocused);
798 if (ctl <> mFocused) then
799 begin
800 mGrab := nil;
801 mFocused := ctl;
802 end;
803 end;
804 exit;
805 end;
806 if (ev.kind = ev.Press) and (ev = 'Tab') then
807 begin
808 result := true;
809 if (ev.kind = ev.Press) then
810 begin
811 ctl := findNextFocus(mFocused);
812 if (ctl <> mFocused) then
813 begin
814 mGrab := nil;
815 mFocused := ctl;
816 end;
817 end;
818 exit;
819 end;
820 if mEscClose and (ev.kind = ev.Press) and (ev = 'Escape') then
821 begin
822 result := true;
823 uiRemoveWindow(self);
824 exit;
825 end;
826 end;
827 if mEatKeys then result := true;
828 end;
831 // ////////////////////////////////////////////////////////////////////////// //
832 constructor THTopWindow.Create (const atitle: AnsiString; ax, ay: Integer; aw: Integer=-1; ah: Integer=-1);
833 begin
834 inherited Create(ax, ay, aw, ah, nil);
835 mFrameWidth := 8;
836 mFrameHeight := 8;
837 mTitle := atitle;
838 if (mWidth < mFrameWidth*2+3*8) then mWidth := mFrameWidth*2+3*8;
839 if (mHeight < mFrameHeight*2) then mHeight := mFrameHeight*2;
840 if (Length(mTitle) > 0) then
841 begin
842 if (mWidth < Length(mTitle)*8+mFrameWidth*2+3*8) then mWidth := Length(mTitle)*8+mFrameWidth*2+3*8;
843 end;
844 mDragging := false;
845 mDrawShadow := true;
846 mWaitingClose := false;
847 mInClose := false;
848 closeCB := nil;
849 end;
852 procedure THTopWindow.centerInScreen ();
853 begin
854 if (mWidth > 0) and (mHeight > 0) then
855 begin
856 mX := trunc((gWinSizeX/g_holmes_ui_scale-mWidth)/2);
857 mY := trunc((gWinSizeY/g_holmes_ui_scale-mHeight)/2);
858 end;
859 end;
862 procedure THTopWindow.drawControl (sx, sy: Integer);
863 begin
864 fillRect(sx, sy, mWidth, mHeight, 0, 0, 128);
865 end;
868 procedure THTopWindow.drawControlPost (sx, sy: Integer);
869 const r = 255;
870 const g = 255;
871 const b = 255;
872 var
873 tx: Integer;
874 begin
875 if mDragging then
876 begin
877 drawRect(mX+4, mY+4, mWidth-8, mHeight-8, r, g, b);
878 end
879 else
880 begin
881 drawRect(mX+3, mY+3, mWidth-6, mHeight-6, r, g, b);
882 drawRect(mX+5, mY+5, mWidth-10, mHeight-10, r, g, b);
883 setScissor(mFrameWidth, 0, 3*8, 8);
884 fillRect(mX+mFrameWidth, mY, 3*8, 8, 0, 0, 128);
885 drawText8(mX+mFrameWidth, mY, '[ ]', r, g, b);
886 if mInClose then drawText8(mX+mFrameWidth+7, mY, '#', 0, 255, 0)
887 else drawText8(mX+mFrameWidth+7, mY, '*', 0, 255, 0);
888 end;
889 if (Length(mTitle) > 0) then
890 begin
891 setScissor(mFrameWidth+3*8, 0, mWidth-mFrameWidth*2-3*8, 8);
892 tx := (mX+3*8)+((mWidth-3*8)-Length(mTitle)*8) div 2;
893 fillRect(tx-3, mY, Length(mTitle)*8+3+2, 8, 0, 0, 128);
894 drawText8(tx, mY, mTitle, r, g, b);
895 end;
896 inherited drawControlPost(sx, sy);
897 end;
900 procedure THTopWindow.blurred ();
901 begin
902 mDragging := false;
903 mWaitingClose := false;
904 mInClose := false;
905 inherited;
906 end;
909 function THTopWindow.keyEvent (var ev: THKeyEvent): Boolean;
910 begin
911 result := inherited keyEvent(ev);
912 if not getFocused then exit;
913 if (ev.kind = ev.Press) and (ev = 'M-F3') then
914 begin
915 uiRemoveWindow(self);
916 result := true;
917 exit;
918 end;
919 end;
922 function THTopWindow.mouseEvent (var ev: THMouseEvent): Boolean;
923 var
924 lx, ly: Integer;
925 begin
926 result := false;
927 if not mEnabled then exit;
928 if (mWidth < 1) or (mHeight < 1) then exit;
930 if mDragging then
931 begin
932 mX += ev.x-mDragStartX;
933 mY += ev.y-mDragStartY;
934 mDragStartX := ev.x;
935 mDragStartY := ev.y;
936 if (ev.kind = ev.Release) then mDragging := false;
937 result := true;
938 exit;
939 end;
941 lx := ev.x;
942 ly := ev.y;
943 if toLocal(lx, ly) then
944 begin
945 if (ev.kind = ev.Press) then
946 begin
947 if (ly < 8) then
948 begin
949 if (lx >= mFrameWidth) and (lx < mFrameWidth+3*8) then
950 begin
951 //uiRemoveWindow(self);
952 mWaitingClose := true;
953 mInClose := true;
954 end
955 else
956 begin
957 mDragging := true;
958 mDragStartX := ev.x;
959 mDragStartY := ev.y;
960 end;
961 result := true;
962 exit;
963 end;
964 if (lx < mFrameWidth) or (lx >= mWidth-mFrameWidth) or (ly >= mHeight-mFrameHeight) then
965 begin
966 mDragging := true;
967 mDragStartX := ev.x;
968 mDragStartY := ev.y;
969 result := true;
970 exit;
971 end;
972 end;
974 if (ev.kind = ev.Release) then
975 begin
976 if mWaitingClose and (lx >= mFrameWidth) and (lx < mFrameWidth+3*8) then
977 begin
978 uiRemoveWindow(self);
979 result := true;
980 exit;
981 end;
982 mWaitingClose := false;
983 mInClose := false;
984 end;
986 if (ev.kind = ev.Motion) then
987 begin
988 if mWaitingClose then
989 begin
990 mInClose := (lx >= mFrameWidth) and (lx < mFrameWidth+3*8);
991 result := true;
992 exit;
993 end;
994 end;
995 end
996 else
997 begin
998 mInClose := false;
999 if (ev.kind <> ev.Motion) then mWaitingClose := false;
1000 end;
1002 result := inherited mouseEvent(ev);
1003 end;
1006 // ////////////////////////////////////////////////////////////////////////// //
1007 constructor THCtlSimpleText.Create (ax, ay: Integer; aparent: THControl=nil);
1008 begin
1009 mItems := nil;
1010 inherited Create(ax, ay, 4, 4);
1011 end;
1014 destructor THCtlSimpleText.Destroy ();
1015 begin
1016 mItems := nil;
1017 inherited;
1018 end;
1021 procedure THCtlSimpleText.appendItem (const atext: AnsiString; acentered: Boolean=false; ahline: Boolean=false);
1022 var
1023 it: PItem;
1024 begin
1025 if (Length(atext)*8+3*8+2 > mWidth) then mWidth := Length(atext)*8+3*8+2;
1026 SetLength(mItems, Length(mItems)+1);
1027 it := @mItems[High(mItems)];
1028 it.title := atext;
1029 it.centered := acentered;
1030 it.hline := ahline;
1031 if (Length(mItems)*8 > mHeight) then mHeight := Length(mItems)*8;
1032 end;
1035 procedure THCtlSimpleText.drawControl (sx, sy: Integer);
1036 var
1037 f, tx: Integer;
1038 it: PItem;
1039 r, g, b: Integer;
1040 begin
1041 for f := 0 to High(mItems) do
1042 begin
1043 it := @mItems[f];
1044 tx := sx;
1045 r := 255;
1046 g := 255;
1047 b := 0;
1048 if it.centered then begin b := 255; tx := sx+(mWidth-Length(it.title)*8) div 2; end;
1049 if it.hline then
1050 begin
1051 b := 255;
1052 if (Length(it.title) = 0) then
1053 begin
1054 drawLine(sx+4, sy+3, sx+mWidth-8, sy+3, r, g, b);
1055 end
1056 else if (tx-3 > sx+4) then
1057 begin
1058 drawLine(sx+4, sy+3, tx-3, sy+3, r, g, b);
1059 drawLine(tx+Length(it.title)*8, sy+3, sx+mWidth-4, sy+3, r, g, b);
1060 end;
1061 end;
1062 drawText8(tx, sy, it.title, r, g, b);
1063 Inc(sy, 8);
1064 end;
1065 end;
1068 function THCtlSimpleText.mouseEvent (var ev: THMouseEvent): Boolean;
1069 var
1070 lx, ly: Integer;
1071 begin
1072 result := inherited mouseEvent(ev);
1073 lx := ev.x;
1074 ly := ev.y;
1075 if not result and toLocal(lx, ly) then
1076 begin
1077 result := true;
1078 end;
1079 end;
1082 function THCtlSimpleText.keyEvent (var ev: THKeyEvent): Boolean;
1083 begin
1084 result := inherited keyEvent(ev);
1085 end;
1088 // ////////////////////////////////////////////////////////////////////////// //
1089 constructor THCtlCBListBox.Create (ax, ay: Integer; aparent: THControl=nil);
1090 begin
1091 mItems := nil;
1092 mCurIndex := -1;
1093 inherited Create(ax, ay, 4, 4);
1094 end;
1097 destructor THCtlCBListBox.Destroy ();
1098 begin
1099 mItems := nil;
1100 inherited;
1101 end;
1104 procedure THCtlCBListBox.appendItem (const atext: AnsiString; bv: PBoolean; aaction: TActionCB=nil);
1105 var
1106 it: PItem;
1107 begin
1108 if (Length(atext)*8+3*8+2 > mWidth) then mWidth := Length(atext)*8+3*8+2;
1109 SetLength(mItems, Length(mItems)+1);
1110 it := @mItems[High(mItems)];
1111 it.title := atext;
1112 it.varp := bv;
1113 it.actionCB := aaction;
1114 if (Length(mItems)*8 > mHeight) then mHeight := Length(mItems)*8;
1115 if (mCurIndex < 0) then mCurIndex := 0;
1116 end;
1119 procedure THCtlCBListBox.drawControl (sx, sy: Integer);
1120 var
1121 f, tx: Integer;
1122 it: PItem;
1123 begin
1124 for f := 0 to High(mItems) do
1125 begin
1126 it := @mItems[f];
1127 if (mCurIndex = f) then fillRect(sx, sy, mWidth, 8, 0, 128, 0);
1128 if (it.varp <> nil) then
1129 begin
1130 if it.varp^ then drawText8(sx, sy, '[x]', 255, 255, 255) else drawText8(sx, sy, '[ ]', 255, 255, 255);
1131 drawText8(sx+3*8+2, sy, it.title, 255, 255, 0);
1132 end
1133 else if (Length(it.title) > 0) then
1134 begin
1135 tx := sx+(mWidth-Length(it.title)*8) div 2;
1136 if (tx-3 > sx+4) then
1137 begin
1138 drawLine(sx+4, sy+3, tx-3, sy+3, 255, 255, 255);
1139 drawLine(tx+Length(it.title)*8, sy+3, sx+mWidth-4, sy+3, 255, 255, 255);
1140 end;
1141 drawText8(tx, sy, it.title, 255, 255, 255);
1142 end
1143 else
1144 begin
1145 drawLine(sx+4, sy+3, sx+mWidth-8, sy+3, 255, 255, 255);
1146 end;
1147 Inc(sy, 8);
1148 end;
1149 end;
1152 function THCtlCBListBox.mouseEvent (var ev: THMouseEvent): Boolean;
1153 var
1154 lx, ly: Integer;
1155 it: PItem;
1156 begin
1157 result := inherited mouseEvent(ev);
1158 lx := ev.x;
1159 ly := ev.y;
1160 if not result and toLocal(lx, ly) then
1161 begin
1162 result := true;
1163 if (ev.kind = ev.Press) and (ev = 'lmb') then
1164 begin
1165 ly := ly div 8;
1166 if (ly >= 0) and (ly < Length(mItems)) then
1167 begin
1168 it := @mItems[ly];
1169 if (it.varp <> nil) then
1170 begin
1171 mCurIndex := ly;
1172 it.varp^ := not it.varp^;
1173 if assigned(it.actionCB) then it.actionCB(self, Integer(it.varp^));
1174 if assigned(actionCB) then actionCB(self, ly);
1175 end;
1176 end;
1177 end;
1178 end;
1179 end;
1182 function THCtlCBListBox.keyEvent (var ev: THKeyEvent): Boolean;
1183 var
1184 it: PItem;
1185 begin
1186 result := inherited keyEvent(ev);
1187 if not getFocused then exit;
1188 //result := true;
1189 if (ev.kind = ev.Press) then
1190 begin
1191 if (ev = 'Home') or (ev = 'PageUp') then
1192 begin
1193 result := true;
1194 mCurIndex := 0;
1195 end;
1196 if (ev = 'End') or (ev = 'PageDown') then
1197 begin
1198 result := true;
1199 mCurIndex := High(mItems);
1200 end;
1201 if (ev = 'Up') then
1202 begin
1203 result := true;
1204 if (Length(mItems) > 0) then
1205 begin
1206 if (mCurIndex < 0) then mCurIndex := Length(mItems);
1207 while (mCurIndex > 0) do
1208 begin
1209 Dec(mCurIndex);
1210 if (mItems[mCurIndex].varp <> nil) then break;
1211 end;
1212 end
1213 else
1214 begin
1215 mCurIndex := -1;
1216 end;
1217 end;
1218 if (ev = 'Down') then
1219 begin
1220 result := true;
1221 if (Length(mItems) > 0) then
1222 begin
1223 if (mCurIndex < 0) then mCurIndex := -1;
1224 while (mCurIndex < High(mItems)) do
1225 begin
1226 Inc(mCurIndex);
1227 if (mItems[mCurIndex].varp <> nil) then break;
1228 end;
1229 end
1230 else
1231 begin
1232 mCurIndex := -1;
1233 end;
1234 end;
1235 if (ev = 'Space') or (ev = 'Return') then
1236 begin
1237 result := true;
1238 if (mCurIndex >= 0) and (mCurIndex < Length(mItems)) and (mItems[mCurIndex].varp <> nil) then
1239 begin
1240 it := @mItems[mCurIndex];
1241 it.varp^ := not it.varp^;
1242 if assigned(it.actionCB) then it.actionCB(self, Integer(it.varp^));
1243 if assigned(actionCB) then actionCB(self, mCurIndex);
1244 end;
1245 end;
1246 end;
1247 end;