e903279ac3e0cd0360810387a76776dcad7de4db
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;
118 mWaitingClose: Boolean;
119 mInClose: Boolean;
121 protected
122 procedure blurred (); override;
124 public
125 constructor Create (const atitle: AnsiString; ax, ay: Integer; aw: Integer=-1; ah: Integer=-1);
127 // `sx` and `sy` are screen coordinates
128 procedure drawControl (sx, sy: Integer); override;
129 procedure drawControlPost (sx, sy: Integer); override;
131 function keyEvent (var ev: THKeyEvent): Boolean; override; // returns `true` if event was eaten
132 function mouseEvent (var ev: THMouseEvent): Boolean; override; // returns `true` if event was eaten
133 end;
136 THCtlCBListBox = class(THControl)
137 private
138 mItems: array of AnsiString;
139 mChecks: array of PBoolean;
140 mCurIndex: Integer;
142 public
143 constructor Create (ax, ay: Integer; aparent: THControl=nil);
144 destructor Destroy (); override;
146 procedure appendItem (const atext: AnsiString; bv: PBoolean);
148 procedure drawControl (sx, sy: Integer); override;
150 function mouseEvent (var ev: THMouseEvent): Boolean; override;
151 function keyEvent (var ev: THKeyEvent): Boolean; override;
152 end;
154 // ////////////////////////////////////////////////////////////////////////// //
155 var
156 uiTopList: array of THControl = nil;
159 function uiMouseEvent (var ev: THMouseEvent): Boolean;
160 var
161 f, c: Integer;
162 lx, ly: Integer;
163 ctmp: THControl;
164 begin
165 if (Length(uiTopList) = 0) then result := false else result := uiTopList[High(uiTopList)].mouseEvent(ev);
166 if not result and (ev.kind = ev.Press) then
167 begin
168 for f := High(uiTopList) downto 0 do
169 begin
170 lx := ev.x;
171 ly := ev.y;
172 if uiTopList[f].toLocal(lx, ly) then
173 begin
174 result := true;
175 if uiTopList[f].mEnabled and (f <> High(uiTopList)) then
176 begin
177 uiTopList[High(uiTopList)].blurred();
178 ctmp := uiTopList[f];
179 ctmp.mGrab := nil;
180 for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
181 uiTopList[High(uiTopList)] := ctmp;
182 ctmp.activated();
183 result := ctmp.mouseEvent(ev);
184 end;
185 exit;
186 end;
187 end;
188 end;
189 end;
192 function uiKeyEvent (var ev: THKeyEvent): Boolean;
193 begin
194 if (Length(uiTopList) = 0) then result := false else result := uiTopList[High(uiTopList)].keyEvent(ev);
195 if (ev.kind = ev.Release) then begin result := true; exit; end;
196 end;
199 procedure uiDraw ();
200 var
201 f: Integer;
202 ctl: THControl;
203 begin
204 for f := 0 to High(uiTopList) do
205 begin
206 ctl := uiTopList[f];
207 ctl.draw();
208 if (f <> High(uiTopList)) then darkenRect(ctl.x0, ctl.y0, ctl.width, ctl.height, 128);
209 end;
210 end;
213 procedure uiAddWindow (ctl: THControl);
214 var
215 f, c: Integer;
216 begin
217 if (ctl = nil) then exit;
218 ctl := ctl.topLevel;
219 for f := 0 to High(uiTopList) do
220 begin
221 if (uiTopList[f] = ctl) then
222 begin
223 if (f <> High(uiTopList)) then
224 begin
225 uiTopList[High(uiTopList)].blurred();
226 for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
227 uiTopList[High(uiTopList)] := ctl;
228 ctl.activated();
229 end;
230 exit;
231 end;
232 end;
233 if (Length(uiTopList) > 0) then uiTopList[High(uiTopList)].blurred();
234 SetLength(uiTopList, Length(uiTopList)+1);
235 uiTopList[High(uiTopList)] := ctl;
236 ctl.activated();
237 end;
240 // won't free object
241 procedure uiRemoveWindow (ctl: THControl);
242 var
243 f, c: Integer;
244 begin
245 if (ctl = nil) then exit;
246 ctl := ctl.topLevel;
247 for f := 0 to High(uiTopList) do
248 begin
249 if (uiTopList[f] = ctl) then
250 begin
251 ctl.blurred();
252 for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
253 SetLength(uiTopList, Length(uiTopList)-1);
254 exit;
255 end;
256 end;
257 end;
260 function uiVisibleWindow (ctl: THControl): Boolean;
261 var
262 f: Integer;
263 begin
264 result := false;
265 if (ctl = nil) then exit;
266 ctl := ctl.topLevel;
267 for f := 0 to High(uiTopList) do
268 begin
269 if (uiTopList[f] = ctl) then begin result := true; exit; end;
270 end;
271 end;
274 // ////////////////////////////////////////////////////////////////////////// //
275 constructor THControl.Create (ax, ay, aw, ah: Integer; aparent: THControl=nil);
276 begin
277 mParent := aparent;
278 mX := ax;
279 mY := ay;
280 mWidth := aw;
281 mHeight := ah;
282 mFrameWidth := 0;
283 mFrameHeight := 0;
284 mEnabled := true;
285 mCanFocus := true;
286 mChildren := nil;
287 mFocused := nil;
288 mGrab := nil;
289 mEscClose := false;
290 mEatKeys := false;
291 scallowed := false;
292 mDrawShadow := false;
293 end;
296 destructor THControl.Destroy ();
297 var
298 f, c: Integer;
299 begin
300 if (mParent <> nil) then
301 begin
302 setFocused(false);
303 for f := 0 to High(mParent.mChildren) do
304 begin
305 if (mParent.mChildren[f] = self) then
306 begin
307 for c := f+1 to High(mParent.mChildren) do mParent.mChildren[c-1] := mParent.mChildren[c];
308 SetLength(mParent.mChildren, Length(mParent.mChildren)-1);
309 end;
310 end;
311 end;
312 for f := 0 to High(mChildren) do
313 begin
314 mChildren[f].mParent := nil;
315 mChildren[f].Free();
316 end;
317 mChildren := nil;
318 end;
321 procedure THControl.activated ();
322 begin
323 end;
326 procedure THControl.blurred ();
327 begin
328 mGrab := nil;
329 end;
332 function THControl.topLevel (): THControl; inline;
333 begin
334 result := self;
335 while (result.mParent <> nil) do result := result.mParent;
336 end;
339 function THControl.getEnabled (): Boolean;
340 var
341 ctl: THControl;
342 begin
343 result := false;
344 if (not mEnabled) or (mWidth < 1) or (mHeight < 1) then exit;
345 ctl := mParent;
346 while (ctl <> nil) do
347 begin
348 if (not ctl.mEnabled) or (ctl.mWidth < 1) or (ctl.mHeight < 1) then exit;
349 ctl := ctl.mParent;
350 end;
351 result := true;
352 end;
355 procedure THControl.setEnabled (v: Boolean); inline;
356 begin
357 if (mEnabled = v) then exit;
358 mEnabled := v;
359 if not v and focused then setFocused(false);
360 end;
363 function THControl.getFocused (): Boolean; inline;
364 begin
365 if (mParent = nil) then result := (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)] = self) else result := (topLevel.mFocused = self);
366 end;
369 procedure THControl.setFocused (v: Boolean); inline;
370 var
371 tl: THControl;
372 begin
373 tl := topLevel;
374 if not v then
375 begin
376 if (tl.mFocused = self) then
377 begin
378 tl.blurred();
379 tl.mFocused := tl.findNextFocus(self);
380 if (tl.mFocused = self) then tl.mFocused := nil;
381 end;
382 exit;
383 end;
384 if (not mEnabled) or (not mCanFocus) then exit;
385 if (tl.mFocused <> self) then
386 begin
387 tl.mFocused.blurred();
388 tl.mFocused := self;
389 if (tl.mGrab <> self) then tl.mGrab := nil;
390 activated();
391 end;
392 end;
395 function THControl.isMyChild (ctl: THControl): Boolean;
396 begin
397 result := true;
398 while (ctl <> nil) do
399 begin
400 if (ctl.mParent = self) then exit;
401 ctl := ctl.mParent;
402 end;
403 result := false;
404 end;
407 // returns `true` if global coords are inside this control
408 function THControl.toLocal (var x, y: Integer): Boolean;
409 var
410 ctl: THControl;
411 begin
412 ctl := self;
413 while (ctl <> nil) do
414 begin
415 Dec(x, ctl.mX);
416 Dec(y, ctl.mY);
417 ctl := ctl.mParent;
418 end;
419 result := (x >= 0) and (y >= 0) and (x < mWidth) and (y < mHeight);
420 end;
423 procedure THControl.toGlobal (var x, y: Integer);
424 var
425 ctl: THControl;
426 begin
427 ctl := self;
428 while (ctl <> nil) do
429 begin
430 Inc(x, ctl.mX);
431 Inc(y, ctl.mY);
432 ctl := ctl.mParent;
433 end;
434 end;
437 // x and y are global coords
438 function THControl.controlAtXY (x, y: Integer): THControl;
439 var
440 lx, ly: Integer;
441 f: Integer;
442 begin
443 result := nil;
444 if (not mEnabled) or (mWidth < 1) or (mHeight < 1) then exit;
445 lx := x;
446 ly := y;
447 if not toLocal(lx, ly) then exit;
448 for f := High(mChildren) downto 0 do
449 begin
450 result := mChildren[f].controlAtXY(x, y);
451 if (result <> nil) then exit;
452 end;
453 result := self;
454 end;
457 function THControl.prevSibling (): THControl;
458 var
459 f: Integer;
460 begin
461 if (mParent <> nil) then
462 begin
463 for f := 1 to High(mParent.mChildren) do
464 begin
465 if (mParent.mChildren[f] = self) then begin result := mParent.mChildren[f-1]; exit; end;
466 end;
467 end;
468 result := nil;
469 end;
471 function THControl.nextSibling (): THControl;
472 var
473 f: Integer;
474 begin
475 if (mParent <> nil) then
476 begin
477 for f := 0 to High(mParent.mChildren)-1 do
478 begin
479 if (mParent.mChildren[f] = self) then begin result := mParent.mChildren[f+1]; exit; end;
480 end;
481 end;
482 result := nil;
483 end;
485 function THControl.firstChild (): THControl; inline;
486 begin
487 if (Length(mChildren) <> 0) then result := mChildren[0] else result := nil;
488 end;
490 function THControl.lastChild (): THControl; inline;
491 begin
492 if (Length(mChildren) <> 0) then result := mChildren[High(mChildren)] else result := nil;
493 end;
496 function THControl.findFirstFocus (): THControl;
497 var
498 f: Integer;
499 begin
500 result := nil;
501 if enabled then
502 begin
503 for f := 0 to High(mChildren) do
504 begin
505 result := mChildren[f].findFirstFocus();
506 if (result <> nil) then exit;
507 end;
508 if mCanFocus then result := self;
509 end;
510 end;
513 function THControl.findLastFocus (): THControl;
514 var
515 f: Integer;
516 begin
517 result := nil;
518 if enabled then
519 begin
520 for f := High(mChildren) downto 0 do
521 begin
522 result := mChildren[f].findLastFocus();
523 if (result <> nil) then exit;
524 end;
525 if mCanFocus then result := self;
526 end;
527 end;
530 function THControl.findNextFocus (cur: THControl): THControl;
531 begin
532 result := nil;
533 if enabled then
534 begin
535 if not isMyChild(cur) then cur := nil;
536 if (cur = nil) then begin result := findFirstFocus(); exit; end;
537 result := cur.findFirstFocus();
538 if (result <> nil) and (result <> cur) then exit;
539 while true do
540 begin
541 cur := cur.nextSibling;
542 if (cur = nil) then break;
543 result := cur.findFirstFocus();
544 if (result <> nil) then exit;
545 end;
546 result := findFirstFocus();
547 end;
548 end;
551 function THControl.findPrevFocus (cur: THControl): THControl;
552 begin
553 result := nil;
554 if enabled then
555 begin
556 if not isMyChild(cur) then cur := nil;
557 if (cur = nil) then begin result := findLastFocus(); exit; end;
558 //FIXME!
559 result := cur.findLastFocus();
560 if (result <> nil) and (result <> cur) then exit;
561 while true do
562 begin
563 cur := cur.prevSibling;
564 if (cur = nil) then break;
565 result := cur.findLastFocus();
566 if (result <> nil) then exit;
567 end;
568 result := findLastFocus();
569 end;
570 end;
573 procedure THControl.appendChild (ctl: THControl);
574 begin
575 if (ctl = nil) then exit;
576 if (ctl.mParent <> nil) then exit;
577 SetLength(mChildren, Length(mChildren)+1);
578 mChildren[High(mChildren)] := ctl;
579 ctl.mParent := self;
580 Inc(ctl.mX, mFrameWidth);
581 Inc(ctl.mY, mFrameHeight);
582 if (ctl.mWidth > 0) and (ctl.mHeight > 0) and
583 (ctl.mX+ctl.mWidth > mFrameWidth) and (ctl.mY+ctl.mHeight > mFrameHeight) then
584 begin
585 if (mWidth+mFrameWidth < ctl.mX+ctl.mWidth) then mWidth := ctl.mX+ctl.mWidth+mFrameWidth;
586 if (mHeight+mFrameHeight < ctl.mY+ctl.mHeight) then mHeight := ctl.mY+ctl.mHeight+mFrameHeight;
587 end;
588 if (mFocused = nil) and ctl.mEnabled and ctl.mCanFocus and (ctl.mWidth > 0) and (ctl.mHeight > 0) then mFocused := ctl;
589 end;
592 //TODO: overflow checks
593 class function THControl.intersectRect (var x0, y0, w0, h0: Integer; const x1, y1, w1, h1: Integer): Boolean;
594 var
595 ex0, ey0: Integer;
596 begin
597 result := false;
598 if (w0 < 1) or (h0 < 1) or (w1 < 1) or (h1 < 1) then exit;
599 // check for intersection
600 if (x0+w0 <= x1) or (y0+h0 <= y1) or (x1+w1 <= x0) or (y1+h1 <= y0) then exit;
601 if (x0 >= x1+w1) or (y0 >= y1+h1) or (x1 >= x0+h0) or (y1 >= y0+h0) then exit;
602 // ok, intersects
603 ex0 := x0+w0;
604 ey0 := y0+h0;
605 if (x0 < x1) then x0 := x1;
606 if (y0 < y1) then y0 := y1;
607 if (ex0 > x1+w1) then ex0 := x1+w1;
608 if (ey0 > y1+h1) then ey0 := y1+h1;
609 w0 := ex0-x0;
610 h0 := ey0-y0;
611 result := (w0 > 0) and (h0 > 0);
612 end;
615 procedure THControl.setScissorGLInternal (x, y, w, h: Integer);
616 begin
617 if not scallowed then exit;
618 y := gWinSizeY-(y+h);
619 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);
620 end;
623 procedure THControl.resetScissor ();
624 var
625 x, y: Integer;
626 begin
627 if not scallowed then exit;
628 x := 0;
629 y := 0;
630 toGlobal(x, y);
631 setScissorGLInternal(x, y, mWidth, mHeight);
632 end;
635 procedure THControl.setScissor (lx, ly, lw, lh: Integer);
636 var
637 x, y: Integer;
638 begin
639 if not scallowed then exit;
640 if not intersectRect(lx, ly, lw, lh, 0, 0, mWidth, mHeight) then begin glScissor(0, 0, 0, 0); exit; end;
641 x := lx;
642 y := ly;
643 toGlobal(x, y);
644 setScissorGLInternal(x, y, lw, lh);
645 end;
648 procedure THControl.draw ();
649 var
650 f: Integer;
651 x, y: Integer;
652 wassc: Boolean;
653 begin
654 if (mWidth < 1) or (mHeight < 1) then exit;
655 x := 0;
656 y := 0;
657 toGlobal(x, y);
658 //conwritefln('[%s]: (%d,%d)-(%d,%d) (%d,%d)', [ClassName, mX, mY, mWidth, mHeight, x, y]);
660 scxywh[0] := 0;
661 scxywh[1] := 0;
662 scxywh[2] := 0;
663 scxywh[3] := 0;
665 wassc := (glIsEnabled(GL_SCISSOR_TEST) <> 0);
666 if wassc then glGetIntegerv(GL_SCISSOR_BOX, @scxywh[0]) else glGetIntegerv(GL_VIEWPORT, @scxywh[0]);
667 //conwritefln('(%d,%d)-(%d,%d)', [scxywh[0], scxywh[1], scxywh[2], scxywh[3]]);
668 glEnable(GL_SCISSOR_TEST);
669 scallowed := true;
671 resetScissor();
672 drawControl(x, y);
673 if (mFrameWidth <> 0) or (mFrameHeight <> 0) then setScissor(mFrameWidth, mFrameHeight, mWidth-mFrameWidth*2, mHeight-mFrameHeight*2);
674 for f := 0 to High(mChildren) do mChildren[f].draw();
675 if (mFrameWidth <> 0) or (mFrameHeight <> 0) then resetScissor();
676 drawControlPost(x, y);
677 glScissor(scxywh[0], scxywh[1], scxywh[2], scxywh[3]);
679 if wassc then glEnable(GL_SCISSOR_TEST) else glDisable(GL_SCISSOR_TEST);
680 scallowed := false;
681 end;
684 procedure THControl.drawControl (sx, sy: Integer);
685 begin
686 if (mParent = nil) then darkenRect(sx, sy, mWidth, mHeight, 64);
687 end;
690 procedure THControl.drawControlPost (sx, sy: Integer);
691 begin
692 if mDrawShadow and (mWidth > 0) and (mHeight > 0) then
693 begin
694 setScissorGLInternal(sx+8, sy+8, mWidth, mHeight);
695 darkenRect(sx+mWidth, sy+8, 8, mHeight, 128);
696 darkenRect(sx+8, sy+mHeight, mWidth-8, 8, 128);
697 end;
698 end;
701 function THControl.mouseEvent (var ev: THMouseEvent): Boolean;
702 var
703 ctl: THControl;
704 begin
705 result := false;
706 if not mEnabled then exit;
707 if (mParent = nil) then
708 begin
709 if (mGrab <> nil) then
710 begin
711 result := mGrab.mouseEvent(ev);
712 if (ev.kind = ev.Release) then mGrab := nil;
713 exit;
714 end;
715 end;
716 if (mWidth < 1) or (mHeight < 1) then exit;
717 ctl := controlAtXY(ev.x, ev.y);
718 if (ctl <> nil) and (ctl <> self) then
719 begin
720 if (ctl <> topLevel.mFocused) then ctl.setFocused(true);
721 result := ctl.mouseEvent(ev);
722 end;
723 end;
726 function THControl.keyEvent (var ev: THKeyEvent): Boolean;
727 var
728 ctl: THControl;
729 begin
730 result := false;
731 if not mEnabled then exit;
732 if (topLevel.mFocused <> self) and isMyChild(topLevel.mFocused) and topLevel.mFocused.mEnabled then result := topLevel.mFocused.keyEvent(ev);
733 if (mParent = nil) then
734 begin
735 if (ev.kstate = THKeyEvent.ModShift) and (ev.scan = SDL_SCANCODE_TAB) then
736 begin
737 result := true;
738 if (ev.kind = ev.Press) then
739 begin
740 ctl := findPrevFocus(mFocused);
741 if (ctl <> mFocused) then
742 begin
743 mGrab := nil;
744 mFocused := ctl;
745 end;
746 end;
747 exit;
748 end;
749 if (ev.kstate = 0) and (ev.scan = SDL_SCANCODE_TAB) then
750 begin
751 result := true;
752 if (ev.kind = ev.Press) then
753 begin
754 ctl := findNextFocus(mFocused);
755 if (ctl <> mFocused) then
756 begin
757 mGrab := nil;
758 mFocused := ctl;
759 end;
760 end;
761 exit;
762 end;
763 if mEscClose and (ev.kind = ev.Press) and (ev.kstate = 0) and (ev.scan = SDL_SCANCODE_ESCAPE) then
764 begin
765 result := true;
766 uiRemoveWindow(self);
767 exit;
768 end;
769 end;
770 if mEatKeys then result := true;
771 end;
774 // ////////////////////////////////////////////////////////////////////////// //
775 constructor THTopWindow.Create (const atitle: AnsiString; ax, ay: Integer; aw: Integer=-1; ah: Integer=-1);
776 begin
777 inherited Create(ax, ay, aw, ah, nil);
778 mFrameWidth := 8;
779 mFrameHeight := 8;
780 mTitle := atitle;
781 if (mWidth < mFrameWidth*2+3*8) then mWidth := mFrameWidth*2+3*8;
782 if (mHeight < mFrameHeight*2) then mHeight := mFrameHeight*2;
783 if (Length(mTitle) > 0) then
784 begin
785 if (mWidth < Length(mTitle)*8+mFrameWidth*2+3*8) then mWidth := Length(mTitle)*8+mFrameWidth*2+3*8;
786 end;
787 mDragging := false;
788 mDrawShadow := true;
789 mWaitingClose := false;
790 mInClose := false;
791 end;
794 procedure THTopWindow.drawControl (sx, sy: Integer);
795 begin
796 fillRect(sx, sy, mWidth, mHeight, 0, 0, 128);
797 end;
800 procedure THTopWindow.drawControlPost (sx, sy: Integer);
801 const r = 255;
802 const g = 255;
803 const b = 255;
804 var
805 tx: Integer;
806 begin
807 if mDragging then
808 begin
809 drawRect(mX+4, mY+4, mWidth-8, mHeight-8, r, g, b);
810 end
811 else
812 begin
813 drawRect(mX+3, mY+3, mWidth-6, mHeight-6, r, g, b);
814 drawRect(mX+5, mY+5, mWidth-10, mHeight-10, r, g, b);
815 setScissor(mFrameWidth, 0, 3*8, 8);
816 fillRect(mX+mFrameWidth, mY, 3*8, 8, 0, 0, 128);
817 drawText8(mX+mFrameWidth, mY, '[ ]', r, g, b);
818 if mInClose then drawText8(mX+mFrameWidth+7, mY, '#', 0, 255, 0)
819 else drawText8(mX+mFrameWidth+7, mY, '*', 0, 255, 0);
820 end;
821 if (Length(mTitle) > 0) then
822 begin
823 setScissor(mFrameWidth+3*8, 0, mWidth-mFrameWidth*2-3*8, 8);
824 tx := mX+(mWidth-Length(mTitle)*8) div 2;
825 fillRect(tx-3, mY, Length(mTitle)*8+3+2, 8, 0, 0, 128);
826 drawText8(tx, mY, mTitle, r, g, b);
827 end;
828 inherited drawControlPost(sx, sy);
829 end;
832 procedure THTopWindow.blurred ();
833 begin
834 mDragging := false;
835 mWaitingClose := false;
836 mInClose := false;
837 inherited;
838 end;
841 function THTopWindow.keyEvent (var ev: THKeyEvent): Boolean;
842 begin
843 result := inherited keyEvent(ev);
844 if not getFocused then exit;
845 if (ev.kstate = ev.ModAlt) and (ev.kind = ev.Press) and (ev.scan = SDL_SCANCODE_F3) then
846 begin
847 uiRemoveWindow(self);
848 result := true;
849 exit;
850 end;
851 end;
854 function THTopWindow.mouseEvent (var ev: THMouseEvent): Boolean;
855 var
856 lx, ly: Integer;
857 begin
858 result := false;
859 if not mEnabled then exit;
860 if (mWidth < 1) or (mHeight < 1) then exit;
862 if mDragging then
863 begin
864 mX += ev.x-mDragStartX;
865 mY += ev.y-mDragStartY;
866 mDragStartX := ev.x;
867 mDragStartY := ev.y;
868 if (ev.kind = ev.Release) then mDragging := false;
869 result := true;
870 exit;
871 end;
873 lx := ev.x;
874 ly := ev.y;
875 if toLocal(lx, ly) then
876 begin
877 if (ev.kind = ev.Press) then
878 begin
879 if (ly < 8) then
880 begin
881 if (lx >= mFrameWidth) and (lx < mFrameWidth+3*8) then
882 begin
883 //uiRemoveWindow(self);
884 mWaitingClose := true;
885 mInClose := true;
886 end
887 else
888 begin
889 mDragging := true;
890 mDragStartX := ev.x;
891 mDragStartY := ev.y;
892 end;
893 result := true;
894 exit;
895 end;
896 if (lx < mFrameWidth) or (lx >= mWidth-mFrameWidth) or (ly >= mHeight-mFrameHeight) then
897 begin
898 mDragging := true;
899 mDragStartX := ev.x;
900 mDragStartY := ev.y;
901 result := true;
902 exit;
903 end;
904 end;
906 if (ev.kind = ev.Release) then
907 begin
908 if mWaitingClose and (lx >= mFrameWidth) and (lx < mFrameWidth+3*8) then
909 begin
910 uiRemoveWindow(self);
911 result := true;
912 exit;
913 end;
914 mWaitingClose := false;
915 mInClose := false;
916 end;
918 if (ev.kind = ev.Motion) then
919 begin
920 if mWaitingClose then
921 begin
922 mInClose := (lx >= mFrameWidth) and (lx < mFrameWidth+3*8);
923 result := true;
924 exit;
925 end;
926 end;
927 end
928 else
929 begin
930 mInClose := false;
931 if (ev.kind <> ev.Motion) then mWaitingClose := false;
932 end;
934 result := inherited mouseEvent(ev);
935 end;
938 // ////////////////////////////////////////////////////////////////////////// //
939 constructor THCtlCBListBox.Create (ax, ay: Integer; aparent: THControl=nil);
940 begin
941 mItems := nil;
942 mChecks := nil;
943 mCurIndex := -1;
944 inherited Create(ax, ay, 4, 4);
945 end;
948 destructor THCtlCBListBox.Destroy ();
949 begin
950 mItems := nil;
951 mChecks := nil;
952 inherited;
953 end;
956 procedure THCtlCBListBox.appendItem (const atext: AnsiString; bv: PBoolean);
957 begin
958 if (Length(atext)*8+4+3*8+2 > mWidth) then mWidth := Length(atext)*8+4+3*8+2;
959 SetLength(mItems, Length(mItems)+1);
960 mItems[High(mItems)] := atext;
961 SetLength(mChecks, Length(mChecks)+1);
962 mChecks[High(mChecks)] := bv;
963 if (Length(mItems)*8+4 > mHeight) then mHeight := Length(mItems)*8+4;
964 if (mCurIndex < 0) then mCurIndex := 0;
965 end;
968 procedure THCtlCBListBox.drawControl (sx, sy: Integer);
969 var
970 f, tx: Integer;
971 begin
972 //fillRect(sx, sy, mWidth, mHeight, 0, 128, 0);
973 Inc(sx, 2);
974 Inc(sy, 2);
975 for f := 0 to High(mItems) do
976 begin
977 if (mCurIndex = f) then fillRect(sx-2, sy, mWidth, 8, 0, 128, 0);
978 if (mChecks[f] <> nil) then
979 begin
980 //drawText8(sx, sy, '[ ]', 255, 255, 255);
981 //if mChecks[f]^ then drawText8(sx+6, sy, 'x', 255, 255, 255);
982 if mChecks[f]^ then drawText8(sx, sy, '[x]', 255, 255, 255) else drawText8(sx, sy, '[ ]', 255, 255, 255);
983 drawText8(sx+3*8+2, sy, mItems[f], 255, 255, 0);
984 end
985 else if (Length(mItems[f]) > 0) then
986 begin
987 tx := sx+(mWidth-Length(mItems[f])*8) div 2;
988 if (tx-3 > sx+4) then
989 begin
990 drawLine(sx+4, sy+3, tx-3, sy+3, 255, 255, 255);
991 drawLine(tx+Length(mItems[f])*8, sy+3, sx+mWidth-4, sy+3, 255, 255, 255);
992 end;
993 drawText8(sx+(mWidth-Length(mItems[f])*8) div 2, sy, mItems[f], 255, 255, 255);
994 end
995 else
996 begin
997 drawLine(sx+4, sy+3, sx+mWidth-8, sy+3, 255, 255, 255);
998 end;
999 Inc(sy, 8);
1000 end;
1001 end;
1004 function THCtlCBListBox.mouseEvent (var ev: THMouseEvent): Boolean;
1005 var
1006 lx, ly: Integer;
1007 begin
1008 result := inherited mouseEvent(ev);
1009 if not result and (Length(mItems) > 0) and (ev.kind = ev.Press) then
1010 begin
1011 lx := ev.x;
1012 ly := ev.y;
1013 if toLocal(lx, ly) then
1014 begin
1015 if (ly < 2) then ly := 2;
1016 ly := ly div 8;
1017 if (ly < 0) then ly := 0 else if (ly > High(mItems)) then ly := High(mItems);
1018 if (mChecks[ly] <> nil) then
1019 begin
1020 mCurIndex := ly;
1021 if (mChecks[ly] <> nil) then mChecks[ly]^ := not mChecks[ly]^;
1022 end;
1023 end;
1024 end;
1025 end;
1028 function THCtlCBListBox.keyEvent (var ev: THKeyEvent): Boolean;
1029 begin
1030 result := inherited keyEvent(ev);
1031 if not getFocused then exit;
1032 //result := true;
1033 if (ev.kstate = 0) and (ev.kind = ev.Press) then
1034 begin
1035 case ev.scan of
1036 SDL_SCANCODE_HOME,
1037 SDL_SCANCODE_PAGEUP:
1038 begin
1039 result := true;
1040 mCurIndex := 0;
1041 end;
1042 SDL_SCANCODE_END,
1043 SDL_SCANCODE_PAGEDOWN:
1044 begin
1045 result := true;
1046 mCurIndex := High(mItems);
1047 end;
1048 SDL_SCANCODE_UP:
1049 begin
1050 result := true;
1051 if (Length(mItems) > 0) then
1052 begin
1053 if (mCurIndex < 0) then mCurIndex := Length(mItems);
1054 while (mCurIndex > 0) do
1055 begin
1056 Dec(mCurIndex);
1057 if (mChecks[mCurIndex] <> nil) then break;
1058 end;
1059 end
1060 else
1061 begin
1062 mCurIndex := -1;
1063 end;
1064 end;
1065 SDL_SCANCODE_DOWN:
1066 begin
1067 result := true;
1068 if (Length(mItems) > 0) then
1069 begin
1070 if (mCurIndex < 0) then mCurIndex := -1;
1071 while (mCurIndex < High(mItems)) do
1072 begin
1073 Inc(mCurIndex);
1074 if (mChecks[mCurIndex] <> nil) then break;
1075 end;
1076 end
1077 else
1078 begin
1079 mCurIndex := -1;
1080 end;
1081 end;
1082 SDL_SCANCODE_SPACE,
1083 SDL_SCANCODE_RETURN:
1084 begin
1085 result := true;
1086 if (mCurIndex >= 0) and (mCurIndex < Length(mChecks)) and (mChecks[mCurIndex] <> nil) then mChecks[mCurIndex]^ := not mChecks[mCurIndex]^;
1087 end;
1088 end;
1089 end;
1090 end;