a6daf4f491b4d6da83f65e0ffbcf53c5de212cec
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 y := gWinSizeY-(y+h);
668 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);
669 end;
672 procedure THControl.resetScissor ();
673 var
674 x, y: Integer;
675 begin
676 if not scallowed then exit;
677 x := 0;
678 y := 0;
679 toGlobal(x, y);
680 setScissorGLInternal(x, y, mWidth, mHeight);
681 end;
684 procedure THControl.setScissor (lx, ly, lw, lh: Integer);
685 var
686 x, y: Integer;
687 begin
688 if not scallowed then exit;
689 if not intersectRect(lx, ly, lw, lh, 0, 0, mWidth, mHeight) then begin glScissor(0, 0, 0, 0); exit; end;
690 x := lx;
691 y := ly;
692 toGlobal(x, y);
693 setScissorGLInternal(x, y, lw, lh);
694 end;
697 procedure THControl.draw ();
698 var
699 f: Integer;
700 x, y: Integer;
701 wassc: Boolean;
702 begin
703 if (mWidth < 1) or (mHeight < 1) then exit;
704 x := 0;
705 y := 0;
706 toGlobal(x, y);
707 //conwritefln('[%s]: (%d,%d)-(%d,%d) (%d,%d)', [ClassName, mX, mY, mWidth, mHeight, x, y]);
709 scxywh[0] := 0;
710 scxywh[1] := 0;
711 scxywh[2] := 0;
712 scxywh[3] := 0;
714 wassc := (glIsEnabled(GL_SCISSOR_TEST) <> 0);
715 if wassc then glGetIntegerv(GL_SCISSOR_BOX, @scxywh[0]) else glGetIntegerv(GL_VIEWPORT, @scxywh[0]);
716 //conwritefln('(%d,%d)-(%d,%d)', [scxywh[0], scxywh[1], scxywh[2], scxywh[3]]);
717 glEnable(GL_SCISSOR_TEST);
718 scallowed := true;
720 resetScissor();
721 drawControl(x, y);
722 if (mFrameWidth <> 0) or (mFrameHeight <> 0) then setScissor(mFrameWidth, mFrameHeight, mWidth-mFrameWidth*2, mHeight-mFrameHeight*2);
723 for f := 0 to High(mChildren) do mChildren[f].draw();
724 if (mFrameWidth <> 0) or (mFrameHeight <> 0) then resetScissor();
725 drawControlPost(x, y);
726 glScissor(scxywh[0], scxywh[1], scxywh[2], scxywh[3]);
728 if wassc then glEnable(GL_SCISSOR_TEST) else glDisable(GL_SCISSOR_TEST);
729 scallowed := false;
730 end;
733 procedure THControl.drawControl (sx, sy: Integer);
734 begin
735 if (mParent = nil) then darkenRect(sx, sy, mWidth, mHeight, 64);
736 end;
739 procedure THControl.drawControlPost (sx, sy: Integer);
740 begin
741 if mDrawShadow and (mWidth > 0) and (mHeight > 0) then
742 begin
743 setScissorGLInternal(sx+8, sy+8, mWidth, mHeight);
744 darkenRect(sx+mWidth, sy+8, 8, mHeight, 128);
745 darkenRect(sx+8, sy+mHeight, mWidth-8, 8, 128);
746 end;
747 end;
750 function THControl.mouseEvent (var ev: THMouseEvent): Boolean;
751 var
752 ctl: THControl;
753 begin
754 result := false;
755 if not mEnabled then exit;
756 if (mParent = nil) then
757 begin
758 if (mGrab <> nil) then
759 begin
760 result := mGrab.mouseEvent(ev);
761 if (ev.kind = ev.Release) then mGrab := nil;
762 exit;
763 end;
764 end;
765 if (mWidth < 1) or (mHeight < 1) then exit;
766 ctl := controlAtXY(ev.x, ev.y);
767 if (ctl <> nil) and (ctl <> self) then
768 begin
769 if (ctl <> topLevel.mFocused) then ctl.setFocused(true);
770 result := ctl.mouseEvent(ev);
771 end
772 else if (ctl = self) and assigned(actionCB) then
773 begin
774 actionCB(self, 0);
775 end;
776 end;
779 function THControl.keyEvent (var ev: THKeyEvent): Boolean;
780 var
781 ctl: THControl;
782 begin
783 result := false;
784 if not mEnabled then exit;
785 if (topLevel.mFocused <> self) and isMyChild(topLevel.mFocused) and topLevel.mFocused.mEnabled then result := topLevel.mFocused.keyEvent(ev);
786 if (mParent = nil) then
787 begin
788 if (ev.kind = ev.Press) and (ev = 'S-Tab') then
789 begin
790 result := true;
791 if (ev.kind = ev.Press) then
792 begin
793 ctl := findPrevFocus(mFocused);
794 if (ctl <> mFocused) then
795 begin
796 mGrab := nil;
797 mFocused := ctl;
798 end;
799 end;
800 exit;
801 end;
802 if (ev.kind = ev.Press) and (ev = 'Tab') then
803 begin
804 result := true;
805 if (ev.kind = ev.Press) then
806 begin
807 ctl := findNextFocus(mFocused);
808 if (ctl <> mFocused) then
809 begin
810 mGrab := nil;
811 mFocused := ctl;
812 end;
813 end;
814 exit;
815 end;
816 if mEscClose and (ev.kind = ev.Press) and (ev = 'Escape') then
817 begin
818 result := true;
819 uiRemoveWindow(self);
820 exit;
821 end;
822 end;
823 if mEatKeys then result := true;
824 end;
827 // ////////////////////////////////////////////////////////////////////////// //
828 constructor THTopWindow.Create (const atitle: AnsiString; ax, ay: Integer; aw: Integer=-1; ah: Integer=-1);
829 begin
830 inherited Create(ax, ay, aw, ah, nil);
831 mFrameWidth := 8;
832 mFrameHeight := 8;
833 mTitle := atitle;
834 if (mWidth < mFrameWidth*2+3*8) then mWidth := mFrameWidth*2+3*8;
835 if (mHeight < mFrameHeight*2) then mHeight := mFrameHeight*2;
836 if (Length(mTitle) > 0) then
837 begin
838 if (mWidth < Length(mTitle)*8+mFrameWidth*2+3*8) then mWidth := Length(mTitle)*8+mFrameWidth*2+3*8;
839 end;
840 mDragging := false;
841 mDrawShadow := true;
842 mWaitingClose := false;
843 mInClose := false;
844 closeCB := nil;
845 end;
848 procedure THTopWindow.centerInScreen ();
849 begin
850 if (mWidth > 0) and (mHeight > 0) then
851 begin
852 mX := (gWinSizeX-mWidth) div 2;
853 mY := (gWinSizeY-mHeight) div 2;
854 end;
855 end;
858 procedure THTopWindow.drawControl (sx, sy: Integer);
859 begin
860 fillRect(sx, sy, mWidth, mHeight, 0, 0, 128);
861 end;
864 procedure THTopWindow.drawControlPost (sx, sy: Integer);
865 const r = 255;
866 const g = 255;
867 const b = 255;
868 var
869 tx: Integer;
870 begin
871 if mDragging then
872 begin
873 drawRect(mX+4, mY+4, mWidth-8, mHeight-8, r, g, b);
874 end
875 else
876 begin
877 drawRect(mX+3, mY+3, mWidth-6, mHeight-6, r, g, b);
878 drawRect(mX+5, mY+5, mWidth-10, mHeight-10, r, g, b);
879 setScissor(mFrameWidth, 0, 3*8, 8);
880 fillRect(mX+mFrameWidth, mY, 3*8, 8, 0, 0, 128);
881 drawText8(mX+mFrameWidth, mY, '[ ]', r, g, b);
882 if mInClose then drawText8(mX+mFrameWidth+7, mY, '#', 0, 255, 0)
883 else drawText8(mX+mFrameWidth+7, mY, '*', 0, 255, 0);
884 end;
885 if (Length(mTitle) > 0) then
886 begin
887 setScissor(mFrameWidth+3*8, 0, mWidth-mFrameWidth*2-3*8, 8);
888 tx := (mX+3*8)+((mWidth-3*8)-Length(mTitle)*8) div 2;
889 fillRect(tx-3, mY, Length(mTitle)*8+3+2, 8, 0, 0, 128);
890 drawText8(tx, mY, mTitle, r, g, b);
891 end;
892 inherited drawControlPost(sx, sy);
893 end;
896 procedure THTopWindow.blurred ();
897 begin
898 mDragging := false;
899 mWaitingClose := false;
900 mInClose := false;
901 inherited;
902 end;
905 function THTopWindow.keyEvent (var ev: THKeyEvent): Boolean;
906 begin
907 result := inherited keyEvent(ev);
908 if not getFocused then exit;
909 if (ev.kind = ev.Press) and (ev = 'M-F3') then
910 begin
911 uiRemoveWindow(self);
912 result := true;
913 exit;
914 end;
915 end;
918 function THTopWindow.mouseEvent (var ev: THMouseEvent): Boolean;
919 var
920 lx, ly: Integer;
921 begin
922 result := false;
923 if not mEnabled then exit;
924 if (mWidth < 1) or (mHeight < 1) then exit;
926 if mDragging then
927 begin
928 mX += ev.x-mDragStartX;
929 mY += ev.y-mDragStartY;
930 mDragStartX := ev.x;
931 mDragStartY := ev.y;
932 if (ev.kind = ev.Release) then mDragging := false;
933 result := true;
934 exit;
935 end;
937 lx := ev.x;
938 ly := ev.y;
939 if toLocal(lx, ly) then
940 begin
941 if (ev.kind = ev.Press) then
942 begin
943 if (ly < 8) then
944 begin
945 if (lx >= mFrameWidth) and (lx < mFrameWidth+3*8) then
946 begin
947 //uiRemoveWindow(self);
948 mWaitingClose := true;
949 mInClose := true;
950 end
951 else
952 begin
953 mDragging := true;
954 mDragStartX := ev.x;
955 mDragStartY := ev.y;
956 end;
957 result := true;
958 exit;
959 end;
960 if (lx < mFrameWidth) or (lx >= mWidth-mFrameWidth) or (ly >= mHeight-mFrameHeight) then
961 begin
962 mDragging := true;
963 mDragStartX := ev.x;
964 mDragStartY := ev.y;
965 result := true;
966 exit;
967 end;
968 end;
970 if (ev.kind = ev.Release) then
971 begin
972 if mWaitingClose and (lx >= mFrameWidth) and (lx < mFrameWidth+3*8) then
973 begin
974 uiRemoveWindow(self);
975 result := true;
976 exit;
977 end;
978 mWaitingClose := false;
979 mInClose := false;
980 end;
982 if (ev.kind = ev.Motion) then
983 begin
984 if mWaitingClose then
985 begin
986 mInClose := (lx >= mFrameWidth) and (lx < mFrameWidth+3*8);
987 result := true;
988 exit;
989 end;
990 end;
991 end
992 else
993 begin
994 mInClose := false;
995 if (ev.kind <> ev.Motion) then mWaitingClose := false;
996 end;
998 result := inherited mouseEvent(ev);
999 end;
1002 // ////////////////////////////////////////////////////////////////////////// //
1003 constructor THCtlSimpleText.Create (ax, ay: Integer; aparent: THControl=nil);
1004 begin
1005 mItems := nil;
1006 inherited Create(ax, ay, 4, 4);
1007 end;
1010 destructor THCtlSimpleText.Destroy ();
1011 begin
1012 mItems := nil;
1013 inherited;
1014 end;
1017 procedure THCtlSimpleText.appendItem (const atext: AnsiString; acentered: Boolean=false; ahline: Boolean=false);
1018 var
1019 it: PItem;
1020 begin
1021 if (Length(atext)*8+3*8+2 > mWidth) then mWidth := Length(atext)*8+3*8+2;
1022 SetLength(mItems, Length(mItems)+1);
1023 it := @mItems[High(mItems)];
1024 it.title := atext;
1025 it.centered := acentered;
1026 it.hline := ahline;
1027 if (Length(mItems)*8 > mHeight) then mHeight := Length(mItems)*8;
1028 end;
1031 procedure THCtlSimpleText.drawControl (sx, sy: Integer);
1032 var
1033 f, tx: Integer;
1034 it: PItem;
1035 r, g, b: Integer;
1036 begin
1037 for f := 0 to High(mItems) do
1038 begin
1039 it := @mItems[f];
1040 tx := sx;
1041 r := 255;
1042 g := 255;
1043 b := 0;
1044 if it.centered then begin b := 255; tx := sx+(mWidth-Length(it.title)*8) div 2; end;
1045 if it.hline then
1046 begin
1047 b := 255;
1048 if (Length(it.title) = 0) then
1049 begin
1050 drawLine(sx+4, sy+3, sx+mWidth-8, sy+3, r, g, b);
1051 end
1052 else if (tx-3 > sx+4) then
1053 begin
1054 drawLine(sx+4, sy+3, tx-3, sy+3, r, g, b);
1055 drawLine(tx+Length(it.title)*8, sy+3, sx+mWidth-4, sy+3, r, g, b);
1056 end;
1057 end;
1058 drawText8(tx, sy, it.title, r, g, b);
1059 Inc(sy, 8);
1060 end;
1061 end;
1064 function THCtlSimpleText.mouseEvent (var ev: THMouseEvent): Boolean;
1065 var
1066 lx, ly: Integer;
1067 begin
1068 result := inherited mouseEvent(ev);
1069 lx := ev.x;
1070 ly := ev.y;
1071 if not result and toLocal(lx, ly) then
1072 begin
1073 result := true;
1074 end;
1075 end;
1078 function THCtlSimpleText.keyEvent (var ev: THKeyEvent): Boolean;
1079 begin
1080 result := inherited keyEvent(ev);
1081 end;
1084 // ////////////////////////////////////////////////////////////////////////// //
1085 constructor THCtlCBListBox.Create (ax, ay: Integer; aparent: THControl=nil);
1086 begin
1087 mItems := nil;
1088 mCurIndex := -1;
1089 inherited Create(ax, ay, 4, 4);
1090 end;
1093 destructor THCtlCBListBox.Destroy ();
1094 begin
1095 mItems := nil;
1096 inherited;
1097 end;
1100 procedure THCtlCBListBox.appendItem (const atext: AnsiString; bv: PBoolean; aaction: TActionCB=nil);
1101 var
1102 it: PItem;
1103 begin
1104 if (Length(atext)*8+3*8+2 > mWidth) then mWidth := Length(atext)*8+3*8+2;
1105 SetLength(mItems, Length(mItems)+1);
1106 it := @mItems[High(mItems)];
1107 it.title := atext;
1108 it.varp := bv;
1109 it.actionCB := aaction;
1110 if (Length(mItems)*8 > mHeight) then mHeight := Length(mItems)*8;
1111 if (mCurIndex < 0) then mCurIndex := 0;
1112 end;
1115 procedure THCtlCBListBox.drawControl (sx, sy: Integer);
1116 var
1117 f, tx: Integer;
1118 it: PItem;
1119 begin
1120 for f := 0 to High(mItems) do
1121 begin
1122 it := @mItems[f];
1123 if (mCurIndex = f) then fillRect(sx, sy, mWidth, 8, 0, 128, 0);
1124 if (it.varp <> nil) then
1125 begin
1126 if it.varp^ then drawText8(sx, sy, '[x]', 255, 255, 255) else drawText8(sx, sy, '[ ]', 255, 255, 255);
1127 drawText8(sx+3*8+2, sy, it.title, 255, 255, 0);
1128 end
1129 else if (Length(it.title) > 0) then
1130 begin
1131 tx := sx+(mWidth-Length(it.title)*8) div 2;
1132 if (tx-3 > sx+4) then
1133 begin
1134 drawLine(sx+4, sy+3, tx-3, sy+3, 255, 255, 255);
1135 drawLine(tx+Length(it.title)*8, sy+3, sx+mWidth-4, sy+3, 255, 255, 255);
1136 end;
1137 drawText8(tx, sy, it.title, 255, 255, 255);
1138 end
1139 else
1140 begin
1141 drawLine(sx+4, sy+3, sx+mWidth-8, sy+3, 255, 255, 255);
1142 end;
1143 Inc(sy, 8);
1144 end;
1145 end;
1148 function THCtlCBListBox.mouseEvent (var ev: THMouseEvent): Boolean;
1149 var
1150 lx, ly: Integer;
1151 it: PItem;
1152 begin
1153 result := inherited mouseEvent(ev);
1154 lx := ev.x;
1155 ly := ev.y;
1156 if not result and toLocal(lx, ly) then
1157 begin
1158 result := true;
1159 if (ev.kind = ev.Press) and (ev = 'lmb') then
1160 begin
1161 ly := ly div 8;
1162 if (ly >= 0) and (ly < Length(mItems)) then
1163 begin
1164 it := @mItems[ly];
1165 if (it.varp <> nil) then
1166 begin
1167 mCurIndex := ly;
1168 it.varp^ := not it.varp^;
1169 if assigned(it.actionCB) then it.actionCB(self, Integer(it.varp^));
1170 if assigned(actionCB) then actionCB(self, ly);
1171 end;
1172 end;
1173 end;
1174 end;
1175 end;
1178 function THCtlCBListBox.keyEvent (var ev: THKeyEvent): Boolean;
1179 var
1180 it: PItem;
1181 begin
1182 result := inherited keyEvent(ev);
1183 if not getFocused then exit;
1184 //result := true;
1185 if (ev.kind = ev.Press) then
1186 begin
1187 if (ev = 'Home') or (ev = 'PageUp') then
1188 begin
1189 result := true;
1190 mCurIndex := 0;
1191 end;
1192 if (ev = 'End') or (ev = 'PageDown') then
1193 begin
1194 result := true;
1195 mCurIndex := High(mItems);
1196 end;
1197 if (ev = 'Up') then
1198 begin
1199 result := true;
1200 if (Length(mItems) > 0) then
1201 begin
1202 if (mCurIndex < 0) then mCurIndex := Length(mItems);
1203 while (mCurIndex > 0) do
1204 begin
1205 Dec(mCurIndex);
1206 if (mItems[mCurIndex].varp <> nil) then break;
1207 end;
1208 end
1209 else
1210 begin
1211 mCurIndex := -1;
1212 end;
1213 end;
1214 if (ev = 'Down') then
1215 begin
1216 result := true;
1217 if (Length(mItems) > 0) then
1218 begin
1219 if (mCurIndex < 0) then mCurIndex := -1;
1220 while (mCurIndex < High(mItems)) do
1221 begin
1222 Inc(mCurIndex);
1223 if (mItems[mCurIndex].varp <> nil) then break;
1224 end;
1225 end
1226 else
1227 begin
1228 mCurIndex := -1;
1229 end;
1230 end;
1231 if (ev = 'Space') or (ev = 'Return') then
1232 begin
1233 result := true;
1234 if (mCurIndex >= 0) and (mCurIndex < Length(mItems)) and (mItems[mCurIndex].varp <> nil) then
1235 begin
1236 it := @mItems[mCurIndex];
1237 it.varp^ := not it.varp^;
1238 if assigned(it.actionCB) then it.actionCB(self, Integer(it.varp^));
1239 if assigned(actionCB) then actionCB(self, mCurIndex);
1240 end;
1241 end;
1242 end;
1243 end;