3f26b360c8e770e30c6592c38f0e0c64780d6543
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 mEnabled: Boolean;
24 mCanFocus: Boolean;
25 mChildren: array of THControl;
26 mFocused: THControl; // valid only for top-level controls
27 mGrab: THControl; // valid only for top-level controls
28 mEscClose: Boolean; // valid only for top-level controls
29 mEatKeys: Boolean;
31 protected
32 function getEnabled (): Boolean;
33 procedure setEnabled (v: Boolean); inline;
35 function getFocused (): Boolean; inline;
36 procedure setFocused (v: Boolean); inline;
38 function isMyChild (ctl: THControl): Boolean;
40 function findFirstFocus (): THControl;
41 function findLastFocus (): THControl;
43 function findNextFocus (cur: THControl): THControl;
44 function findPrevFocus (cur: THControl): THControl;
46 procedure activated (); virtual;
47 procedure blurred (); virtual;
49 public
50 constructor Create (ax, ay, aw, ah: Integer; aparent: THControl=nil);
51 destructor Destroy (); override;
53 // `sx` and `sy` are screen coordinates
54 procedure drawControl (sx, sy: Integer); virtual;
56 // called after all children drawn
57 procedure drawControlPost (sx, sy: Integer); virtual;
59 procedure draw (); virtual;
61 function topLevel (): THControl; inline;
63 // returns `true` if global coords are inside this control
64 function toLocal (var x, y: Integer): Boolean;
65 procedure toGlobal (var x, y: Integer);
67 // x and y are global coords
68 function controlAtXY (x, y: Integer): THControl;
70 function mouseEvent (var ev: THMouseEvent): Boolean; virtual; // returns `true` if event was eaten
71 function keyEvent (var ev: THKeyEvent): Boolean; virtual; // returns `true` if event was eaten
73 function prevSibling (): THControl;
74 function nextSibling (): THControl;
75 function firstChild (): THControl; inline;
76 function lastChild (): THControl; inline;
78 public
79 property x0: Integer read mX;
80 property y0: Integer read mY;
81 property height: Integer read mHeight;
82 property width: Integer read mWidth;
83 property enabled: Boolean read getEnabled write setEnabled;
84 property parent: THControl read mParent;
85 property focused: Boolean read getFocused write setFocused;
86 property escClose: Boolean read mEscClose write mEscClose;
87 property eatKeys: Boolean read mEatKeys write mEatKeys;
88 end;
91 THTopWindow = class(THControl)
92 private
93 mTitle: AnsiString;
94 mDragging: Boolean;
95 mDragStartX, mDragStartY: Integer;
97 protected
98 procedure blurred (); override;
100 public
101 constructor Create (const atitle: AnsiString; ax, ay: Integer; aw: Integer=-1; ah: Integer=-1);
103 procedure appendChild (ctl: THControl);
105 // `sx` and `sy` are screen coordinates
106 procedure drawControl (sx, sy: Integer); override;
107 procedure drawControlPost (sx, sy: Integer); override;
109 function mouseEvent (var ev: THMouseEvent): Boolean; override; // returns `true` if event was eaten
110 end;
113 THCtlCBListBox = class(THControl)
114 private
115 mItems: array of AnsiString;
116 mChecks: array of PBoolean;
117 mCurIndex: Integer;
119 public
120 constructor Create (ax, ay: Integer; aparent: THControl=nil);
121 destructor Destroy (); override;
123 procedure appendItem (const atext: AnsiString; bv: PBoolean);
125 procedure drawControl (sx, sy: Integer); override;
127 function mouseEvent (var ev: THMouseEvent): Boolean; override;
128 function keyEvent (var ev: THKeyEvent): Boolean; override;
129 end;
131 // ////////////////////////////////////////////////////////////////////////// //
132 var
133 uiTopList: array of THControl = nil;
136 function uiMouseEvent (var ev: THMouseEvent): Boolean;
137 var
138 f, c: Integer;
139 lx, ly: Integer;
140 ctmp: THControl;
141 begin
142 if (Length(uiTopList) = 0) then result := false else result := uiTopList[High(uiTopList)].mouseEvent(ev);
143 if not result and (ev.kind = ev.Press) then
144 begin
145 for f := High(uiTopList) downto 0 do
146 begin
147 lx := ev.x;
148 ly := ev.y;
149 if uiTopList[f].toLocal(lx, ly) then
150 begin
151 result := true;
152 if uiTopList[f].mEnabled and (f <> High(uiTopList)) then
153 begin
154 uiTopList[High(uiTopList)].blurred();
155 ctmp := uiTopList[f];
156 ctmp.mGrab := nil;
157 for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
158 uiTopList[High(uiTopList)] := ctmp;
159 ctmp.activated();
160 result := ctmp.mouseEvent(ev);
161 end;
162 exit;
163 end;
164 end;
165 end;
166 end;
169 function uiKeyEvent (var ev: THKeyEvent): Boolean;
170 begin
171 if (Length(uiTopList) = 0) then result := false else result := uiTopList[High(uiTopList)].keyEvent(ev);
172 if (ev.kind = ev.Release) then begin result := true; exit; end;
173 end;
176 procedure uiDraw ();
177 var
178 f: Integer;
179 begin
180 for f := 0 to High(uiTopList) do uiTopList[f].draw();
181 end;
184 procedure uiAddWindow (ctl: THControl);
185 var
186 f, c: Integer;
187 begin
188 if (ctl = nil) then exit;
189 ctl := ctl.topLevel;
190 for f := 0 to High(uiTopList) do
191 begin
192 if (uiTopList[f] = ctl) then
193 begin
194 if (f <> High(uiTopList)) then
195 begin
196 uiTopList[High(uiTopList)].blurred();
197 for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
198 uiTopList[High(uiTopList)] := ctl;
199 ctl.activated();
200 end;
201 exit;
202 end;
203 end;
204 if (Length(uiTopList) > 0) then uiTopList[High(uiTopList)].blurred();
205 SetLength(uiTopList, Length(uiTopList)+1);
206 uiTopList[High(uiTopList)] := ctl;
207 ctl.activated();
208 end;
211 // won't free object
212 procedure uiRemoveWindow (ctl: THControl);
213 var
214 f, c: Integer;
215 begin
216 if (ctl = nil) then exit;
217 ctl := ctl.topLevel;
218 for f := 0 to High(uiTopList) do
219 begin
220 if (uiTopList[f] = ctl) then
221 begin
222 ctl.blurred();
223 for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
224 SetLength(uiTopList, Length(uiTopList)-1);
225 exit;
226 end;
227 end;
228 end;
231 function uiVisibleWindow (ctl: THControl): Boolean;
232 var
233 f: Integer;
234 begin
235 result := false;
236 if (ctl = nil) then exit;
237 ctl := ctl.topLevel;
238 for f := 0 to High(uiTopList) do
239 begin
240 if (uiTopList[f] = ctl) then begin result := true; exit; end;
241 end;
242 end;
245 // ////////////////////////////////////////////////////////////////////////// //
246 constructor THControl.Create (ax, ay, aw, ah: Integer; aparent: THControl=nil);
247 begin
248 mParent := aparent;
249 mX := ax;
250 mY := ay;
251 mWidth := aw;
252 mHeight := ah;
253 mEnabled := true;
254 mCanFocus := true;
255 mChildren := nil;
256 mFocused := nil;
257 mGrab := nil;
258 mEscClose := false;
259 mEatKeys := false;
260 end;
263 destructor THControl.Destroy ();
264 var
265 f, c: Integer;
266 begin
267 if (mParent <> nil) then
268 begin
269 setFocused(false);
270 for f := 0 to High(mParent.mChildren) do
271 begin
272 if (mParent.mChildren[f] = self) then
273 begin
274 for c := f+1 to High(mParent.mChildren) do mParent.mChildren[c-1] := mParent.mChildren[c];
275 SetLength(mParent.mChildren, Length(mParent.mChildren)-1);
276 end;
277 end;
278 end;
279 for f := 0 to High(mChildren) do
280 begin
281 mChildren[f].mParent := nil;
282 mChildren[f].Free();
283 end;
284 mChildren := nil;
285 end;
288 procedure THControl.activated ();
289 begin
290 end;
293 procedure THControl.blurred ();
294 begin
295 mGrab := nil;
296 end;
299 function THControl.topLevel (): THControl; inline;
300 begin
301 result := self;
302 while (result.mParent <> nil) do result := result.mParent;
303 end;
306 function THControl.getEnabled (): Boolean;
307 var
308 ctl: THControl;
309 begin
310 result := false;
311 if (not mEnabled) or (mWidth < 1) or (mHeight < 1) then exit;
312 ctl := mParent;
313 while (ctl <> nil) do
314 begin
315 if (not ctl.mEnabled) or (ctl.mWidth < 1) or (ctl.mHeight < 1) then exit;
316 ctl := ctl.mParent;
317 end;
318 result := true;
319 end;
322 procedure THControl.setEnabled (v: Boolean); inline;
323 begin
324 if (mEnabled = v) then exit;
325 mEnabled := v;
326 if not v and focused then setFocused(false);
327 end;
330 function THControl.getFocused (): Boolean; inline;
331 begin
332 if (mParent = nil) then result := (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)] = self) else result := (topLevel.mFocused = self);
333 end;
336 procedure THControl.setFocused (v: Boolean); inline;
337 var
338 tl: THControl;
339 begin
340 tl := topLevel;
341 if not v then
342 begin
343 if (tl.mFocused = self) then
344 begin
345 tl.blurred();
346 tl.mFocused := tl.findNextFocus(self);
347 if (tl.mFocused = self) then tl.mFocused := nil;
348 end;
349 exit;
350 end;
351 if (not mEnabled) or (not mCanFocus) then exit;
352 if (tl.mFocused <> self) then
353 begin
354 tl.mFocused.blurred();
355 tl.mFocused := self;
356 if (tl.mGrab <> self) then tl.mGrab := nil;
357 activated();
358 end;
359 end;
362 function THControl.isMyChild (ctl: THControl): Boolean;
363 begin
364 result := true;
365 while (ctl <> nil) do
366 begin
367 if (ctl.mParent = self) then exit;
368 ctl := ctl.mParent;
369 end;
370 result := false;
371 end;
374 // returns `true` if global coords are inside this control
375 function THControl.toLocal (var x, y: Integer): Boolean;
376 var
377 ctl: THControl;
378 begin
379 ctl := self;
380 while (ctl <> nil) do
381 begin
382 Dec(x, ctl.mX);
383 Dec(y, ctl.mY);
384 ctl := ctl.mParent;
385 end;
386 result := (x >= 0) and (y >= 0) and (x < mWidth) and (y < mHeight);
387 end;
390 procedure THControl.toGlobal (var x, y: Integer);
391 var
392 ctl: THControl;
393 begin
394 ctl := self;
395 while (ctl <> nil) do
396 begin
397 Inc(x, ctl.mX);
398 Inc(y, ctl.mY);
399 ctl := ctl.mParent;
400 end;
401 end;
404 // x and y are global coords
405 function THControl.controlAtXY (x, y: Integer): THControl;
406 var
407 lx, ly: Integer;
408 f: Integer;
409 begin
410 result := nil;
411 if (not mEnabled) or (mWidth < 1) or (mHeight < 1) then exit;
412 lx := x;
413 ly := y;
414 if not toLocal(lx, ly) then exit;
415 for f := High(mChildren) downto 0 do
416 begin
417 result := mChildren[f].controlAtXY(x, y);
418 if (result <> nil) then exit;
419 end;
420 result := self;
421 end;
424 function THControl.prevSibling (): THControl;
425 var
426 f: Integer;
427 begin
428 if (mParent <> nil) then
429 begin
430 for f := 1 to High(mParent.mChildren) do
431 begin
432 if (mParent.mChildren[f] = self) then begin result := mParent.mChildren[f-1]; exit; end;
433 end;
434 end;
435 result := nil;
436 end;
438 function THControl.nextSibling (): THControl;
439 var
440 f: Integer;
441 begin
442 if (mParent <> nil) then
443 begin
444 for f := 0 to High(mParent.mChildren)-1 do
445 begin
446 if (mParent.mChildren[f] = self) then begin result := mParent.mChildren[f+1]; exit; end;
447 end;
448 end;
449 result := nil;
450 end;
452 function THControl.firstChild (): THControl; inline;
453 begin
454 if (Length(mChildren) <> 0) then result := mChildren[0] else result := nil;
455 end;
457 function THControl.lastChild (): THControl; inline;
458 begin
459 if (Length(mChildren) <> 0) then result := mChildren[High(mChildren)] else result := nil;
460 end;
463 function THControl.findFirstFocus (): THControl;
464 var
465 f: Integer;
466 begin
467 result := nil;
468 if enabled then
469 begin
470 for f := 0 to High(mChildren) do
471 begin
472 result := mChildren[f].findFirstFocus();
473 if (result <> nil) then exit;
474 end;
475 if mCanFocus then result := self;
476 end;
477 end;
480 function THControl.findLastFocus (): THControl;
481 var
482 f: Integer;
483 begin
484 result := nil;
485 if enabled then
486 begin
487 for f := High(mChildren) downto 0 do
488 begin
489 result := mChildren[f].findLastFocus();
490 if (result <> nil) then exit;
491 end;
492 if mCanFocus then result := self;
493 end;
494 end;
497 function THControl.findNextFocus (cur: THControl): THControl;
498 begin
499 result := nil;
500 if enabled then
501 begin
502 if not isMyChild(cur) then cur := nil;
503 if (cur = nil) then begin result := findFirstFocus(); exit; end;
504 result := cur.findFirstFocus();
505 if (result <> nil) and (result <> cur) then exit;
506 while true do
507 begin
508 cur := cur.nextSibling;
509 if (cur = nil) then break;
510 result := cur.findFirstFocus();
511 if (result <> nil) then exit;
512 end;
513 result := findFirstFocus();
514 end;
515 end;
518 function THControl.findPrevFocus (cur: THControl): THControl;
519 begin
520 result := nil;
521 if enabled then
522 begin
523 if not isMyChild(cur) then cur := nil;
524 if (cur = nil) then begin result := findLastFocus(); exit; end;
525 //FIXME!
526 result := cur.findLastFocus();
527 if (result <> nil) and (result <> cur) then exit;
528 while true do
529 begin
530 cur := cur.prevSibling;
531 if (cur = nil) then break;
532 result := cur.findLastFocus();
533 if (result <> nil) then exit;
534 end;
535 result := findLastFocus();
536 end;
537 end;
540 procedure THControl.draw ();
541 var
542 f: Integer;
543 x, y: Integer;
544 scxywh: array[0..3] of GLint;
545 wassc: Boolean;
547 procedure setScissor (x, y, w, h: Integer);
548 var
549 x1, y1: Integer;
550 sx0, sy0: Integer;
551 sx1, sy1: Integer;
552 begin
553 if (w < 1) or (h < 1) or (scxywh[2] < 1) or (scxywh[3] < 1) then begin glScissor(0, 0, 0, 0); exit; end;
554 x1 := x+w-1;
555 y1 := y+h-1;
556 sx0 := scxywh[0];
557 sy0 := scxywh[1];
558 sx1 := sx0+scxywh[2]-1;
559 sy1 := sy0+scxywh[3]-1;
560 //conwritefln('0: (%d,%d)-(%d,%d) (%d,%d)-(%d,%d)', [sx0, sy0, sx1, sy1, x, y, x1, y1]);
561 if (x1 < sx0) or (y1 < sy0) or (x > sx1) or (y > sy1) then begin glScissor(0, 0, 0, 0); exit; end;
562 if (x < sx0) then x := sx0;
563 if (y < sy0) then y := sy0;
564 if (x1 > sx1) then x1 := sx1;
565 if (y1 > sy1) then y1 := sy1;
566 //conwritefln('1: (%d,%d)-(%d,%d) (%d,%d)-(%d,%d)', [sx0, sy0, sx1, sy1, x, y, x1, y1]);
567 glScissor(x, y, x1-x+1, y1-y+1);
568 end;
570 begin
571 if (mWidth < 1) or (mHeight < 1) then exit;
572 x := 0;
573 y := 0;
574 toGlobal(x, y);
575 //conwritefln('[%s]: (%d,%d)-(%d,%d) (%d,%d)', [ClassName, mX, mY, mWidth, mHeight, x, y]);
577 scxywh[0] := 0;
578 scxywh[1] := 0;
579 scxywh[2] := 0;
580 scxywh[3] := 0;
582 wassc := (glIsEnabled(GL_SCISSOR_TEST) <> 0);
583 if wassc then
584 begin
585 glGetIntegerv(GL_SCISSOR_BOX, @scxywh[0]);
586 end
587 else
588 begin
589 glGetIntegerv(GL_VIEWPORT, @scxywh[0]);
590 end;
591 //conwritefln('(%d,%d)-(%d,%d)', [scxywh[0], scxywh[1], scxywh[2], scxywh[3]]);
593 glEnable(GL_SCISSOR_TEST);
594 setScissor(x, gWinSizeY-(y+mHeight-1)-1, mWidth, mHeight);
596 drawControl(x, y);
597 if (mParent = nil) then setScissor(x+2, gWinSizeY-(y+mHeight-1-2)-1, mWidth-4, mHeight-14);
598 for f := 0 to High(mChildren) do mChildren[f].draw();
599 if (mParent = nil) then setScissor(x, gWinSizeY-(y+mHeight-1)-1, mWidth, mHeight);
600 drawControlPost(x, y);
601 glScissor(scxywh[0], scxywh[1], scxywh[2], scxywh[3]);
602 if wassc then glEnable(GL_SCISSOR_TEST) else glDisable(GL_SCISSOR_TEST);
603 end;
606 procedure THControl.drawControl (sx, sy: Integer);
607 begin
608 if (mParent = nil) then darkenRect(sx, sy, mWidth, mHeight, 64);
609 //fillRect(sx, sy, mWidth, mHeight, 0, 0, 255, 120);
610 end;
613 procedure THControl.drawControlPost (sx, sy: Integer);
614 begin
615 end;
618 function THControl.mouseEvent (var ev: THMouseEvent): Boolean;
619 var
620 ctl: THControl;
621 begin
622 result := false;
623 if not mEnabled then exit;
624 if (mParent = nil) then
625 begin
626 if (mGrab <> nil) then
627 begin
628 result := mGrab.mouseEvent(ev);
629 if (ev.kind = ev.Release) then mGrab := nil;
630 exit;
631 end;
632 end;
633 if (mWidth < 1) or (mHeight < 1) then exit;
634 ctl := controlAtXY(ev.x, ev.y);
635 if (ctl <> nil) and (ctl <> self) then
636 begin
637 if (ctl <> topLevel.mFocused) then ctl.setFocused(true);
638 result := ctl.mouseEvent(ev);
639 end;
640 end;
643 function THControl.keyEvent (var ev: THKeyEvent): Boolean;
644 var
645 ctl: THControl;
646 begin
647 result := false;
648 if not mEnabled then exit;
649 if (topLevel.mFocused <> self) and isMyChild(topLevel.mFocused) and topLevel.mFocused.mEnabled then result := topLevel.mFocused.keyEvent(ev);
650 if (mParent = nil) then
651 begin
652 if (ev.kstate = THKeyEvent.ModShift) and (ev.scan = SDL_SCANCODE_TAB) then
653 begin
654 result := true;
655 if (ev.kind = ev.Press) then
656 begin
657 ctl := findPrevFocus(mFocused);
658 if (ctl <> mFocused) then
659 begin
660 mGrab := nil;
661 mFocused := ctl;
662 end;
663 end;
664 exit;
665 end;
666 if (ev.kstate = 0) and (ev.scan = SDL_SCANCODE_TAB) then
667 begin
668 result := true;
669 if (ev.kind = ev.Press) then
670 begin
671 ctl := findNextFocus(mFocused);
672 if (ctl <> mFocused) then
673 begin
674 mGrab := nil;
675 mFocused := ctl;
676 end;
677 end;
678 exit;
679 end;
680 if mEscClose and (ev.kind = ev.Press) and (ev.kstate = 0) and (ev.scan = SDL_SCANCODE_ESCAPE) then
681 begin
682 result := true;
683 uiRemoveWindow(self);
684 exit;
685 end;
686 end;
687 if mEatKeys then result := true;
688 end;
691 // ////////////////////////////////////////////////////////////////////////// //
692 constructor THTopWindow.Create (const atitle: AnsiString; ax, ay: Integer; aw: Integer=-1; ah: Integer=-1);
693 begin
694 mTitle := atitle;
695 if (Length(mTitle) > 0) then
696 begin
697 if (ah < 14) then ah := 14;
698 if (aw < Length(mTitle)*8+4) then aw := Length(mTitle)*8+4;
699 end
700 else
701 begin
702 if (ah < 4) then ah := 4;
703 if (aw < 4) then aw := 4;
704 end;
705 mDragging := false;
706 inherited Create(ax, ay, aw, ah, nil);
707 end;
710 procedure THTopWindow.appendChild (ctl: THControl);
711 var
712 myofs: Integer;
713 begin
714 if (ctl = nil) then exit;
715 if (ctl.mParent <> nil) then exit;
716 if (Length(mTitle) > 0) then myofs := 12 else myofs := 2;
717 SetLength(mChildren, Length(mChildren)+1);
718 mChildren[High(mChildren)] := ctl;
719 ctl.mParent := self;
720 Inc(ctl.mX, 2);
721 Inc(ctl.mY, myofs);
722 if (ctl.mWidth > 0) and (ctl.mHeight > 0) and
723 (ctl.mX+ctl.mWidth > 2) and (ctl.mY+ctl.mHeight > myofs-2) then
724 begin
725 if (mWidth+2 < ctl.mX+ctl.mWidth) then mWidth := ctl.mX+ctl.mWidth+2;
726 if (mHeight+2 < ctl.mY+ctl.mHeight) then mHeight := ctl.mY+ctl.mHeight+2;
727 end;
728 if (mFocused = nil) and ctl.mEnabled and ctl.mCanFocus and (ctl.mWidth > 0) and (ctl.mHeight > 0) then mFocused := ctl;
729 end;
732 procedure THTopWindow.drawControl (sx, sy: Integer);
733 begin
734 //if (mParent = nil) then darkenRect(sx, sy, mWidth, mHeight, 200);
735 fillRect(sx, sy, mWidth, mHeight, 0, 0, 128);
736 end;
739 procedure THTopWindow.drawControlPost (sx, sy: Integer);
740 var
741 r, g, b: Integer;
742 begin
743 if getFocused then
744 begin
745 r := 255;
746 g := 255;
747 b := 255;
748 end
749 else
750 begin
751 r := 127;
752 g := 127;
753 b := 127;
754 end;
755 drawRect(mX, mY, mWidth, mHeight, r, g, b);
756 if (Length(mTitle) > 0) then
757 begin
758 fillRect(mX+1, mY+1, mWidth-2, 9, r, g, b);
759 drawText8(mX+2, mY+1, mTitle, 0, 0, 0);
760 end;
761 end;
764 procedure THTopWindow.blurred ();
765 begin
766 mDragging := false;
767 inherited;
768 end;
771 function THTopWindow.mouseEvent (var ev: THMouseEvent): Boolean;
772 var
773 lx, ly: Integer;
774 begin
775 result := false;
776 if not mEnabled then exit;
777 if (mWidth < 1) or (mHeight < 1) then exit;
779 if mDragging then
780 begin
781 mX += ev.x-mDragStartX;
782 mY += ev.y-mDragStartY;
783 mDragStartX := ev.x;
784 mDragStartY := ev.y;
785 if (ev.kind = ev.Release) then mDragging := false;
786 result := true;
787 exit;
788 end;
790 if (ev.kind = ev.Press) and (ev.but = ev.Left) then
791 begin
792 lx := ev.x;
793 ly := ev.y;
794 if toLocal(lx, ly) then
795 begin
796 if ((Length(mTitle) > 0) and (ly < 12)) or ((Length(mTitle) = 0) and (ly < 2)) then
797 begin
798 mDragging := true;
799 mDragStartX := ev.x;
800 mDragStartY := ev.y;
801 result := true;
802 exit;
803 end;
804 end;
805 end;
807 result := inherited mouseEvent(ev);
808 end;
811 // ////////////////////////////////////////////////////////////////////////// //
812 constructor THCtlCBListBox.Create (ax, ay: Integer; aparent: THControl=nil);
813 begin
814 mItems := nil;
815 mChecks := nil;
816 mCurIndex := -1;
817 inherited Create(ax, ay, 4, 4);
818 end;
821 destructor THCtlCBListBox.Destroy ();
822 begin
823 mItems := nil;
824 mChecks := nil;
825 inherited;
826 end;
829 procedure THCtlCBListBox.appendItem (const atext: AnsiString; bv: PBoolean);
830 begin
831 if (Length(atext)*8+4+10 > mWidth) then mWidth := Length(atext)*8+4+10;
832 SetLength(mItems, Length(mItems)+1);
833 mItems[High(mItems)] := atext;
834 SetLength(mChecks, Length(mChecks)+1);
835 mChecks[High(mChecks)] := bv;
836 if (Length(mItems)*8+4 > mHeight) then mHeight := Length(mItems)*8+4;
837 end;
840 procedure THCtlCBListBox.drawControl (sx, sy: Integer);
841 var
842 f: Integer;
843 begin
844 //fillRect(sx, sy, mWidth, mHeight, 0, 128, 0);
845 Inc(sx, 2);
846 Inc(sy, 2);
847 for f := 0 to High(mItems) do
848 begin
849 if (mCurIndex = f) then fillRect(sx-2, sy, mWidth, 8, 0, 128, 0);
850 if (mChecks[f] <> nil) and (mChecks[f]^) then drawText8(sx, sy, '*', 255, 255, 255);
851 drawText8(sx+10, sy, mItems[f], 255, 255, 0);
852 Inc(sy, 8);
853 end;
854 end;
857 function THCtlCBListBox.mouseEvent (var ev: THMouseEvent): Boolean;
858 var
859 lx, ly: Integer;
860 begin
861 result := inherited mouseEvent(ev);
862 if not result and (Length(mItems) > 0) and (ev.kind = ev.Press) then
863 begin
864 lx := ev.x;
865 ly := ev.y;
866 if toLocal(lx, ly) then
867 begin
868 if (ly < 2) then ly := 2;
869 ly := ly div 8;
870 if (ly < 0) then ly := 0 else if (ly > High(mItems)) then ly := High(mItems);
871 mCurIndex := ly;
872 if (mChecks[ly] <> nil) then mChecks[ly]^ := not mChecks[ly]^;
873 end;
874 end;
875 end;
878 function THCtlCBListBox.keyEvent (var ev: THKeyEvent): Boolean;
879 begin
880 result := inherited keyEvent(ev);
881 if not getFocused then exit;
882 //result := true;
883 if (ev.kstate = 0) and (ev.kind = ev.Press) then
884 begin
885 case ev.scan of
886 SDL_SCANCODE_HOME,
887 SDL_SCANCODE_PAGEUP:
888 begin
889 result := true;
890 mCurIndex := 0;
891 end;
892 SDL_SCANCODE_END,
893 SDL_SCANCODE_PAGEDOWN:
894 begin
895 result := true;
896 mCurIndex := High(mItems);
897 end;
898 SDL_SCANCODE_UP:
899 begin
900 result := true;
901 if (mCurIndex < 0) then mCurIndex := Length(mItems)
902 else if (mCurIndex > 0) then Dec(mCurIndex);
903 end;
904 SDL_SCANCODE_DOWN:
905 begin
906 result := true;
907 if (mCurIndex < 0) then mCurIndex := 0
908 else if (mCurIndex < High(mItems)) then Inc(mCurIndex);
909 end;
910 SDL_SCANCODE_SPACE,
911 SDL_SCANCODE_RETURN:
912 begin
913 result := true;
914 if (mCurIndex >= 0) and (mCurIndex < Length(mChecks)) and (mChecks[mCurIndex] <> nil) then mChecks[mCurIndex]^ := not mChecks[mCurIndex]^;
915 end;
916 end;
917 end;
918 end;