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}
30 // ////////////////////////////////////////////////////////////////////////// //
32 THControlClass
= class of THControl
;
36 type TActionCB
= procedure (me
: THControl
; uinfo
: Integer);
41 mWidth
, mHeight
: Integer;
42 mFrameWidth
, mFrameHeight
: Integer;
45 mChildren
: array of THControl
;
46 mFocused
: THControl
; // valid only for top-level controls
47 mGrab
: THControl
; // valid only for top-level controls
48 mEscClose
: Boolean; // valid only for top-level controls
57 function getEnabled (): Boolean;
58 procedure setEnabled (v
: Boolean); inline;
60 function getFocused (): Boolean; inline;
61 procedure setFocused (v
: Boolean); inline;
63 function isMyChild (ctl
: THControl
): Boolean;
65 function findFirstFocus (): THControl
;
66 function findLastFocus (): THControl
;
68 function findNextFocus (cur
: THControl
): THControl
;
69 function findPrevFocus (cur
: THControl
): THControl
;
71 procedure activated (); virtual;
72 procedure blurred (); virtual;
74 //WARNING! do not call scissor functions outside `.draw*()` API!
75 // reset scissor to whole control
76 procedure resetScissor ();
77 // set scissor to this internal rect (in local coords)
78 procedure setScissor (lx
, ly
, lw
, lh
: Integer);
81 procedure setScissorGLInternal (x
, y
, w
, h
: Integer);
87 mDefSize
: TLaySize
; // default size
88 mMaxSize
: TLaySize
; // maximum size
97 mLayDefSize
: TLaySize
;
98 mLayMaxSize
: TLaySize
;
101 // layouter interface
102 function getDefSize (): TLaySize
; inline; // default size; <0: use max size
103 //procedure setDefSize (const sz: TLaySize); inline; // default size; <0: use max size
104 function getMargins (): TLayMargins
; inline;
105 function getMaxSize (): TLaySize
; inline; // max size; <0: set to some huge value
106 //procedure setMaxSize (const sz: TLaySize); inline; // max size; <0: set to some huge value
107 function getFlex (): Integer; inline; // <=0: not flexible
108 function isHorizBox (): Boolean; inline; // horizontal layout for children?
109 procedure setHorizBox (v
: Boolean); inline; // horizontal layout for children?
110 function canWrap (): Boolean; inline; // for horizontal boxes: can wrap children? for child: `false` means 'nonbreakable at *next* ctl'
111 procedure setCanWrap (v
: Boolean); inline; // for horizontal boxes: can wrap children? for child: `false` means 'nonbreakable at *next* ctl'
112 function isLineStart (): Boolean; inline; // `true` if this ctl should start a new line; ignored for vertical boxes
113 procedure setLineStart (v
: Boolean); inline; // `true` if this ctl should start a new line; ignored for vertical boxes
114 function getAlign (): Integer; inline; // aligning in non-main direction: <0: left/up; 0: center; >0: right/down
115 procedure setAlign (v
: Integer); inline; // aligning in non-main direction: <0: left/up; 0: center; >0: right/down
116 function getExpand (): Boolean; inline; // expanding in non-main direction: `true` will ignore align and eat all available space
117 procedure setExpand (v
: Boolean); inline; // expanding in non-main direction: `true` will ignore align and eat all available space
118 function getHGroup (): AnsiString; inline; // empty: not grouped
119 procedure setHGroup (const v
: AnsiString); inline; // empty: not grouped
120 function getVGroup (): AnsiString; inline; // empty: not grouped
121 procedure setVGroup (const v
: AnsiString); inline; // empty: not grouped
123 procedure setActualSizePos (constref apos
: TLayPos
; constref asize
: TLaySize
); inline;
125 procedure layPrepare (); virtual; // called before registering control in layouter
128 property flex
: Integer read mFlex write mFlex
;
129 property flDefaultSize
: TLaySize read mDefSize write mDefSize
;
130 property flMaxSize
: TLaySize read mMaxSize write mMaxSize
;
131 property flHoriz
: Boolean read isHorizBox write setHorizBox
;
132 property flCanWrap
: Boolean read canWrap write setCanWrap
;
133 property flLineStart
: Boolean read isLineStart write setLineStart
;
134 property flAlign
: Integer read getAlign write setAlign
;
135 property flExpand
: Boolean read getExpand write setExpand
;
136 property flHGroup
: AnsiString read getHGroup write setHGroup
;
137 property flVGroup
: AnsiString read getVGroup write setVGroup
;
140 function parsePos (par
: TTextParser
): TLayPos
;
141 function parseSize (par
: TTextParser
): TLaySize
;
142 function parseBool (par
: TTextParser
): Boolean;
143 function parseAnyAlign (par
: TTextParser
): Integer;
144 function parseHAlign (par
: TTextParser
): Integer;
145 function parseVAlign (par
: TTextParser
): Integer;
146 procedure parseTextAlign (par
: TTextParser
; var h
, v
: Integer);
147 procedure parseChildren (par
: TTextParser
); // par should be on '{'; final '}' is eaten
150 // par is on property data
151 // there may be more data in text stream, don't eat it!
152 // return `true` if property name is valid and value was parsed
153 // return `false` if property name is invalid; don't advance parser in this case
154 // throw on property data errors
155 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; virtual;
157 // par should be on '{'; final '}' is eaten
158 procedure parseProperties (par
: TTextParser
);
161 constructor Create ();
162 constructor Create (aparent
: THControl
);
163 constructor Create (ax
, ay
, aw
, ah
: Integer; aparent
: THControl
=nil);
164 destructor Destroy (); override;
166 // `sx` and `sy` are screen coordinates
167 procedure drawControl (sx
, sy
: Integer); virtual;
169 // called after all children drawn
170 procedure drawControlPost (sx
, sy
: Integer); virtual;
172 procedure draw (); virtual;
174 function topLevel (): THControl
; inline;
176 // returns `true` if global coords are inside this control
177 function toLocal (var x
, y
: Integer): Boolean;
178 procedure toGlobal (var x
, y
: Integer);
180 // x and y are global coords
181 function controlAtXY (x
, y
: Integer): THControl
;
183 function mouseEvent (var ev
: THMouseEvent
): Boolean; virtual; // returns `true` if event was eaten
184 function keyEvent (var ev
: THKeyEvent
): Boolean; virtual; // returns `true` if event was eaten
186 function prevSibling (): THControl
;
187 function nextSibling (): THControl
;
188 function firstChild (): THControl
; inline;
189 function lastChild (): THControl
; inline;
191 procedure appendChild (ctl
: THControl
); virtual;
194 property x0
: Integer read mX
;
195 property y0
: Integer read mY
;
196 property height
: Integer read mHeight
;
197 property width
: Integer read mWidth
;
198 property enabled
: Boolean read getEnabled write setEnabled
;
199 property parent
: THControl read mParent
;
200 property focused
: Boolean read getFocused write setFocused
;
201 property escClose
: Boolean read mEscClose write mEscClose
;
202 property eatKeys
: Boolean read mEatKeys write mEatKeys
;
206 THTopWindow
= class(THControl
)
210 mDragStartX
, mDragStartY
: Integer;
211 mWaitingClose
: Boolean;
213 mFreeOnClose
: Boolean; // default: false
216 procedure blurred (); override;
219 closeCB
: TActionCB
; // called after window was removed from ui window list
222 constructor Create (const atitle
: AnsiString; ax
, ay
: Integer; aw
: Integer=-1; ah
: Integer=-1);
224 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
226 procedure centerInScreen ();
228 // `sx` and `sy` are screen coordinates
229 procedure drawControl (sx
, sy
: Integer); override;
230 procedure drawControlPost (sx
, sy
: Integer); override;
232 function keyEvent (var ev
: THKeyEvent
): Boolean; override; // returns `true` if event was eaten
233 function mouseEvent (var ev
: THMouseEvent
): Boolean; override; // returns `true` if event was eaten
236 property freeOnClose
: Boolean read mFreeOnClose write mFreeOnClose
;
240 THCtlSimpleText
= class(THControl
)
250 mItems
: array of TItem
;
253 constructor Create (ax
, ay
: Integer; aparent
: THControl
=nil);
254 destructor Destroy (); override;
256 procedure appendItem (const atext
: AnsiString; acentered
: Boolean=false; ahline
: Boolean=false);
258 procedure drawControl (sx
, sy
: Integer); override;
260 function mouseEvent (var ev
: THMouseEvent
): Boolean; override;
261 function keyEvent (var ev
: THKeyEvent
): Boolean; override;
265 THCtlCBListBox
= class(THControl
)
275 mItems
: array of TItem
;
279 constructor Create (ax
, ay
: Integer; aparent
: THControl
=nil);
280 destructor Destroy (); override;
282 procedure appendItem (const atext
: AnsiString; bv
: PBoolean; aaction
: TActionCB
=nil);
284 procedure drawControl (sx
, sy
: Integer); override;
286 function mouseEvent (var ev
: THMouseEvent
): Boolean; override;
287 function keyEvent (var ev
: THKeyEvent
): Boolean; override;
290 // ////////////////////////////////////////////////////////////////////// //
291 THCtlBox
= class(THControl
)
294 mCaption
: AnsiString;
297 constructor Create (ahoriz
: Boolean; aparent
: THControl
=nil);
298 //destructor Destroy (); override;
300 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
302 procedure drawControl (sx
, sy
: Integer); override;
304 function mouseEvent (var ev
: THMouseEvent
): Boolean; override;
305 function keyEvent (var ev
: THKeyEvent
): Boolean; override;
308 THCtlHBox
= class(THCtlBox
)
310 constructor Create (aparent
: THControl
=nil);
313 THCtlVBox
= class(THCtlBox
)
315 constructor Create (aparent
: THControl
=nil);
319 THCtlTextLabel
= class(THControl
)
322 mHAlign
: Integer; // -1: left; 0: center; 1: right; default: left
323 mVAlign
: Integer; // -1: top; 0: center; 1: bottom; default: center
326 constructor Create (const atext
: AnsiString; aparent
: THControl
=nil);
327 //destructor Destroy (); override;
329 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
331 procedure drawControl (sx
, sy
: Integer); override;
333 function mouseEvent (var ev
: THMouseEvent
): Boolean; override;
334 function keyEvent (var ev
: THKeyEvent
): Boolean; override;
338 // ////////////////////////////////////////////////////////////////////////// //
339 function uiMouseEvent (ev
: THMouseEvent
): Boolean;
340 function uiKeyEvent (ev
: THKeyEvent
): Boolean;
344 // ////////////////////////////////////////////////////////////////////////// //
345 procedure uiAddWindow (ctl
: THControl
);
346 procedure uiRemoveWindow (ctl
: THControl
); // will free window if `mFreeOnClose` is `true`
347 function uiVisibleWindow (ctl
: THControl
): Boolean;
350 // ////////////////////////////////////////////////////////////////////////// //
352 procedure uiLayoutCtl (ctl
: THControl
);
355 // ////////////////////////////////////////////////////////////////////////// //
357 gh_ui_scale
: Single = 1.0;
367 // ////////////////////////////////////////////////////////////////////////// //
369 knownCtlClasses
: array of record
370 klass
: THControlClass
;
375 procedure registerCtlClass (aklass
: THControlClass
; const aname
: AnsiString);
377 assert(aklass
<> nil);
378 assert(Length(aname
) > 0);
379 SetLength(knownCtlClasses
, Length(knownCtlClasses
)+1);
380 knownCtlClasses
[High(knownCtlClasses
)].klass
:= aklass
;
381 knownCtlClasses
[High(knownCtlClasses
)].name
:= aname
;
385 function findCtlClass (const aname
: AnsiString): THControlClass
;
389 for f
:= 0 to High(knownCtlClasses
) do
391 if (strEquCI1251(aname
, knownCtlClasses
[f
].name
)) then
393 result
:= knownCtlClasses
[f
].klass
;
401 // ////////////////////////////////////////////////////////////////////////// //
403 TFlexLayouter
= specialize TFlexLayouterBase
<THControl
>;
405 procedure uiLayoutCtl (ctl
: THControl
);
409 if (ctl
= nil) then exit
;
410 lay
:= TFlexLayouter
.Create();
415 writeln('============================');
418 writeln('=== initial ===');
421 //lay.calcMaxSizeInternal(0);
424 writeln('=== after first pass ===');
428 writeln('=== after second pass ===');
433 writeln('=== final ===');
442 // ////////////////////////////////////////////////////////////////////////// //
444 uiTopList
: array of THControl
= nil;
447 function uiMouseEvent (ev
: THMouseEvent
): Boolean;
453 ev
.x
:= trunc(ev
.x
/gh_ui_scale
);
454 ev
.y
:= trunc(ev
.y
/gh_ui_scale
);
455 ev
.dx
:= trunc(ev
.dx
/gh_ui_scale
); //FIXME
456 ev
.dy
:= trunc(ev
.dy
/gh_ui_scale
); //FIXME
457 if (Length(uiTopList
) = 0) then result
:= false else result
:= uiTopList
[High(uiTopList
)].mouseEvent(ev
);
458 if not result
and (ev
.press
) then
460 for f
:= High(uiTopList
) downto 0 do
464 if uiTopList
[f
].toLocal(lx
, ly
) then
467 if uiTopList
[f
].mEnabled
and (f
<> High(uiTopList
)) then
469 uiTopList
[High(uiTopList
)].blurred();
470 ctmp
:= uiTopList
[f
];
472 for c
:= f
+1 to High(uiTopList
) do uiTopList
[c
-1] := uiTopList
[c
];
473 uiTopList
[High(uiTopList
)] := ctmp
;
475 result
:= ctmp
.mouseEvent(ev
);
484 function uiKeyEvent (ev
: THKeyEvent
): Boolean;
486 ev
.x
:= trunc(ev
.x
/gh_ui_scale
);
487 ev
.y
:= trunc(ev
.y
/gh_ui_scale
);
488 if (Length(uiTopList
) = 0) then result
:= false else result
:= uiTopList
[High(uiTopList
)].keyEvent(ev
);
489 if (ev
.release
) then begin result
:= true; exit
; end;
498 glMatrixMode(GL_MODELVIEW
);
502 glScalef(gh_ui_scale
, gh_ui_scale
, 1);
503 for f
:= 0 to High(uiTopList
) do
507 if (f
<> High(uiTopList
)) then darkenRect(ctl
.x0
, ctl
.y0
, ctl
.width
, ctl
.height
, 128);
510 glMatrixMode(GL_MODELVIEW
);
516 procedure uiAddWindow (ctl
: THControl
);
520 if (ctl
= nil) then exit
;
522 if not (ctl
is THTopWindow
) then exit
; // alas
523 for f
:= 0 to High(uiTopList
) do
525 if (uiTopList
[f
] = ctl
) then
527 if (f
<> High(uiTopList
)) then
529 uiTopList
[High(uiTopList
)].blurred();
530 for c
:= f
+1 to High(uiTopList
) do uiTopList
[c
-1] := uiTopList
[c
];
531 uiTopList
[High(uiTopList
)] := ctl
;
537 if (Length(uiTopList
) > 0) then uiTopList
[High(uiTopList
)].blurred();
538 SetLength(uiTopList
, Length(uiTopList
)+1);
539 uiTopList
[High(uiTopList
)] := ctl
;
544 procedure uiRemoveWindow (ctl
: THControl
);
548 if (ctl
= nil) then exit
;
550 if not (ctl
is THTopWindow
) then exit
; // alas
551 for f
:= 0 to High(uiTopList
) do
553 if (uiTopList
[f
] = ctl
) then
556 for c
:= f
+1 to High(uiTopList
) do uiTopList
[c
-1] := uiTopList
[c
];
557 SetLength(uiTopList
, Length(uiTopList
)-1);
558 if (ctl
is THTopWindow
) then
561 if assigned(THTopWindow(ctl
).closeCB
) then THTopWindow(ctl
).closeCB(ctl
, 0);
563 if (THTopWindow(ctl
).mFreeOnClose
) then FreeAndNil(ctl
);
572 function uiVisibleWindow (ctl
: THControl
): Boolean;
577 if (ctl
= nil) then exit
;
579 if not (ctl
is THTopWindow
) then exit
; // alas
580 for f
:= 0 to High(uiTopList
) do
582 if (uiTopList
[f
] = ctl
) then begin result
:= true; exit
; end;
587 // ////////////////////////////////////////////////////////////////////////// //
588 constructor THControl
.Create ();
605 mDrawShadow
:= false;
607 // layouter interface
608 mDefSize
:= TLaySize
.Create(64, 8); // default size
609 mMaxSize
:= TLaySize
.Create(-1, -1); // maximum size
616 mAlign
:= -1; // left/top
621 constructor THControl
.Create (ax
, ay
, aw
, ah
: Integer; aparent
: THControl
=nil);
631 constructor THControl
.Create (aparent
: THControl
);
638 destructor THControl
.Destroy ();
642 if (mParent
<> nil) then
645 for f
:= 0 to High(mParent
.mChildren
) do
647 if (mParent
.mChildren
[f
] = self
) then
649 for c
:= f
+1 to High(mParent
.mChildren
) do mParent
.mChildren
[c
-1] := mParent
.mChildren
[c
];
650 SetLength(mParent
.mChildren
, Length(mParent
.mChildren
)-1);
654 for f
:= 0 to High(mChildren
) do
656 mChildren
[f
].mParent
:= nil;
663 // ////////////////////////////////////////////////////////////////////////// //
664 function THControl
.getDefSize (): TLaySize
; inline; begin result
:= mLayDefSize
; end;
665 function THControl
.getMaxSize (): TLaySize
; inline; begin result
:= mLayMaxSize
; end;
666 function THControl
.getFlex (): Integer; inline; begin result
:= mFlex
; end;
667 function THControl
.isHorizBox (): Boolean; inline; begin result
:= mHoriz
; end;
668 procedure THControl
.setHorizBox (v
: Boolean); inline; begin mHoriz
:= v
; end;
669 function THControl
.canWrap (): Boolean; inline; begin result
:= mCanWrap
; end;
670 procedure THControl
.setCanWrap (v
: Boolean); inline; begin mCanWrap
:= v
; end;
671 function THControl
.isLineStart (): Boolean; inline; begin result
:= mLineStart
; end;
672 procedure THControl
.setLineStart (v
: Boolean); inline; begin mLineStart
:= v
; end;
673 function THControl
.getAlign (): Integer; inline; begin result
:= mAlign
; end;
674 procedure THControl
.setAlign (v
: Integer); inline; begin mAlign
:= v
; end;
675 function THControl
.getExpand (): Boolean; inline; begin result
:= mExpand
; end;
676 procedure THControl
.setExpand (v
: Boolean); inline; begin mExpand
:= v
; end;
677 function THControl
.getHGroup (): AnsiString; inline; begin result
:= mHGroup
; end;
678 procedure THControl
.setHGroup (const v
: AnsiString); inline; begin mHGroup
:= v
; end;
679 function THControl
.getVGroup (): AnsiString; inline; begin result
:= mVGroup
; end;
680 procedure THControl
.setVGroup (const v
: AnsiString); inline; begin mVGroup
:= v
; end;
682 function THControl
.getMargins (): TLayMargins
; inline;
684 result
:= TLayMargins
.Create(mFrameHeight
, mFrameWidth
, mFrameHeight
, mFrameWidth
);
687 procedure THControl
.setActualSizePos (constref apos
: TLayPos
; constref asize
: TLaySize
); inline; begin
688 if (mParent
<> nil) then
697 procedure THControl
.layPrepare ();
699 mLayDefSize
:= mDefSize
;
700 mLayMaxSize
:= mMaxSize
;
701 if (mLayMaxSize
.w
>= 0) then mLayMaxSize
.w
+= mFrameWidth
*2;
702 if (mLayMaxSize
.h
>= 0) then mLayMaxSize
.h
+= mFrameHeight
*2;
706 // ////////////////////////////////////////////////////////////////////////// //
707 function THControl
.parsePos (par
: TTextParser
): TLayPos
;
711 if (par
.eatDelim('[')) then ech
:= ']' else par
.expectDelim('(');
712 result
.x
:= par
.expectInt();
713 par
.eatDelim(','); // optional comma
714 result
.y
:= par
.expectInt();
715 par
.eatDelim(','); // optional comma
716 par
.expectDelim(ech
);
719 function THControl
.parseSize (par
: TTextParser
): TLaySize
;
723 if (par
.eatDelim('[')) then ech
:= ']' else par
.expectDelim('(');
724 result
.h
:= par
.expectInt();
725 par
.eatDelim(','); // optional comma
726 result
.w
:= par
.expectInt();
727 par
.eatDelim(','); // optional comma
728 par
.expectDelim(ech
);
731 function THControl
.parseBool (par
: TTextParser
): Boolean;
734 par
.eatIdOrStr('true', false) or
735 par
.eatIdOrStr('yes', false) or
736 par
.eatIdOrStr('tan', false);
739 if (not par
.eatIdOrStr('false', false)) and (not par
.eatIdOrStr('no', false)) and (not par
.eatIdOrStr('ona', false)) then
741 par
.error('boolean value expected');
746 function THControl
.parseAnyAlign (par
: TTextParser
): Integer;
748 if (par
.eatIdOrStr('left', false)) or (par
.eatIdOrStr('top', false)) then result
:= -1
749 else if (par
.eatIdOrStr('right', false)) or (par
.eatIdOrStr('bottom', false)) then result
:= 1
750 else if (par
.eatIdOrStr('center', false)) then result
:= 0
751 else par
.error('invalid align value');
754 function THControl
.parseHAlign (par
: TTextParser
): Integer;
756 if (par
.eatIdOrStr('left', false)) then result
:= -1
757 else if (par
.eatIdOrStr('right', false)) then result
:= 1
758 else if (par
.eatIdOrStr('center', false)) then result
:= 0
759 else par
.error('invalid horizontal align value');
762 function THControl
.parseVAlign (par
: TTextParser
): Integer;
764 if (par
.eatIdOrStr('top', false)) then result
:= -1
765 else if (par
.eatIdOrStr('bottom', false)) then result
:= 1
766 else if (par
.eatIdOrStr('center', false)) then result
:= 0
767 else par
.error('invalid vertical align value');
770 procedure THControl
.parseTextAlign (par
: TTextParser
; var h
, v
: Integer);
772 wasH
: Boolean = false;
773 wasV
: Boolean = false;
777 if (par
.eatIdOrStr('left', false)) then
779 if wasH
then par
.error('too many align directives');
784 if (par
.eatIdOrStr('right', false)) then
786 if wasH
then par
.error('too many align directives');
791 if (par
.eatIdOrStr('hcenter', false)) then
793 if wasH
then par
.error('too many align directives');
798 if (par
.eatIdOrStr('top', false)) then
800 if wasV
then par
.error('too many align directives');
805 if (par
.eatIdOrStr('bottom', false)) then
807 if wasV
then par
.error('too many align directives');
812 if (par
.eatIdOrStr('vcenter', false)) then
814 if wasV
then par
.error('too many align directives');
819 if (par
.eatIdOrStr('center', false)) then
821 if wasV
or wasH
then par
.error('too many align directives');
830 if not wasV
and not wasH
then par
.error('invalid align value');
833 // par should be on '{'; final '}' is eaten
834 procedure THControl
.parseProperties (par
: TTextParser
);
838 if (not par
.eatDelim('{')) then exit
;
839 while (not par
.eatDelim('}')) do
841 if (par
.tokType
<> par
.TTId
) and (par
.tokType
<> par
.TTStr
) then par
.error('property name expected');
844 par
.eatDelim(':'); // optional
845 if not parseProperty(pn
, par
) then par
.errorfmt('invalid property name ''%s''', [pn
]);
846 par
.eatDelim(','); // optional
850 // par should be on '{'
851 procedure THControl
.parseChildren (par
: TTextParser
);
856 par
.expectDelim('{');
857 while (not par
.eatDelim('}')) do
859 if (par
.tokType
<> par
.TTId
) then par
.error('control name expected');
860 cc
:= findCtlClass(par
.tokStr
);
861 if (cc
= nil) then par
.errorfmt('unknown control name: ''%s''', [par
.tokStr
]);
862 //writeln('children for <', par.tokStr, '>: <', cc.className, '>');
864 par
.eatDelim(':'); // optional
865 ctl
:= cc
.Create(nil);
867 ctl
.parseProperties(par
);
872 //writeln(': ', ctl.mDefSize.toString);
874 par
.eatDelim(','); // optional
879 function THControl
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
882 if (strEquCI1251(prname
, 'flex')) then begin flex
:= par
.expectInt(); exit
; end;
884 if (strEquCI1251(prname
, 'defsize')) then begin mDefSize
:= parseSize(par
); exit
; end;
885 if (strEquCI1251(prname
, 'maxsize')) then begin mMaxSize
:= parseSize(par
); exit
; end;
886 if (strEquCI1251(prname
, 'wrap')) then begin mCanWrap
:= parseBool(par
); exit
; end;
887 if (strEquCI1251(prname
, 'linestart')) then begin mLineStart
:= parseBool(par
); exit
; end;
888 if (strEquCI1251(prname
, 'expand')) then begin mExpand
:= parseBool(par
); exit
; end;
890 if (strEquCI1251(prname
, 'align')) then begin mAlign
:= parseAnyAlign(par
); exit
; end;
891 if (strEquCI1251(prname
, 'hgroup')) then begin mHGroup
:= par
.expectStrOrId(true); exit
; end; // allow empty strings
892 if (strEquCI1251(prname
, 'vgroup')) then begin mVGroup
:= par
.expectStrOrId(true); exit
; end; // allow empty strings
894 if (strEquCI1251(prname
, 'canfocus')) then begin mCanFocus
:= parseBool(par
); exit
; end;
895 if (strEquCI1251(prname
, 'enabled')) then begin mEnabled
:= parseBool(par
); exit
; end;
896 if (strEquCI1251(prname
, 'disabled')) then begin mEnabled
:= not parseBool(par
); exit
; end;
897 if (strEquCI1251(prname
, 'escclose')) then begin mEscClose
:= not parseBool(par
); exit
; end;
898 if (strEquCI1251(prname
, 'eatkeys')) then begin mEatKeys
:= not parseBool(par
); exit
; end;
903 // ////////////////////////////////////////////////////////////////////////// //
904 procedure THControl
.activated ();
909 procedure THControl
.blurred ();
915 function THControl
.topLevel (): THControl
; inline;
918 while (result
.mParent
<> nil) do result
:= result
.mParent
;
922 function THControl
.getEnabled (): Boolean;
927 if (not mEnabled
) or (mWidth
< 1) or (mHeight
< 1) then exit
;
929 while (ctl
<> nil) do
931 if (not ctl
.mEnabled
) or (ctl
.mWidth
< 1) or (ctl
.mHeight
< 1) then exit
;
938 procedure THControl
.setEnabled (v
: Boolean); inline;
940 if (mEnabled
= v
) then exit
;
942 if not v
and focused
then setFocused(false);
946 function THControl
.getFocused (): Boolean; inline;
948 if (mParent
= nil) then result
:= (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)] = self
) else result
:= (topLevel
.mFocused
= self
);
952 procedure THControl
.setFocused (v
: Boolean); inline;
959 if (tl
.mFocused
= self
) then
962 tl
.mFocused
:= tl
.findNextFocus(self
);
963 if (tl
.mFocused
= self
) then tl
.mFocused
:= nil;
967 if (not mEnabled
) or (not mCanFocus
) then exit
;
968 if (tl
.mFocused
<> self
) then
970 tl
.mFocused
.blurred();
972 if (tl
.mGrab
<> self
) then tl
.mGrab
:= nil;
978 function THControl
.isMyChild (ctl
: THControl
): Boolean;
981 while (ctl
<> nil) do
983 if (ctl
.mParent
= self
) then exit
;
990 // returns `true` if global coords are inside this control
991 function THControl
.toLocal (var x
, y
: Integer): Boolean;
996 while (ctl
<> nil) do
1002 result
:= (x
>= 0) and (y
>= 0) and (x
< mWidth
) and (y
< mHeight
);
1006 procedure THControl
.toGlobal (var x
, y
: Integer);
1011 while (ctl
<> nil) do
1020 // x and y are global coords
1021 function THControl
.controlAtXY (x
, y
: Integer): THControl
;
1027 if (not mEnabled
) or (mWidth
< 1) or (mHeight
< 1) then exit
;
1030 if not toLocal(lx
, ly
) then exit
;
1031 for f
:= High(mChildren
) downto 0 do
1033 result
:= mChildren
[f
].controlAtXY(x
, y
);
1034 if (result
<> nil) then exit
;
1040 function THControl
.prevSibling (): THControl
;
1044 if (mParent
<> nil) then
1046 for f
:= 1 to High(mParent
.mChildren
) do
1048 if (mParent
.mChildren
[f
] = self
) then begin result
:= mParent
.mChildren
[f
-1]; exit
; end;
1054 function THControl
.nextSibling (): THControl
;
1058 if (mParent
<> nil) then
1060 for f
:= 0 to High(mParent
.mChildren
)-1 do
1062 if (mParent
.mChildren
[f
] = self
) then begin result
:= mParent
.mChildren
[f
+1]; exit
; end;
1068 function THControl
.firstChild (): THControl
; inline;
1070 if (Length(mChildren
) <> 0) then result
:= mChildren
[0] else result
:= nil;
1073 function THControl
.lastChild (): THControl
; inline;
1075 if (Length(mChildren
) <> 0) then result
:= mChildren
[High(mChildren
)] else result
:= nil;
1079 function THControl
.findFirstFocus (): THControl
;
1086 for f
:= 0 to High(mChildren
) do
1088 result
:= mChildren
[f
].findFirstFocus();
1089 if (result
<> nil) then exit
;
1091 if mCanFocus
then result
:= self
;
1096 function THControl
.findLastFocus (): THControl
;
1103 for f
:= High(mChildren
) downto 0 do
1105 result
:= mChildren
[f
].findLastFocus();
1106 if (result
<> nil) then exit
;
1108 if mCanFocus
then result
:= self
;
1113 function THControl
.findNextFocus (cur
: THControl
): THControl
;
1118 if not isMyChild(cur
) then cur
:= nil;
1119 if (cur
= nil) then begin result
:= findFirstFocus(); exit
; end;
1120 result
:= cur
.findFirstFocus();
1121 if (result
<> nil) and (result
<> cur
) then exit
;
1124 cur
:= cur
.nextSibling
;
1125 if (cur
= nil) then break
;
1126 result
:= cur
.findFirstFocus();
1127 if (result
<> nil) then exit
;
1129 result
:= findFirstFocus();
1134 function THControl
.findPrevFocus (cur
: THControl
): THControl
;
1139 if not isMyChild(cur
) then cur
:= nil;
1140 if (cur
= nil) then begin result
:= findLastFocus(); exit
; end;
1142 result
:= cur
.findLastFocus();
1143 if (result
<> nil) and (result
<> cur
) then exit
;
1146 cur
:= cur
.prevSibling
;
1147 if (cur
= nil) then break
;
1148 result
:= cur
.findLastFocus();
1149 if (result
<> nil) then exit
;
1151 result
:= findLastFocus();
1156 procedure THControl
.appendChild (ctl
: THControl
);
1158 if (ctl
= nil) then exit
;
1159 if (ctl
.mParent
<> nil) then exit
;
1160 SetLength(mChildren
, Length(mChildren
)+1);
1161 mChildren
[High(mChildren
)] := ctl
;
1162 ctl
.mParent
:= self
;
1163 Inc(ctl
.mX
, mFrameWidth
);
1164 Inc(ctl
.mY
, mFrameHeight
);
1165 if (ctl
.mWidth
> 0) and (ctl
.mHeight
> 0) and
1166 (ctl
.mX
+ctl
.mWidth
> mFrameWidth
) and (ctl
.mY
+ctl
.mHeight
> mFrameHeight
) then
1168 if (mWidth
+mFrameWidth
< ctl
.mX
+ctl
.mWidth
) then mWidth
:= ctl
.mX
+ctl
.mWidth
+mFrameWidth
;
1169 if (mHeight
+mFrameHeight
< ctl
.mY
+ctl
.mHeight
) then mHeight
:= ctl
.mY
+ctl
.mHeight
+mFrameHeight
;
1171 if (mFocused
= nil) and ctl
.mEnabled
and ctl
.mCanFocus
and (ctl
.mWidth
> 0) and (ctl
.mHeight
> 0) then mFocused
:= ctl
;
1175 procedure THControl
.setScissorGLInternal (x
, y
, w
, h
: Integer);
1177 if not scallowed
then exit
;
1178 x
:= trunc(x
*gh_ui_scale
);
1179 y
:= trunc(y
*gh_ui_scale
);
1180 w
:= trunc(w
*gh_ui_scale
);
1181 h
:= trunc(h
*gh_ui_scale
);
1182 //y := gWinSizeY-(y+h);
1183 scis
.setRect(x
, y
, w
, h
);
1187 procedure THControl
.resetScissor ();
1191 if not scallowed
then exit
;
1195 setScissorGLInternal(x
, y
, mWidth
, mHeight
);
1199 procedure THControl
.setScissor (lx
, ly
, lw
, lh
: Integer);
1203 if not scallowed
then exit
;
1204 if not intersectRect(lx
, ly
, lw
, lh
, 0, 0, mWidth
, mHeight
) then begin glScissor(0, 0, 0, 0); exit
; end;
1208 setScissorGLInternal(x
, y
, lw
, lh
);
1212 procedure THControl
.draw ();
1217 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1221 //conwritefln('[%s]: (%d,%d)-(%d,%d) (%d,%d)', [ClassName, mX, mY, mWidth, mHeight, x, y]);
1223 scis
.save(true); // scissoring enabled
1225 //glEnable(GL_SCISSOR_TEST);
1229 if (mFrameWidth
<> 0) or (mFrameHeight
<> 0) then setScissor(mFrameWidth
, mFrameHeight
, mWidth
-mFrameWidth
*2, mHeight
-mFrameHeight
*2);
1230 for f
:= 0 to High(mChildren
) do mChildren
[f
].draw();
1231 if (mFrameWidth
<> 0) or (mFrameHeight
<> 0) then resetScissor();
1232 drawControlPost(x
, y
);
1240 procedure THControl
.drawControl (sx
, sy
: Integer);
1242 if (mParent
= nil) then darkenRect(sx
, sy
, mWidth
, mHeight
, 64);
1246 procedure THControl
.drawControlPost (sx
, sy
: Integer);
1248 if mDrawShadow
and (mWidth
> 0) and (mHeight
> 0) then
1250 setScissorGLInternal(sx
+8, sy
+8, mWidth
, mHeight
);
1251 darkenRect(sx
+mWidth
, sy
+8, 8, mHeight
, 128);
1252 darkenRect(sx
+8, sy
+mHeight
, mWidth
-8, 8, 128);
1257 function THControl
.mouseEvent (var ev
: THMouseEvent
): Boolean;
1262 if not mEnabled
then exit
;
1263 if (mParent
= nil) then
1265 if (mGrab
<> nil) then
1267 result
:= mGrab
.mouseEvent(ev
);
1268 if (ev
.release
) then mGrab
:= nil;
1272 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1273 ctl
:= controlAtXY(ev
.x
, ev
.y
);
1274 if (ctl
<> nil) and (ctl
<> self
) then
1276 if (ctl
<> topLevel
.mFocused
) then ctl
.setFocused(true);
1277 result
:= ctl
.mouseEvent(ev
);
1279 else if (ctl
= self
) and assigned(actionCB
) then
1286 function THControl
.keyEvent (var ev
: THKeyEvent
): Boolean;
1291 if not mEnabled
then exit
;
1292 if (topLevel
.mFocused
<> self
) and isMyChild(topLevel
.mFocused
) and topLevel
.mFocused
.mEnabled
then result
:= topLevel
.mFocused
.keyEvent(ev
);
1293 if (mParent
= nil) then
1295 if (ev
= 'S-Tab') then
1298 ctl
:= findPrevFocus(mFocused
);
1299 if (ctl
<> mFocused
) then
1306 if (ev
= 'Tab') then
1309 ctl
:= findNextFocus(mFocused
);
1310 if (ctl
<> mFocused
) then
1317 if mEscClose
and (ev
= 'Escape') then
1320 uiRemoveWindow(self
);
1324 if mEatKeys
then result
:= true;
1328 // ////////////////////////////////////////////////////////////////////////// //
1329 constructor THTopWindow
.Create (const atitle
: AnsiString; ax
, ay
: Integer; aw
: Integer=-1; ah
: Integer=-1);
1331 inherited Create(ax
, ay
, aw
, ah
, nil);
1335 if (mWidth
< mFrameWidth
*2+3*8) then mWidth
:= mFrameWidth
*2+3*8;
1336 if (mHeight
< mFrameHeight
*2) then mHeight
:= mFrameHeight
*2;
1337 if (Length(mTitle
) > 0) then
1339 if (mWidth
< Length(mTitle
)*8+mFrameWidth
*2+3*8) then mWidth
:= Length(mTitle
)*8+mFrameWidth
*2+3*8;
1342 mDrawShadow
:= true;
1343 mWaitingClose
:= false;
1349 function THTopWindow
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
1351 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) then
1353 mTitle
:= par
.expectStrOrId(true);
1357 if (strEquCI1251(prname
, 'children')) then
1363 if (strEquCI1251(prname
, 'orientation')) or (strEquCI1251(prname
, 'orient')) then
1365 if (par
.eatIdOrStr('horizontal', false)) or (par
.eatIdOrStr('horiz', false)) then mHoriz
:= true
1366 else if (par
.eatIdOrStr('vertical', false)) or (par
.eatIdOrStr('vert', false)) then mHoriz
:= false
1367 else par
.error('`horizontal` or `vertical` expected');
1371 result
:= inherited parseProperty(prname
, par
);
1375 procedure THTopWindow
.centerInScreen ();
1377 if (mWidth
> 0) and (mHeight
> 0) then
1379 mX
:= trunc((gScrWidth
/gh_ui_scale
-mWidth
)/2);
1380 mY
:= trunc((gScrHeight
/gh_ui_scale
-mHeight
)/2);
1385 procedure THTopWindow
.drawControl (sx
, sy
: Integer);
1387 fillRect(sx
, sy
, mWidth
, mHeight
, 0, 0, 128);
1391 procedure THTopWindow
.drawControlPost (sx
, sy
: Integer);
1400 drawRectUI(mX
+4, mY
+4, mWidth
-8, mHeight
-8, r
, g
, b
);
1404 drawRectUI(mX
+3, mY
+3, mWidth
-6, mHeight
-6, r
, g
, b
);
1405 drawRectUI(mX
+5, mY
+5, mWidth
-10, mHeight
-10, r
, g
, b
);
1406 setScissor(mFrameWidth
, 0, 3*8, 8);
1407 fillRect(mX
+mFrameWidth
, mY
, 3*8, 8, 0, 0, 128);
1408 drawText8(mX
+mFrameWidth
, mY
, '[ ]', r
, g
, b
);
1409 if mInClose
then drawText8(mX
+mFrameWidth
+7, mY
, '#', 0, 255, 0)
1410 else drawText8(mX
+mFrameWidth
+7, mY
, '*', 0, 255, 0);
1412 if (Length(mTitle
) > 0) then
1414 setScissor(mFrameWidth
+3*8, 0, mWidth
-mFrameWidth
*2-3*8, 8);
1415 tx
:= (mX
+3*8)+((mWidth
-3*8)-Length(mTitle
)*8) div 2;
1416 fillRect(tx
-3, mY
, Length(mTitle
)*8+3+2, 8, 0, 0, 128);
1417 drawText8(tx
, mY
, mTitle
, r
, g
, b
);
1419 inherited drawControlPost(sx
, sy
);
1423 procedure THTopWindow
.blurred ();
1426 mWaitingClose
:= false;
1432 function THTopWindow
.keyEvent (var ev
: THKeyEvent
): Boolean;
1434 result
:= inherited keyEvent(ev
);
1435 if not getFocused
then exit
;
1436 if (ev
= 'M-F3') then
1438 uiRemoveWindow(self
);
1445 function THTopWindow
.mouseEvent (var ev
: THMouseEvent
): Boolean;
1450 if not mEnabled
then exit
;
1451 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1455 mX
+= ev
.x
-mDragStartX
;
1456 mY
+= ev
.y
-mDragStartY
;
1457 mDragStartX
:= ev
.x
;
1458 mDragStartY
:= ev
.y
;
1459 if (ev
.release
) then mDragging
:= false;
1466 if toLocal(lx
, ly
) then
1472 if (lx
>= mFrameWidth
) and (lx
< mFrameWidth
+3*8) then
1474 //uiRemoveWindow(self);
1475 mWaitingClose
:= true;
1481 mDragStartX
:= ev
.x
;
1482 mDragStartY
:= ev
.y
;
1487 if (lx
< mFrameWidth
) or (lx
>= mWidth
-mFrameWidth
) or (ly
>= mHeight
-mFrameHeight
) then
1490 mDragStartX
:= ev
.x
;
1491 mDragStartY
:= ev
.y
;
1497 if (ev
.release
) then
1499 if mWaitingClose
and (lx
>= mFrameWidth
) and (lx
< mFrameWidth
+3*8) then
1501 uiRemoveWindow(self
);
1505 mWaitingClose
:= false;
1511 if mWaitingClose
then
1513 mInClose
:= (lx
>= mFrameWidth
) and (lx
< mFrameWidth
+3*8);
1522 if (not ev
.motion
) then mWaitingClose
:= false;
1525 result
:= inherited mouseEvent(ev
);
1529 // ////////////////////////////////////////////////////////////////////////// //
1530 constructor THCtlSimpleText
.Create (ax
, ay
: Integer; aparent
: THControl
=nil);
1533 inherited Create(ax
, ay
, 4, 4);
1537 destructor THCtlSimpleText
.Destroy ();
1544 procedure THCtlSimpleText
.appendItem (const atext
: AnsiString; acentered
: Boolean=false; ahline
: Boolean=false);
1548 if (Length(atext
)*8+3*8+2 > mWidth
) then mWidth
:= Length(atext
)*8+3*8+2;
1549 SetLength(mItems
, Length(mItems
)+1);
1550 it
:= @mItems
[High(mItems
)];
1552 it
.centered
:= acentered
;
1554 if (Length(mItems
)*8 > mHeight
) then mHeight
:= Length(mItems
)*8;
1558 procedure THCtlSimpleText
.drawControl (sx
, sy
: Integer);
1564 for f
:= 0 to High(mItems
) do
1571 if it
.centered
then begin b
:= 255; tx
:= sx
+(mWidth
-Length(it
.title
)*8) div 2; end;
1575 if (Length(it
.title
) = 0) then
1577 drawHLine(sx
+4, sy
+3, mWidth
-8, r
, g
, b
);
1579 else if (tx
-3 > sx
+4) then
1581 drawHLine(sx
+4, sy
+3, tx
-3-(sx
+3), r
, g
, b
);
1582 drawHLine(tx
+Length(it
.title
)*8, sy
+3, mWidth
-4, r
, g
, b
);
1585 drawText8(tx
, sy
, it
.title
, r
, g
, b
);
1591 function THCtlSimpleText
.mouseEvent (var ev
: THMouseEvent
): Boolean;
1595 result
:= inherited mouseEvent(ev
);
1598 if not result
and toLocal(lx
, ly
) then
1605 function THCtlSimpleText
.keyEvent (var ev
: THKeyEvent
): Boolean;
1607 result
:= inherited keyEvent(ev
);
1611 // ////////////////////////////////////////////////////////////////////////// //
1612 constructor THCtlCBListBox
.Create (ax
, ay
: Integer; aparent
: THControl
=nil);
1616 inherited Create(ax
, ay
, 4, 4);
1620 destructor THCtlCBListBox
.Destroy ();
1627 procedure THCtlCBListBox
.appendItem (const atext
: AnsiString; bv
: PBoolean; aaction
: TActionCB
=nil);
1631 if (Length(atext
)*8+3*8+2 > mWidth
) then mWidth
:= Length(atext
)*8+3*8+2;
1632 SetLength(mItems
, Length(mItems
)+1);
1633 it
:= @mItems
[High(mItems
)];
1636 it
.actionCB
:= aaction
;
1637 if (Length(mItems
)*8 > mHeight
) then mHeight
:= Length(mItems
)*8;
1638 if (mCurIndex
< 0) then mCurIndex
:= 0;
1642 procedure THCtlCBListBox
.drawControl (sx
, sy
: Integer);
1647 for f
:= 0 to High(mItems
) do
1650 if (mCurIndex
= f
) then fillRect(sx
, sy
, mWidth
, 8, 0, 128, 0);
1651 if (it
.varp
<> nil) then
1653 if it
.varp
^ then drawText8(sx
, sy
, '[x]', 255, 255, 255) else drawText8(sx
, sy
, '[ ]', 255, 255, 255);
1654 drawText8(sx
+3*8+2, sy
, it
.title
, 255, 255, 0);
1656 else if (Length(it
.title
) > 0) then
1658 tx
:= sx
+(mWidth
-Length(it
.title
)*8) div 2;
1659 if (tx
-3 > sx
+4) then
1661 drawHLine(sx
+4, sy
+3, tx
-3-(sx
+3), 255, 255, 255);
1662 drawHLine(tx
+Length(it
.title
)*8, sy
+3, mWidth
-4, 255, 255, 255);
1664 drawText8(tx
, sy
, it
.title
, 255, 255, 255);
1668 drawHLine(sx
+4, sy
+3, mWidth
-8, 255, 255, 255);
1675 function THCtlCBListBox
.mouseEvent (var ev
: THMouseEvent
): Boolean;
1680 result
:= inherited mouseEvent(ev
);
1683 if not result
and toLocal(lx
, ly
) then
1686 if (ev
= 'lmb') then
1689 if (ly
>= 0) and (ly
< Length(mItems
)) then
1692 if (it
.varp
<> nil) then
1695 it
.varp
^ := not it
.varp
^;
1696 if assigned(it
.actionCB
) then it
.actionCB(self
, Integer(it
.varp
^));
1697 if assigned(actionCB
) then actionCB(self
, ly
);
1705 function THCtlCBListBox
.keyEvent (var ev
: THKeyEvent
): Boolean;
1709 result
:= inherited keyEvent(ev
);
1710 if not getFocused
then exit
;
1712 if (ev
= 'Home') or (ev
= 'PageUp') then
1717 if (ev
= 'End') or (ev
= 'PageDown') then
1720 mCurIndex
:= High(mItems
);
1725 if (Length(mItems
) > 0) then
1727 if (mCurIndex
< 0) then mCurIndex
:= Length(mItems
);
1728 while (mCurIndex
> 0) do
1731 if (mItems
[mCurIndex
].varp
<> nil) then break
;
1739 if (ev
= 'Down') then
1742 if (Length(mItems
) > 0) then
1744 if (mCurIndex
< 0) then mCurIndex
:= -1;
1745 while (mCurIndex
< High(mItems
)) do
1748 if (mItems
[mCurIndex
].varp
<> nil) then break
;
1756 if (ev
= 'Space') or (ev
= 'Enter') then
1759 if (mCurIndex
>= 0) and (mCurIndex
< Length(mItems
)) and (mItems
[mCurIndex
].varp
<> nil) then
1761 it
:= @mItems
[mCurIndex
];
1762 it
.varp
^ := not it
.varp
^;
1763 if assigned(it
.actionCB
) then it
.actionCB(self
, Integer(it
.varp
^));
1764 if assigned(actionCB
) then actionCB(self
, mCurIndex
);
1770 // ////////////////////////////////////////////////////////////////////////// //
1771 constructor THCtlBox
.Create (ahoriz
: Boolean; aparent
: THControl
=nil);
1773 inherited Create(aparent
);
1778 function THCtlBox
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
1780 if (strEquCI1251(prname
, 'orientation')) or (strEquCI1251(prname
, 'orient')) then
1782 if (par
.eatIdOrStr('horizontal', false)) or (par
.eatIdOrStr('horiz', false)) then mHoriz
:= true
1783 else if (par
.eatIdOrStr('vertical', false)) or (par
.eatIdOrStr('vert', false)) then mHoriz
:= false
1784 else par
.error('`horizontal` or `vertical` expected');
1788 if (strEquCI1251(prname
, 'frame')) then
1790 mHasFrame
:= parseBool(par
);
1791 if (mHasFrame
) then begin mFrameWidth
:= 8; mFrameHeight
:= 8; end else begin mFrameWidth
:= 0; mFrameHeight
:= 0; end;
1795 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) then
1797 mCaption
:= par
.expectStrOrId(true);
1798 mDefSize
:= TLaySize
.Create(Length(mCaption
)*8+2+8*2, 8*2+2);
1802 if (strEquCI1251(prname
, 'children')) then
1808 result
:= inherited parseProperty(prname
, par
);
1812 procedure THCtlBox
.drawControl (sx
, sy
: Integer);
1817 if focused
then begin r
:= 255; g
:= 255; b
:= 255; end else begin r
:= 255; g
:= 255; b
:= 0; end;
1821 drawRectUI(mX
+3, mY
+3, mWidth
-6, mHeight
-6, r
, g
, b
);
1823 if (Length(mCaption
) > 0) then
1825 setScissor(mFrameWidth
+1, 0, mWidth
-mFrameWidth
-2, 8);
1826 tx
:= mX
+((mWidth
-Length(mCaption
)*8) div 2)-1;
1827 if mHasFrame
then fillRect(tx
, mY
, Length(mCaption
)*8+2, 8, 0, 0, 128);
1828 drawText8(tx
+1, mY
, mCaption
, r
, g
, b
);
1832 function THCtlBox
.mouseEvent (var ev
: THMouseEvent
): Boolean;
1836 result
:= inherited mouseEvent(ev
);
1839 if not result
and toLocal(lx
, ly
) then
1846 //TODO: navigation with arrow keys, according to box orientation
1847 function THCtlBox
.keyEvent (var ev
: THKeyEvent
): Boolean;
1849 result
:= inherited keyEvent(ev
);
1853 // ////////////////////////////////////////////////////////////////////////// //
1854 constructor THCtlHBox
.Create (aparent
: THControl
=nil);
1856 inherited Create(true, aparent
);
1860 // ////////////////////////////////////////////////////////////////////////// //
1861 constructor THCtlVBox
.Create (aparent
: THControl
=nil);
1863 inherited Create(false, aparent
);
1867 // ////////////////////////////////////////////////////////////////////////// //
1868 constructor THCtlTextLabel
.Create (const atext
: AnsiString; aparent
: THControl
=nil);
1870 inherited Create(aparent
);
1874 mDefSize
:= TLaySize
.Create(Length(atext
)*8, 8);
1878 function THCtlTextLabel
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
1880 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) then
1882 mText
:= par
.expectStrOrId(true);
1883 mDefSize
:= TLaySize
.Create(Length(mText
)*8, 8);
1887 if (strEquCI1251(prname
, 'textalign')) then
1889 parseTextAlign(par
, mHAlign
, mVAlign
);
1893 result
:= inherited parseProperty(prname
, par
);
1897 procedure THCtlTextLabel
.drawControl (sx
, sy
: Integer);
1899 xpos
, ypos
: Integer;
1902 fillRect(sx
, sy
, mWidth
, mHeight
, 96, 96, 0);
1903 drawRectUI(sx
, sy
, mWidth
, mHeight
, 96, 96, 96);
1905 if (Length(mText
) > 0) then
1907 if (mHAlign
< 0) then xpos
:= 0
1908 else if (mHAlign
> 0) then xpos
:= mWidth
-Length(mText
)*8
1909 else xpos
:= (mWidth
-Length(mText
)*8) div 2;
1911 if (mVAlign
< 0) then ypos
:= 0
1912 else if (mVAlign
> 0) then ypos
:= mHeight
-8
1913 else ypos
:= (mHeight
-8) div 2;
1915 drawText8(sx
+xpos
, sy
+ypos
, mText
, 255, 255, 255);
1920 function THCtlTextLabel
.mouseEvent (var ev
: THMouseEvent
): Boolean;
1924 result
:= inherited mouseEvent(ev
);
1927 if not result
and toLocal(lx
, ly
) then
1934 function THCtlTextLabel
.keyEvent (var ev
: THKeyEvent
): Boolean;
1936 result
:= inherited keyEvent(ev
);
1941 registerCtlClass(THCtlBox
, 'box');
1942 registerCtlClass(THCtlHBox
, 'hbox');
1943 registerCtlClass(THCtlVBox
, 'vbox');
1944 registerCtlClass(THCtlTextLabel
, 'label');