4f372842ff369a7c8a598207b044152c1299188e
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 ctl: THControl;
180 begin
181 for f := 0 to High(uiTopList) do
182 begin
183 ctl := uiTopList[f];
184 ctl.draw();
185 if (f <> High(uiTopList)) then darkenRect(ctl.x0, ctl.y0, ctl.width, ctl.height, 128);
186 end;
187 end;
190 procedure uiAddWindow (ctl: THControl);
191 var
192 f, c: Integer;
193 begin
194 if (ctl = nil) then exit;
195 ctl := ctl.topLevel;
196 for f := 0 to High(uiTopList) do
197 begin
198 if (uiTopList[f] = ctl) then
199 begin
200 if (f <> High(uiTopList)) then
201 begin
202 uiTopList[High(uiTopList)].blurred();
203 for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
204 uiTopList[High(uiTopList)] := ctl;
205 ctl.activated();
206 end;
207 exit;
208 end;
209 end;
210 if (Length(uiTopList) > 0) then uiTopList[High(uiTopList)].blurred();
211 SetLength(uiTopList, Length(uiTopList)+1);
212 uiTopList[High(uiTopList)] := ctl;
213 ctl.activated();
214 end;
217 // won't free object
218 procedure uiRemoveWindow (ctl: THControl);
219 var
220 f, c: Integer;
221 begin
222 if (ctl = nil) then exit;
223 ctl := ctl.topLevel;
224 for f := 0 to High(uiTopList) do
225 begin
226 if (uiTopList[f] = ctl) then
227 begin
228 ctl.blurred();
229 for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
230 SetLength(uiTopList, Length(uiTopList)-1);
231 exit;
232 end;
233 end;
234 end;
237 function uiVisibleWindow (ctl: THControl): Boolean;
238 var
239 f: Integer;
240 begin
241 result := false;
242 if (ctl = nil) then exit;
243 ctl := ctl.topLevel;
244 for f := 0 to High(uiTopList) do
245 begin
246 if (uiTopList[f] = ctl) then begin result := true; exit; end;
247 end;
248 end;
251 // ////////////////////////////////////////////////////////////////////////// //
252 constructor THControl.Create (ax, ay, aw, ah: Integer; aparent: THControl=nil);
253 begin
254 mParent := aparent;
255 mX := ax;
256 mY := ay;
257 mWidth := aw;
258 mHeight := ah;
259 mEnabled := true;
260 mCanFocus := true;
261 mChildren := nil;
262 mFocused := nil;
263 mGrab := nil;
264 mEscClose := false;
265 mEatKeys := false;
266 end;
269 destructor THControl.Destroy ();
270 var
271 f, c: Integer;
272 begin
273 if (mParent <> nil) then
274 begin
275 setFocused(false);
276 for f := 0 to High(mParent.mChildren) do
277 begin
278 if (mParent.mChildren[f] = self) then
279 begin
280 for c := f+1 to High(mParent.mChildren) do mParent.mChildren[c-1] := mParent.mChildren[c];
281 SetLength(mParent.mChildren, Length(mParent.mChildren)-1);
282 end;
283 end;
284 end;
285 for f := 0 to High(mChildren) do
286 begin
287 mChildren[f].mParent := nil;
288 mChildren[f].Free();
289 end;
290 mChildren := nil;
291 end;
294 procedure THControl.activated ();
295 begin
296 end;
299 procedure THControl.blurred ();
300 begin
301 mGrab := nil;
302 end;
305 function THControl.topLevel (): THControl; inline;
306 begin
307 result := self;
308 while (result.mParent <> nil) do result := result.mParent;
309 end;
312 function THControl.getEnabled (): Boolean;
313 var
314 ctl: THControl;
315 begin
316 result := false;
317 if (not mEnabled) or (mWidth < 1) or (mHeight < 1) then exit;
318 ctl := mParent;
319 while (ctl <> nil) do
320 begin
321 if (not ctl.mEnabled) or (ctl.mWidth < 1) or (ctl.mHeight < 1) then exit;
322 ctl := ctl.mParent;
323 end;
324 result := true;
325 end;
328 procedure THControl.setEnabled (v: Boolean); inline;
329 begin
330 if (mEnabled = v) then exit;
331 mEnabled := v;
332 if not v and focused then setFocused(false);
333 end;
336 function THControl.getFocused (): Boolean; inline;
337 begin
338 if (mParent = nil) then result := (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)] = self) else result := (topLevel.mFocused = self);
339 end;
342 procedure THControl.setFocused (v: Boolean); inline;
343 var
344 tl: THControl;
345 begin
346 tl := topLevel;
347 if not v then
348 begin
349 if (tl.mFocused = self) then
350 begin
351 tl.blurred();
352 tl.mFocused := tl.findNextFocus(self);
353 if (tl.mFocused = self) then tl.mFocused := nil;
354 end;
355 exit;
356 end;
357 if (not mEnabled) or (not mCanFocus) then exit;
358 if (tl.mFocused <> self) then
359 begin
360 tl.mFocused.blurred();
361 tl.mFocused := self;
362 if (tl.mGrab <> self) then tl.mGrab := nil;
363 activated();
364 end;
365 end;
368 function THControl.isMyChild (ctl: THControl): Boolean;
369 begin
370 result := true;
371 while (ctl <> nil) do
372 begin
373 if (ctl.mParent = self) then exit;
374 ctl := ctl.mParent;
375 end;
376 result := false;
377 end;
380 // returns `true` if global coords are inside this control
381 function THControl.toLocal (var x, y: Integer): Boolean;
382 var
383 ctl: THControl;
384 begin
385 ctl := self;
386 while (ctl <> nil) do
387 begin
388 Dec(x, ctl.mX);
389 Dec(y, ctl.mY);
390 ctl := ctl.mParent;
391 end;
392 result := (x >= 0) and (y >= 0) and (x < mWidth) and (y < mHeight);
393 end;
396 procedure THControl.toGlobal (var x, y: Integer);
397 var
398 ctl: THControl;
399 begin
400 ctl := self;
401 while (ctl <> nil) do
402 begin
403 Inc(x, ctl.mX);
404 Inc(y, ctl.mY);
405 ctl := ctl.mParent;
406 end;
407 end;
410 // x and y are global coords
411 function THControl.controlAtXY (x, y: Integer): THControl;
412 var
413 lx, ly: Integer;
414 f: Integer;
415 begin
416 result := nil;
417 if (not mEnabled) or (mWidth < 1) or (mHeight < 1) then exit;
418 lx := x;
419 ly := y;
420 if not toLocal(lx, ly) then exit;
421 for f := High(mChildren) downto 0 do
422 begin
423 result := mChildren[f].controlAtXY(x, y);
424 if (result <> nil) then exit;
425 end;
426 result := self;
427 end;
430 function THControl.prevSibling (): THControl;
431 var
432 f: Integer;
433 begin
434 if (mParent <> nil) then
435 begin
436 for f := 1 to High(mParent.mChildren) do
437 begin
438 if (mParent.mChildren[f] = self) then begin result := mParent.mChildren[f-1]; exit; end;
439 end;
440 end;
441 result := nil;
442 end;
444 function THControl.nextSibling (): THControl;
445 var
446 f: Integer;
447 begin
448 if (mParent <> nil) then
449 begin
450 for f := 0 to High(mParent.mChildren)-1 do
451 begin
452 if (mParent.mChildren[f] = self) then begin result := mParent.mChildren[f+1]; exit; end;
453 end;
454 end;
455 result := nil;
456 end;
458 function THControl.firstChild (): THControl; inline;
459 begin
460 if (Length(mChildren) <> 0) then result := mChildren[0] else result := nil;
461 end;
463 function THControl.lastChild (): THControl; inline;
464 begin
465 if (Length(mChildren) <> 0) then result := mChildren[High(mChildren)] else result := nil;
466 end;
469 function THControl.findFirstFocus (): THControl;
470 var
471 f: Integer;
472 begin
473 result := nil;
474 if enabled then
475 begin
476 for f := 0 to High(mChildren) do
477 begin
478 result := mChildren[f].findFirstFocus();
479 if (result <> nil) then exit;
480 end;
481 if mCanFocus then result := self;
482 end;
483 end;
486 function THControl.findLastFocus (): THControl;
487 var
488 f: Integer;
489 begin
490 result := nil;
491 if enabled then
492 begin
493 for f := High(mChildren) downto 0 do
494 begin
495 result := mChildren[f].findLastFocus();
496 if (result <> nil) then exit;
497 end;
498 if mCanFocus then result := self;
499 end;
500 end;
503 function THControl.findNextFocus (cur: THControl): THControl;
504 begin
505 result := nil;
506 if enabled then
507 begin
508 if not isMyChild(cur) then cur := nil;
509 if (cur = nil) then begin result := findFirstFocus(); exit; end;
510 result := cur.findFirstFocus();
511 if (result <> nil) and (result <> cur) then exit;
512 while true do
513 begin
514 cur := cur.nextSibling;
515 if (cur = nil) then break;
516 result := cur.findFirstFocus();
517 if (result <> nil) then exit;
518 end;
519 result := findFirstFocus();
520 end;
521 end;
524 function THControl.findPrevFocus (cur: THControl): THControl;
525 begin
526 result := nil;
527 if enabled then
528 begin
529 if not isMyChild(cur) then cur := nil;
530 if (cur = nil) then begin result := findLastFocus(); exit; end;
531 //FIXME!
532 result := cur.findLastFocus();
533 if (result <> nil) and (result <> cur) then exit;
534 while true do
535 begin
536 cur := cur.prevSibling;
537 if (cur = nil) then break;
538 result := cur.findLastFocus();
539 if (result <> nil) then exit;
540 end;
541 result := findLastFocus();
542 end;
543 end;
546 procedure THControl.draw ();
547 var
548 f: Integer;
549 x, y: Integer;
550 scxywh: array[0..3] of GLint;
551 wassc: Boolean;
553 procedure setScissor (x, y, w, h: Integer);
554 var
555 x1, y1: Integer;
556 sx0, sy0: Integer;
557 sx1, sy1: Integer;
558 begin
559 if (w < 1) or (h < 1) or (scxywh[2] < 1) or (scxywh[3] < 1) then begin glScissor(0, 0, 0, 0); exit; end;
560 x1 := x+w-1;
561 y1 := y+h-1;
562 sx0 := scxywh[0];
563 sy0 := scxywh[1];
564 sx1 := sx0+scxywh[2]-1;
565 sy1 := sy0+scxywh[3]-1;
566 //conwritefln('0: (%d,%d)-(%d,%d) (%d,%d)-(%d,%d)', [sx0, sy0, sx1, sy1, x, y, x1, y1]);
567 if (x1 < sx0) or (y1 < sy0) or (x > sx1) or (y > sy1) then begin glScissor(0, 0, 0, 0); exit; end;
568 if (x < sx0) then x := sx0;
569 if (y < sy0) then y := sy0;
570 if (x1 > sx1) then x1 := sx1;
571 if (y1 > sy1) then y1 := sy1;
572 //conwritefln('1: (%d,%d)-(%d,%d) (%d,%d)-(%d,%d)', [sx0, sy0, sx1, sy1, x, y, x1, y1]);
573 glScissor(x, y, x1-x+1, y1-y+1);
574 end;
576 begin
577 if (mWidth < 1) or (mHeight < 1) then exit;
578 x := 0;
579 y := 0;
580 toGlobal(x, y);
581 //conwritefln('[%s]: (%d,%d)-(%d,%d) (%d,%d)', [ClassName, mX, mY, mWidth, mHeight, x, y]);
583 scxywh[0] := 0;
584 scxywh[1] := 0;
585 scxywh[2] := 0;
586 scxywh[3] := 0;
588 wassc := (glIsEnabled(GL_SCISSOR_TEST) <> 0);
589 if wassc then
590 begin
591 glGetIntegerv(GL_SCISSOR_BOX, @scxywh[0]);
592 end
593 else
594 begin
595 glGetIntegerv(GL_VIEWPORT, @scxywh[0]);
596 end;
597 //conwritefln('(%d,%d)-(%d,%d)', [scxywh[0], scxywh[1], scxywh[2], scxywh[3]]);
599 glEnable(GL_SCISSOR_TEST);
600 setScissor(x, gWinSizeY-(y+mHeight-1)-1, mWidth, mHeight);
602 drawControl(x, y);
603 if (mParent = nil) then setScissor(x+2, gWinSizeY-(y+mHeight-1-2)-1, mWidth-4, mHeight-14);
604 for f := 0 to High(mChildren) do mChildren[f].draw();
605 if (mParent = nil) then setScissor(x, gWinSizeY-(y+mHeight-1)-1, mWidth, mHeight);
606 drawControlPost(x, y);
607 glScissor(scxywh[0], scxywh[1], scxywh[2], scxywh[3]);
608 if wassc then glEnable(GL_SCISSOR_TEST) else glDisable(GL_SCISSOR_TEST);
609 end;
612 procedure THControl.drawControl (sx, sy: Integer);
613 begin
614 if (mParent = nil) then darkenRect(sx, sy, mWidth, mHeight, 64);
615 //fillRect(sx, sy, mWidth, mHeight, 0, 0, 255, 120);
616 end;
619 procedure THControl.drawControlPost (sx, sy: Integer);
620 begin
621 end;
624 function THControl.mouseEvent (var ev: THMouseEvent): Boolean;
625 var
626 ctl: THControl;
627 begin
628 result := false;
629 if not mEnabled then exit;
630 if (mParent = nil) then
631 begin
632 if (mGrab <> nil) then
633 begin
634 result := mGrab.mouseEvent(ev);
635 if (ev.kind = ev.Release) then mGrab := nil;
636 exit;
637 end;
638 end;
639 if (mWidth < 1) or (mHeight < 1) then exit;
640 ctl := controlAtXY(ev.x, ev.y);
641 if (ctl <> nil) and (ctl <> self) then
642 begin
643 if (ctl <> topLevel.mFocused) then ctl.setFocused(true);
644 result := ctl.mouseEvent(ev);
645 end;
646 end;
649 function THControl.keyEvent (var ev: THKeyEvent): Boolean;
650 var
651 ctl: THControl;
652 begin
653 result := false;
654 if not mEnabled then exit;
655 if (topLevel.mFocused <> self) and isMyChild(topLevel.mFocused) and topLevel.mFocused.mEnabled then result := topLevel.mFocused.keyEvent(ev);
656 if (mParent = nil) then
657 begin
658 if (ev.kstate = THKeyEvent.ModShift) and (ev.scan = SDL_SCANCODE_TAB) then
659 begin
660 result := true;
661 if (ev.kind = ev.Press) then
662 begin
663 ctl := findPrevFocus(mFocused);
664 if (ctl <> mFocused) then
665 begin
666 mGrab := nil;
667 mFocused := ctl;
668 end;
669 end;
670 exit;
671 end;
672 if (ev.kstate = 0) and (ev.scan = SDL_SCANCODE_TAB) then
673 begin
674 result := true;
675 if (ev.kind = ev.Press) then
676 begin
677 ctl := findNextFocus(mFocused);
678 if (ctl <> mFocused) then
679 begin
680 mGrab := nil;
681 mFocused := ctl;
682 end;
683 end;
684 exit;
685 end;
686 if mEscClose and (ev.kind = ev.Press) and (ev.kstate = 0) and (ev.scan = SDL_SCANCODE_ESCAPE) then
687 begin
688 result := true;
689 uiRemoveWindow(self);
690 exit;
691 end;
692 end;
693 if mEatKeys then result := true;
694 end;
697 // ////////////////////////////////////////////////////////////////////////// //
698 constructor THTopWindow.Create (const atitle: AnsiString; ax, ay: Integer; aw: Integer=-1; ah: Integer=-1);
699 begin
700 mTitle := atitle;
701 if (Length(mTitle) > 0) then
702 begin
703 if (ah < 14) then ah := 14;
704 if (aw < Length(mTitle)*8+4) then aw := Length(mTitle)*8+4;
705 end
706 else
707 begin
708 if (ah < 4) then ah := 4;
709 if (aw < 4) then aw := 4;
710 end;
711 mDragging := false;
712 inherited Create(ax, ay, aw, ah, nil);
713 end;
716 procedure THTopWindow.appendChild (ctl: THControl);
717 var
718 myofs: Integer;
719 begin
720 if (ctl = nil) then exit;
721 if (ctl.mParent <> nil) then exit;
722 if (Length(mTitle) > 0) then myofs := 12 else myofs := 2;
723 SetLength(mChildren, Length(mChildren)+1);
724 mChildren[High(mChildren)] := ctl;
725 ctl.mParent := self;
726 Inc(ctl.mX, 2);
727 Inc(ctl.mY, myofs);
728 if (ctl.mWidth > 0) and (ctl.mHeight > 0) and
729 (ctl.mX+ctl.mWidth > 2) and (ctl.mY+ctl.mHeight > myofs-2) then
730 begin
731 if (mWidth+2 < ctl.mX+ctl.mWidth) then mWidth := ctl.mX+ctl.mWidth+2;
732 if (mHeight+2 < ctl.mY+ctl.mHeight) then mHeight := ctl.mY+ctl.mHeight+2;
733 end;
734 if (mFocused = nil) and ctl.mEnabled and ctl.mCanFocus and (ctl.mWidth > 0) and (ctl.mHeight > 0) then mFocused := ctl;
735 end;
738 procedure THTopWindow.drawControl (sx, sy: Integer);
739 begin
740 //if (mParent = nil) then darkenRect(sx, sy, mWidth, mHeight, 200);
741 fillRect(sx, sy, mWidth, mHeight, 0, 0, 128);
742 end;
745 procedure THTopWindow.drawControlPost (sx, sy: Integer);
746 var
747 r, g, b: Integer;
748 begin
749 {
750 if getFocused then
751 begin
752 r := 255;
753 g := 255;
754 b := 255;
755 end
756 else
757 begin
758 r := 127;
759 g := 127;
760 b := 127;
761 end;
762 }
763 r := 255;
764 g := 255;
765 b := 255;
766 drawRect(mX, mY, mWidth, mHeight, r, g, b);
767 if (Length(mTitle) > 0) then
768 begin
769 fillRect(mX+1, mY+1, mWidth-2, 9, r, g, b);
770 drawText8(mX+2, mY+1, mTitle, 0, 0, 0);
771 end;
772 end;
775 procedure THTopWindow.blurred ();
776 begin
777 mDragging := false;
778 inherited;
779 end;
782 function THTopWindow.mouseEvent (var ev: THMouseEvent): Boolean;
783 var
784 lx, ly: Integer;
785 begin
786 result := false;
787 if not mEnabled then exit;
788 if (mWidth < 1) or (mHeight < 1) then exit;
790 if mDragging then
791 begin
792 mX += ev.x-mDragStartX;
793 mY += ev.y-mDragStartY;
794 mDragStartX := ev.x;
795 mDragStartY := ev.y;
796 if (ev.kind = ev.Release) then mDragging := false;
797 result := true;
798 exit;
799 end;
801 if (ev.kind = ev.Press) and (ev.but = ev.Left) then
802 begin
803 lx := ev.x;
804 ly := ev.y;
805 if toLocal(lx, ly) then
806 begin
807 if ((Length(mTitle) > 0) and (ly < 12)) or ((Length(mTitle) = 0) and (ly < 2)) then
808 begin
809 mDragging := true;
810 mDragStartX := ev.x;
811 mDragStartY := ev.y;
812 result := true;
813 exit;
814 end;
815 end;
816 end;
818 result := inherited mouseEvent(ev);
819 end;
822 // ////////////////////////////////////////////////////////////////////////// //
823 constructor THCtlCBListBox.Create (ax, ay: Integer; aparent: THControl=nil);
824 begin
825 mItems := nil;
826 mChecks := nil;
827 mCurIndex := -1;
828 inherited Create(ax, ay, 4, 4);
829 end;
832 destructor THCtlCBListBox.Destroy ();
833 begin
834 mItems := nil;
835 mChecks := nil;
836 inherited;
837 end;
840 procedure THCtlCBListBox.appendItem (const atext: AnsiString; bv: PBoolean);
841 begin
842 if (Length(atext)*8+4+3*8+2 > mWidth) then mWidth := Length(atext)*8+4+3*8+2;
843 SetLength(mItems, Length(mItems)+1);
844 mItems[High(mItems)] := atext;
845 SetLength(mChecks, Length(mChecks)+1);
846 mChecks[High(mChecks)] := bv;
847 if (Length(mItems)*8+4 > mHeight) then mHeight := Length(mItems)*8+4;
848 if (mCurIndex < 0) then mCurIndex := 0;
849 end;
852 procedure THCtlCBListBox.drawControl (sx, sy: Integer);
853 var
854 f: Integer;
855 begin
856 //fillRect(sx, sy, mWidth, mHeight, 0, 128, 0);
857 Inc(sx, 2);
858 Inc(sy, 2);
859 for f := 0 to High(mItems) do
860 begin
861 if (mCurIndex = f) then fillRect(sx-2, sy, mWidth, 8, 0, 128, 0);
862 drawText8(sx, sy, '[ ]', 255, 255, 255);
863 if (mChecks[f] <> nil) and (mChecks[f]^) then drawText8(sx+6, sy, 'x', 255, 255, 255);
864 drawText8(sx+3*8+2, sy, mItems[f], 255, 255, 0);
865 Inc(sy, 8);
866 end;
867 end;
870 function THCtlCBListBox.mouseEvent (var ev: THMouseEvent): Boolean;
871 var
872 lx, ly: Integer;
873 begin
874 result := inherited mouseEvent(ev);
875 if not result and (Length(mItems) > 0) and (ev.kind = ev.Press) then
876 begin
877 lx := ev.x;
878 ly := ev.y;
879 if toLocal(lx, ly) then
880 begin
881 if (ly < 2) then ly := 2;
882 ly := ly div 8;
883 if (ly < 0) then ly := 0 else if (ly > High(mItems)) then ly := High(mItems);
884 mCurIndex := ly;
885 if (mChecks[ly] <> nil) then mChecks[ly]^ := not mChecks[ly]^;
886 end;
887 end;
888 end;
891 function THCtlCBListBox.keyEvent (var ev: THKeyEvent): Boolean;
892 begin
893 result := inherited keyEvent(ev);
894 if not getFocused then exit;
895 //result := true;
896 if (ev.kstate = 0) and (ev.kind = ev.Press) then
897 begin
898 case ev.scan of
899 SDL_SCANCODE_HOME,
900 SDL_SCANCODE_PAGEUP:
901 begin
902 result := true;
903 mCurIndex := 0;
904 end;
905 SDL_SCANCODE_END,
906 SDL_SCANCODE_PAGEDOWN:
907 begin
908 result := true;
909 mCurIndex := High(mItems);
910 end;
911 SDL_SCANCODE_UP:
912 begin
913 result := true;
914 if (Length(mItems) > 0) then
915 begin
916 if (mCurIndex < 0) then mCurIndex := Length(mItems);
917 while (mCurIndex > 0) do
918 begin
919 Dec(mCurIndex);
920 if (mChecks[mCurIndex] <> nil) then break;
921 end;
922 end
923 else
924 begin
925 mCurIndex := -1;
926 end;
927 end;
928 SDL_SCANCODE_DOWN:
929 begin
930 result := true;
931 if (Length(mItems) > 0) then
932 begin
933 if (mCurIndex < 0) then mCurIndex := -1;
934 while (mCurIndex < High(mItems)) do
935 begin
936 Inc(mCurIndex);
937 if (mChecks[mCurIndex] <> nil) then break;
938 end;
939 end
940 else
941 begin
942 mCurIndex := -1;
943 end;
944 end;
945 SDL_SCANCODE_SPACE,
946 SDL_SCANCODE_RETURN:
947 begin
948 result := true;
949 if (mCurIndex >= 0) and (mCurIndex < Length(mChecks)) and (mChecks[mCurIndex] <> nil) then mChecks[mCurIndex]^ := not mChecks[mCurIndex]^;
950 end;
951 end;
952 end;
953 end;