1 (* Copyright (C) DooM 2D:Forever Developers
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.
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.
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/>.
16 {$INCLUDE ../shared/a_modes.inc}
27 // ////////////////////////////////////////////////////////////////////////// //
31 type TActionCB
= procedure (me
: THControl
; uinfo
: Integer);
36 mWidth
, mHeight
: Integer;
37 mFrameWidth
, mFrameHeight
: Integer;
40 mChildren
: array of THControl
;
41 mFocused
: THControl
; // valid only for top-level controls
42 mGrab
: THControl
; // valid only for top-level controls
43 mEscClose
: Boolean; // valid only for top-level controls
52 function getEnabled (): Boolean;
53 procedure setEnabled (v
: Boolean); inline;
55 function getFocused (): Boolean; inline;
56 procedure setFocused (v
: Boolean); inline;
58 function isMyChild (ctl
: THControl
): Boolean;
60 function findFirstFocus (): THControl
;
61 function findLastFocus (): THControl
;
63 function findNextFocus (cur
: THControl
): THControl
;
64 function findPrevFocus (cur
: THControl
): THControl
;
66 procedure activated (); virtual;
67 procedure blurred (); virtual;
69 //WARNING! do not call scissor functions outside `.draw*()` API!
70 // reset scissor to whole control
71 procedure resetScissor ();
72 // set scissor to this internal rect (in local coords)
73 procedure setScissor (lx
, ly
, lw
, lh
: Integer);
76 procedure setScissorGLInternal (x
, y
, w
, h
: Integer);
82 constructor Create (ax
, ay
, aw
, ah
: Integer; aparent
: THControl
=nil);
83 destructor Destroy (); override;
85 // `sx` and `sy` are screen coordinates
86 procedure drawControl (sx
, sy
: Integer); virtual;
88 // called after all children drawn
89 procedure drawControlPost (sx
, sy
: Integer); virtual;
91 procedure draw (); virtual;
93 function topLevel (): THControl
; inline;
95 // returns `true` if global coords are inside this control
96 function toLocal (var x
, y
: Integer): Boolean;
97 procedure toGlobal (var x
, y
: Integer);
99 // x and y are global coords
100 function controlAtXY (x
, y
: Integer): THControl
;
102 function mouseEvent (var ev
: THMouseEvent
): Boolean; virtual; // returns `true` if event was eaten
103 function keyEvent (var ev
: THKeyEvent
): Boolean; virtual; // returns `true` if event was eaten
105 function prevSibling (): THControl
;
106 function nextSibling (): THControl
;
107 function firstChild (): THControl
; inline;
108 function lastChild (): THControl
; inline;
110 procedure appendChild (ctl
: THControl
); virtual;
113 property x0
: Integer read mX
;
114 property y0
: Integer read mY
;
115 property height
: Integer read mHeight
;
116 property width
: Integer read mWidth
;
117 property enabled
: Boolean read getEnabled write setEnabled
;
118 property parent
: THControl read mParent
;
119 property focused
: Boolean read getFocused write setFocused
;
120 property escClose
: Boolean read mEscClose write mEscClose
;
121 property eatKeys
: Boolean read mEatKeys write mEatKeys
;
125 THTopWindow
= class(THControl
)
129 mDragStartX
, mDragStartY
: Integer;
130 mWaitingClose
: Boolean;
134 procedure blurred (); override;
137 closeCB
: TActionCB
; // called after window was removed from ui window list
140 constructor Create (const atitle
: AnsiString; ax
, ay
: Integer; aw
: Integer=-1; ah
: Integer=-1);
142 procedure centerInScreen ();
144 // `sx` and `sy` are screen coordinates
145 procedure drawControl (sx
, sy
: Integer); override;
146 procedure drawControlPost (sx
, sy
: Integer); override;
148 function keyEvent (var ev
: THKeyEvent
): Boolean; override; // returns `true` if event was eaten
149 function mouseEvent (var ev
: THMouseEvent
): Boolean; override; // returns `true` if event was eaten
153 THCtlSimpleText
= class(THControl
)
163 mItems
: array of TItem
;
166 constructor Create (ax
, ay
: Integer; aparent
: THControl
=nil);
167 destructor Destroy (); override;
169 procedure appendItem (const atext
: AnsiString; acentered
: Boolean=false; ahline
: Boolean=false);
171 procedure drawControl (sx
, sy
: Integer); override;
173 function mouseEvent (var ev
: THMouseEvent
): Boolean; override;
174 function keyEvent (var ev
: THKeyEvent
): Boolean; override;
178 THCtlCBListBox
= class(THControl
)
188 mItems
: array of TItem
;
192 constructor Create (ax
, ay
: Integer; aparent
: THControl
=nil);
193 destructor Destroy (); override;
195 procedure appendItem (const atext
: AnsiString; bv
: PBoolean; aaction
: TActionCB
=nil);
197 procedure drawControl (sx
, sy
: Integer); override;
199 function mouseEvent (var ev
: THMouseEvent
): Boolean; override;
200 function keyEvent (var ev
: THKeyEvent
): Boolean; override;
204 function uiMouseEvent (ev
: THMouseEvent
): Boolean;
205 function uiKeyEvent (ev
: THKeyEvent
): Boolean;
208 procedure uiAddWindow (ctl
: THControl
);
209 procedure uiRemoveWindow (ctl
: THControl
);
210 function uiVisibleWindow (ctl
: THControl
): Boolean;
214 gh_ui_scale
: Single = 1.0;
220 // ////////////////////////////////////////////////////////////////////////// //
222 uiTopList
: array of THControl
= nil;
225 function uiMouseEvent (ev
: THMouseEvent
): Boolean;
231 ev
.x
:= trunc(ev
.x
/gh_ui_scale
);
232 ev
.y
:= trunc(ev
.y
/gh_ui_scale
);
233 ev
.dx
:= trunc(ev
.dx
/gh_ui_scale
); //FIXME
234 ev
.dy
:= trunc(ev
.dy
/gh_ui_scale
); //FIXME
235 if (Length(uiTopList
) = 0) then result
:= false else result
:= uiTopList
[High(uiTopList
)].mouseEvent(ev
);
236 if not result
and (ev
.press
) then
238 for f
:= High(uiTopList
) downto 0 do
242 if uiTopList
[f
].toLocal(lx
, ly
) then
245 if uiTopList
[f
].mEnabled
and (f
<> High(uiTopList
)) then
247 uiTopList
[High(uiTopList
)].blurred();
248 ctmp
:= uiTopList
[f
];
250 for c
:= f
+1 to High(uiTopList
) do uiTopList
[c
-1] := uiTopList
[c
];
251 uiTopList
[High(uiTopList
)] := ctmp
;
253 result
:= ctmp
.mouseEvent(ev
);
262 function uiKeyEvent (ev
: THKeyEvent
): Boolean;
264 ev
.x
:= trunc(ev
.x
/gh_ui_scale
);
265 ev
.y
:= trunc(ev
.y
/gh_ui_scale
);
266 if (Length(uiTopList
) = 0) then result
:= false else result
:= uiTopList
[High(uiTopList
)].keyEvent(ev
);
267 if (ev
.release
) then begin result
:= true; exit
; end;
276 glMatrixMode(GL_MODELVIEW
);
280 glScalef(gh_ui_scale
, gh_ui_scale
, 1);
281 for f
:= 0 to High(uiTopList
) do
285 if (f
<> High(uiTopList
)) then darkenRect(ctl
.x0
, ctl
.y0
, ctl
.width
, ctl
.height
, 128);
288 glMatrixMode(GL_MODELVIEW
);
294 procedure uiAddWindow (ctl
: THControl
);
298 if (ctl
= nil) then exit
;
300 for f
:= 0 to High(uiTopList
) do
302 if (uiTopList
[f
] = ctl
) then
304 if (f
<> High(uiTopList
)) then
306 uiTopList
[High(uiTopList
)].blurred();
307 for c
:= f
+1 to High(uiTopList
) do uiTopList
[c
-1] := uiTopList
[c
];
308 uiTopList
[High(uiTopList
)] := ctl
;
314 if (Length(uiTopList
) > 0) then uiTopList
[High(uiTopList
)].blurred();
315 SetLength(uiTopList
, Length(uiTopList
)+1);
316 uiTopList
[High(uiTopList
)] := ctl
;
322 procedure uiRemoveWindow (ctl
: THControl
);
326 if (ctl
= nil) then exit
;
328 for f
:= 0 to High(uiTopList
) do
330 if (uiTopList
[f
] = ctl
) then
333 for c
:= f
+1 to High(uiTopList
) do uiTopList
[c
-1] := uiTopList
[c
];
334 SetLength(uiTopList
, Length(uiTopList
)-1);
335 if (ctl
is THTopWindow
) then
337 if assigned(THTopWindow(ctl
).closeCB
) then THTopWindow(ctl
).closeCB(ctl
, 0);
345 function uiVisibleWindow (ctl
: THControl
): Boolean;
350 if (ctl
= nil) then exit
;
352 for f
:= 0 to High(uiTopList
) do
354 if (uiTopList
[f
] = ctl
) then begin result
:= true; exit
; end;
359 // ////////////////////////////////////////////////////////////////////////// //
360 constructor THControl
.Create (ax
, ay
, aw
, ah
: Integer; aparent
: THControl
=nil);
377 mDrawShadow
:= false;
382 destructor THControl
.Destroy ();
386 if (mParent
<> nil) then
389 for f
:= 0 to High(mParent
.mChildren
) do
391 if (mParent
.mChildren
[f
] = self
) then
393 for c
:= f
+1 to High(mParent
.mChildren
) do mParent
.mChildren
[c
-1] := mParent
.mChildren
[c
];
394 SetLength(mParent
.mChildren
, Length(mParent
.mChildren
)-1);
398 for f
:= 0 to High(mChildren
) do
400 mChildren
[f
].mParent
:= nil;
407 procedure THControl
.activated ();
412 procedure THControl
.blurred ();
418 function THControl
.topLevel (): THControl
; inline;
421 while (result
.mParent
<> nil) do result
:= result
.mParent
;
425 function THControl
.getEnabled (): Boolean;
430 if (not mEnabled
) or (mWidth
< 1) or (mHeight
< 1) then exit
;
432 while (ctl
<> nil) do
434 if (not ctl
.mEnabled
) or (ctl
.mWidth
< 1) or (ctl
.mHeight
< 1) then exit
;
441 procedure THControl
.setEnabled (v
: Boolean); inline;
443 if (mEnabled
= v
) then exit
;
445 if not v
and focused
then setFocused(false);
449 function THControl
.getFocused (): Boolean; inline;
451 if (mParent
= nil) then result
:= (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)] = self
) else result
:= (topLevel
.mFocused
= self
);
455 procedure THControl
.setFocused (v
: Boolean); inline;
462 if (tl
.mFocused
= self
) then
465 tl
.mFocused
:= tl
.findNextFocus(self
);
466 if (tl
.mFocused
= self
) then tl
.mFocused
:= nil;
470 if (not mEnabled
) or (not mCanFocus
) then exit
;
471 if (tl
.mFocused
<> self
) then
473 tl
.mFocused
.blurred();
475 if (tl
.mGrab
<> self
) then tl
.mGrab
:= nil;
481 function THControl
.isMyChild (ctl
: THControl
): Boolean;
484 while (ctl
<> nil) do
486 if (ctl
.mParent
= self
) then exit
;
493 // returns `true` if global coords are inside this control
494 function THControl
.toLocal (var x
, y
: Integer): Boolean;
499 while (ctl
<> nil) do
505 result
:= (x
>= 0) and (y
>= 0) and (x
< mWidth
) and (y
< mHeight
);
509 procedure THControl
.toGlobal (var x
, y
: Integer);
514 while (ctl
<> nil) do
523 // x and y are global coords
524 function THControl
.controlAtXY (x
, y
: Integer): THControl
;
530 if (not mEnabled
) or (mWidth
< 1) or (mHeight
< 1) then exit
;
533 if not toLocal(lx
, ly
) then exit
;
534 for f
:= High(mChildren
) downto 0 do
536 result
:= mChildren
[f
].controlAtXY(x
, y
);
537 if (result
<> nil) then exit
;
543 function THControl
.prevSibling (): THControl
;
547 if (mParent
<> nil) then
549 for f
:= 1 to High(mParent
.mChildren
) do
551 if (mParent
.mChildren
[f
] = self
) then begin result
:= mParent
.mChildren
[f
-1]; exit
; end;
557 function THControl
.nextSibling (): THControl
;
561 if (mParent
<> nil) then
563 for f
:= 0 to High(mParent
.mChildren
)-1 do
565 if (mParent
.mChildren
[f
] = self
) then begin result
:= mParent
.mChildren
[f
+1]; exit
; end;
571 function THControl
.firstChild (): THControl
; inline;
573 if (Length(mChildren
) <> 0) then result
:= mChildren
[0] else result
:= nil;
576 function THControl
.lastChild (): THControl
; inline;
578 if (Length(mChildren
) <> 0) then result
:= mChildren
[High(mChildren
)] else result
:= nil;
582 function THControl
.findFirstFocus (): THControl
;
589 for f
:= 0 to High(mChildren
) do
591 result
:= mChildren
[f
].findFirstFocus();
592 if (result
<> nil) then exit
;
594 if mCanFocus
then result
:= self
;
599 function THControl
.findLastFocus (): THControl
;
606 for f
:= High(mChildren
) downto 0 do
608 result
:= mChildren
[f
].findLastFocus();
609 if (result
<> nil) then exit
;
611 if mCanFocus
then result
:= self
;
616 function THControl
.findNextFocus (cur
: THControl
): THControl
;
621 if not isMyChild(cur
) then cur
:= nil;
622 if (cur
= nil) then begin result
:= findFirstFocus(); exit
; end;
623 result
:= cur
.findFirstFocus();
624 if (result
<> nil) and (result
<> cur
) then exit
;
627 cur
:= cur
.nextSibling
;
628 if (cur
= nil) then break
;
629 result
:= cur
.findFirstFocus();
630 if (result
<> nil) then exit
;
632 result
:= findFirstFocus();
637 function THControl
.findPrevFocus (cur
: THControl
): THControl
;
642 if not isMyChild(cur
) then cur
:= nil;
643 if (cur
= nil) then begin result
:= findLastFocus(); exit
; end;
645 result
:= cur
.findLastFocus();
646 if (result
<> nil) and (result
<> cur
) then exit
;
649 cur
:= cur
.prevSibling
;
650 if (cur
= nil) then break
;
651 result
:= cur
.findLastFocus();
652 if (result
<> nil) then exit
;
654 result
:= findLastFocus();
659 procedure THControl
.appendChild (ctl
: THControl
);
661 if (ctl
= nil) then exit
;
662 if (ctl
.mParent
<> nil) then exit
;
663 SetLength(mChildren
, Length(mChildren
)+1);
664 mChildren
[High(mChildren
)] := ctl
;
666 Inc(ctl
.mX
, mFrameWidth
);
667 Inc(ctl
.mY
, mFrameHeight
);
668 if (ctl
.mWidth
> 0) and (ctl
.mHeight
> 0) and
669 (ctl
.mX
+ctl
.mWidth
> mFrameWidth
) and (ctl
.mY
+ctl
.mHeight
> mFrameHeight
) then
671 if (mWidth
+mFrameWidth
< ctl
.mX
+ctl
.mWidth
) then mWidth
:= ctl
.mX
+ctl
.mWidth
+mFrameWidth
;
672 if (mHeight
+mFrameHeight
< ctl
.mY
+ctl
.mHeight
) then mHeight
:= ctl
.mY
+ctl
.mHeight
+mFrameHeight
;
674 if (mFocused
= nil) and ctl
.mEnabled
and ctl
.mCanFocus
and (ctl
.mWidth
> 0) and (ctl
.mHeight
> 0) then mFocused
:= ctl
;
678 procedure THControl
.setScissorGLInternal (x
, y
, w
, h
: Integer);
680 if not scallowed
then exit
;
681 x
:= trunc(x
*gh_ui_scale
);
682 y
:= trunc(y
*gh_ui_scale
);
683 w
:= trunc(w
*gh_ui_scale
);
684 h
:= trunc(h
*gh_ui_scale
);
685 //y := gWinSizeY-(y+h);
686 scis
.setRect(x
, y
, w
, h
);
690 procedure THControl
.resetScissor ();
694 if not scallowed
then exit
;
698 setScissorGLInternal(x
, y
, mWidth
, mHeight
);
702 procedure THControl
.setScissor (lx
, ly
, lw
, lh
: Integer);
706 if not scallowed
then exit
;
707 if not intersectRect(lx
, ly
, lw
, lh
, 0, 0, mWidth
, mHeight
) then begin glScissor(0, 0, 0, 0); exit
; end;
711 setScissorGLInternal(x
, y
, lw
, lh
);
715 procedure THControl
.draw ();
720 if (mWidth
< 1) or (mHeight
< 1) then exit
;
724 //conwritefln('[%s]: (%d,%d)-(%d,%d) (%d,%d)', [ClassName, mX, mY, mWidth, mHeight, x, y]);
726 scis
.save(true); // scissoring enabled
728 //glEnable(GL_SCISSOR_TEST);
732 if (mFrameWidth
<> 0) or (mFrameHeight
<> 0) then setScissor(mFrameWidth
, mFrameHeight
, mWidth
-mFrameWidth
*2, mHeight
-mFrameHeight
*2);
733 for f
:= 0 to High(mChildren
) do mChildren
[f
].draw();
734 if (mFrameWidth
<> 0) or (mFrameHeight
<> 0) then resetScissor();
735 drawControlPost(x
, y
);
743 procedure THControl
.drawControl (sx
, sy
: Integer);
745 if (mParent
= nil) then darkenRect(sx
, sy
, mWidth
, mHeight
, 64);
749 procedure THControl
.drawControlPost (sx
, sy
: Integer);
751 if mDrawShadow
and (mWidth
> 0) and (mHeight
> 0) then
753 setScissorGLInternal(sx
+8, sy
+8, mWidth
, mHeight
);
754 darkenRect(sx
+mWidth
, sy
+8, 8, mHeight
, 128);
755 darkenRect(sx
+8, sy
+mHeight
, mWidth
-8, 8, 128);
760 function THControl
.mouseEvent (var ev
: THMouseEvent
): Boolean;
765 if not mEnabled
then exit
;
766 if (mParent
= nil) then
768 if (mGrab
<> nil) then
770 result
:= mGrab
.mouseEvent(ev
);
771 if (ev
.release
) then mGrab
:= nil;
775 if (mWidth
< 1) or (mHeight
< 1) then exit
;
776 ctl
:= controlAtXY(ev
.x
, ev
.y
);
777 if (ctl
<> nil) and (ctl
<> self
) then
779 if (ctl
<> topLevel
.mFocused
) then ctl
.setFocused(true);
780 result
:= ctl
.mouseEvent(ev
);
782 else if (ctl
= self
) and assigned(actionCB
) then
789 function THControl
.keyEvent (var ev
: THKeyEvent
): Boolean;
794 if not mEnabled
then exit
;
795 if (topLevel
.mFocused
<> self
) and isMyChild(topLevel
.mFocused
) and topLevel
.mFocused
.mEnabled
then result
:= topLevel
.mFocused
.keyEvent(ev
);
796 if (mParent
= nil) then
798 if (ev
= 'S-Tab') then
801 ctl
:= findPrevFocus(mFocused
);
802 if (ctl
<> mFocused
) then
812 ctl
:= findNextFocus(mFocused
);
813 if (ctl
<> mFocused
) then
820 if mEscClose
and (ev
= 'Escape') then
823 uiRemoveWindow(self
);
827 if mEatKeys
then result
:= true;
831 // ////////////////////////////////////////////////////////////////////////// //
832 constructor THTopWindow
.Create (const atitle
: AnsiString; ax
, ay
: Integer; aw
: Integer=-1; ah
: Integer=-1);
834 inherited Create(ax
, ay
, aw
, ah
, nil);
838 if (mWidth
< mFrameWidth
*2+3*8) then mWidth
:= mFrameWidth
*2+3*8;
839 if (mHeight
< mFrameHeight
*2) then mHeight
:= mFrameHeight
*2;
840 if (Length(mTitle
) > 0) then
842 if (mWidth
< Length(mTitle
)*8+mFrameWidth
*2+3*8) then mWidth
:= Length(mTitle
)*8+mFrameWidth
*2+3*8;
846 mWaitingClose
:= false;
852 procedure THTopWindow
.centerInScreen ();
854 if (mWidth
> 0) and (mHeight
> 0) then
856 mX
:= trunc((gScrWidth
/gh_ui_scale
-mWidth
)/2);
857 mY
:= trunc((gScrHeight
/gh_ui_scale
-mHeight
)/2);
862 procedure THTopWindow
.drawControl (sx
, sy
: Integer);
864 fillRect(sx
, sy
, mWidth
, mHeight
, 0, 0, 128);
868 procedure THTopWindow
.drawControlPost (sx
, sy
: Integer);
877 drawRectUI(mX
+4, mY
+4, mWidth
-8, mHeight
-8, r
, g
, b
);
881 drawRectUI(mX
+3, mY
+3, mWidth
-6, mHeight
-6, r
, g
, b
);
882 drawRectUI(mX
+5, mY
+5, mWidth
-10, mHeight
-10, r
, g
, b
);
883 setScissor(mFrameWidth
, 0, 3*8, 8);
884 fillRect(mX
+mFrameWidth
, mY
, 3*8, 8, 0, 0, 128);
885 drawText8(mX
+mFrameWidth
, mY
, '[ ]', r
, g
, b
);
886 if mInClose
then drawText8(mX
+mFrameWidth
+7, mY
, '#', 0, 255, 0)
887 else drawText8(mX
+mFrameWidth
+7, mY
, '*', 0, 255, 0);
889 if (Length(mTitle
) > 0) then
891 setScissor(mFrameWidth
+3*8, 0, mWidth
-mFrameWidth
*2-3*8, 8);
892 tx
:= (mX
+3*8)+((mWidth
-3*8)-Length(mTitle
)*8) div 2;
893 fillRect(tx
-3, mY
, Length(mTitle
)*8+3+2, 8, 0, 0, 128);
894 drawText8(tx
, mY
, mTitle
, r
, g
, b
);
896 inherited drawControlPost(sx
, sy
);
900 procedure THTopWindow
.blurred ();
903 mWaitingClose
:= false;
909 function THTopWindow
.keyEvent (var ev
: THKeyEvent
): Boolean;
911 result
:= inherited keyEvent(ev
);
912 if not getFocused
then exit
;
913 if (ev
= 'M-F3') then
915 uiRemoveWindow(self
);
922 function THTopWindow
.mouseEvent (var ev
: THMouseEvent
): Boolean;
927 if not mEnabled
then exit
;
928 if (mWidth
< 1) or (mHeight
< 1) then exit
;
932 mX
+= ev
.x
-mDragStartX
;
933 mY
+= ev
.y
-mDragStartY
;
936 if (ev
.release
) then mDragging
:= false;
943 if toLocal(lx
, ly
) then
949 if (lx
>= mFrameWidth
) and (lx
< mFrameWidth
+3*8) then
951 //uiRemoveWindow(self);
952 mWaitingClose
:= true;
964 if (lx
< mFrameWidth
) or (lx
>= mWidth
-mFrameWidth
) or (ly
>= mHeight
-mFrameHeight
) then
976 if mWaitingClose
and (lx
>= mFrameWidth
) and (lx
< mFrameWidth
+3*8) then
978 uiRemoveWindow(self
);
982 mWaitingClose
:= false;
988 if mWaitingClose
then
990 mInClose
:= (lx
>= mFrameWidth
) and (lx
< mFrameWidth
+3*8);
999 if (not ev
.motion
) then mWaitingClose
:= false;
1002 result
:= inherited mouseEvent(ev
);
1006 // ////////////////////////////////////////////////////////////////////////// //
1007 constructor THCtlSimpleText
.Create (ax
, ay
: Integer; aparent
: THControl
=nil);
1010 inherited Create(ax
, ay
, 4, 4);
1014 destructor THCtlSimpleText
.Destroy ();
1021 procedure THCtlSimpleText
.appendItem (const atext
: AnsiString; acentered
: Boolean=false; ahline
: Boolean=false);
1025 if (Length(atext
)*8+3*8+2 > mWidth
) then mWidth
:= Length(atext
)*8+3*8+2;
1026 SetLength(mItems
, Length(mItems
)+1);
1027 it
:= @mItems
[High(mItems
)];
1029 it
.centered
:= acentered
;
1031 if (Length(mItems
)*8 > mHeight
) then mHeight
:= Length(mItems
)*8;
1035 procedure THCtlSimpleText
.drawControl (sx
, sy
: Integer);
1041 for f
:= 0 to High(mItems
) do
1048 if it
.centered
then begin b
:= 255; tx
:= sx
+(mWidth
-Length(it
.title
)*8) div 2; end;
1052 if (Length(it
.title
) = 0) then
1054 drawHLine(sx
+4, sy
+3, mWidth
-8, r
, g
, b
);
1056 else if (tx
-3 > sx
+4) then
1058 drawHLine(sx
+4, sy
+3, tx
-3-(sx
+3), r
, g
, b
);
1059 drawHLine(tx
+Length(it
.title
)*8, sy
+3, mWidth
-4, r
, g
, b
);
1062 drawText8(tx
, sy
, it
.title
, r
, g
, b
);
1068 function THCtlSimpleText
.mouseEvent (var ev
: THMouseEvent
): Boolean;
1072 result
:= inherited mouseEvent(ev
);
1075 if not result
and toLocal(lx
, ly
) then
1082 function THCtlSimpleText
.keyEvent (var ev
: THKeyEvent
): Boolean;
1084 result
:= inherited keyEvent(ev
);
1088 // ////////////////////////////////////////////////////////////////////////// //
1089 constructor THCtlCBListBox
.Create (ax
, ay
: Integer; aparent
: THControl
=nil);
1093 inherited Create(ax
, ay
, 4, 4);
1097 destructor THCtlCBListBox
.Destroy ();
1104 procedure THCtlCBListBox
.appendItem (const atext
: AnsiString; bv
: PBoolean; aaction
: TActionCB
=nil);
1108 if (Length(atext
)*8+3*8+2 > mWidth
) then mWidth
:= Length(atext
)*8+3*8+2;
1109 SetLength(mItems
, Length(mItems
)+1);
1110 it
:= @mItems
[High(mItems
)];
1113 it
.actionCB
:= aaction
;
1114 if (Length(mItems
)*8 > mHeight
) then mHeight
:= Length(mItems
)*8;
1115 if (mCurIndex
< 0) then mCurIndex
:= 0;
1119 procedure THCtlCBListBox
.drawControl (sx
, sy
: Integer);
1124 for f
:= 0 to High(mItems
) do
1127 if (mCurIndex
= f
) then fillRect(sx
, sy
, mWidth
, 8, 0, 128, 0);
1128 if (it
.varp
<> nil) then
1130 if it
.varp
^ then drawText8(sx
, sy
, '[x]', 255, 255, 255) else drawText8(sx
, sy
, '[ ]', 255, 255, 255);
1131 drawText8(sx
+3*8+2, sy
, it
.title
, 255, 255, 0);
1133 else if (Length(it
.title
) > 0) then
1135 tx
:= sx
+(mWidth
-Length(it
.title
)*8) div 2;
1136 if (tx
-3 > sx
+4) then
1138 drawHLine(sx
+4, sy
+3, tx
-3-(sx
+3), 255, 255, 255);
1139 drawHLine(tx
+Length(it
.title
)*8, sy
+3, mWidth
-4, 255, 255, 255);
1141 drawText8(tx
, sy
, it
.title
, 255, 255, 255);
1145 drawHLine(sx
+4, sy
+3, mWidth
-8, 255, 255, 255);
1152 function THCtlCBListBox
.mouseEvent (var ev
: THMouseEvent
): Boolean;
1157 result
:= inherited mouseEvent(ev
);
1160 if not result
and toLocal(lx
, ly
) then
1163 if (ev
= 'lmb') then
1166 if (ly
>= 0) and (ly
< Length(mItems
)) then
1169 if (it
.varp
<> nil) then
1172 it
.varp
^ := not it
.varp
^;
1173 if assigned(it
.actionCB
) then it
.actionCB(self
, Integer(it
.varp
^));
1174 if assigned(actionCB
) then actionCB(self
, ly
);
1182 function THCtlCBListBox
.keyEvent (var ev
: THKeyEvent
): Boolean;
1186 result
:= inherited keyEvent(ev
);
1187 if not getFocused
then exit
;
1189 if (ev
= 'Home') or (ev
= 'PageUp') then
1194 if (ev
= 'End') or (ev
= 'PageDown') then
1197 mCurIndex
:= High(mItems
);
1202 if (Length(mItems
) > 0) then
1204 if (mCurIndex
< 0) then mCurIndex
:= Length(mItems
);
1205 while (mCurIndex
> 0) do
1208 if (mItems
[mCurIndex
].varp
<> nil) then break
;
1216 if (ev
= 'Down') then
1219 if (Length(mItems
) > 0) then
1221 if (mCurIndex
< 0) then mCurIndex
:= -1;
1222 while (mCurIndex
< High(mItems
)) do
1225 if (mItems
[mCurIndex
].varp
<> nil) then break
;
1233 if (ev
= 'Space') or (ev
= 'Enter') then
1236 if (mCurIndex
>= 0) and (mCurIndex
< Length(mItems
)) and (mItems
[mCurIndex
].varp
<> nil) then
1238 it
:= @mItems
[mCurIndex
];
1239 it
.varp
^ := not it
.varp
^;
1240 if assigned(it
.actionCB
) then it
.actionCB(self
, Integer(it
.varp
^));
1241 if assigned(actionCB
) then actionCB(self
, mCurIndex
);