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);
42 mWidth
, mHeight
: Integer;
43 mFrameWidth
, mFrameHeight
: Integer;
46 mChildren
: array of THControl
;
47 mFocused
: THControl
; // valid only for top-level controls
48 mGrab
: THControl
; // valid only for top-level controls
49 mEscClose
: Boolean; // valid only for top-level controls
58 function getEnabled (): Boolean;
59 procedure setEnabled (v
: Boolean); inline;
61 function getFocused (): Boolean; inline;
62 procedure setFocused (v
: Boolean); inline;
64 function isMyChild (ctl
: THControl
): Boolean;
66 function findFirstFocus (): THControl
;
67 function findLastFocus (): THControl
;
69 function findNextFocus (cur
: THControl
): THControl
;
70 function findPrevFocus (cur
: THControl
): THControl
;
72 procedure activated (); virtual;
73 procedure blurred (); virtual;
75 //WARNING! do not call scissor functions outside `.draw*()` API!
76 // set scissor to this rect (in local coords)
77 procedure setScissor (lx
, ly
, lw
, lh
: Integer);
78 // reset scissor to whole control
79 procedure resetScissor (fullArea
: Boolean); inline; // "full area" means "with frame"
82 // set scissor to this rect (in global coords)
83 procedure setScissorGLInternal (x
, y
, w
, h
: Integer);
89 mDefSize
: TLaySize
; // default size
90 mMaxSize
: TLaySize
; // maximum size
99 mLayDefSize
: TLaySize
;
100 mLayMaxSize
: TLaySize
;
103 // layouter interface
104 function getDefSize (): TLaySize
; inline; // default size; <0: use max size
105 //procedure setDefSize (const sz: TLaySize); inline; // default size; <0: use max size
106 function getMargins (): TLayMargins
; inline;
107 function getMaxSize (): TLaySize
; inline; // max size; <0: set to some huge value
108 //procedure setMaxSize (const sz: TLaySize); inline; // max size; <0: set to some huge value
109 function getFlex (): Integer; inline; // <=0: not flexible
110 function isHorizBox (): Boolean; inline; // horizontal layout for children?
111 procedure setHorizBox (v
: Boolean); inline; // horizontal layout for children?
112 function canWrap (): Boolean; inline; // for horizontal boxes: can wrap children? for child: `false` means 'nonbreakable at *next* ctl'
113 procedure setCanWrap (v
: Boolean); inline; // for horizontal boxes: can wrap children? for child: `false` means 'nonbreakable at *next* ctl'
114 function isLineStart (): Boolean; inline; // `true` if this ctl should start a new line; ignored for vertical boxes
115 procedure setLineStart (v
: Boolean); inline; // `true` if this ctl should start a new line; ignored for vertical boxes
116 function getAlign (): Integer; inline; // aligning in non-main direction: <0: left/up; 0: center; >0: right/down
117 procedure setAlign (v
: Integer); inline; // aligning in non-main direction: <0: left/up; 0: center; >0: right/down
118 function getExpand (): Boolean; inline; // expanding in non-main direction: `true` will ignore align and eat all available space
119 procedure setExpand (v
: Boolean); inline; // expanding in non-main direction: `true` will ignore align and eat all available space
120 function getHGroup (): AnsiString; inline; // empty: not grouped
121 procedure setHGroup (const v
: AnsiString); inline; // empty: not grouped
122 function getVGroup (): AnsiString; inline; // empty: not grouped
123 procedure setVGroup (const v
: AnsiString); inline; // empty: not grouped
125 procedure setActualSizePos (constref apos
: TLayPos
; constref asize
: TLaySize
); inline;
127 procedure layPrepare (); virtual; // called before registering control in layouter
130 property flex
: Integer read mFlex write mFlex
;
131 property flDefaultSize
: TLaySize read mDefSize write mDefSize
;
132 property flMaxSize
: TLaySize read mMaxSize write mMaxSize
;
133 property flHoriz
: Boolean read isHorizBox write setHorizBox
;
134 property flCanWrap
: Boolean read canWrap write setCanWrap
;
135 property flLineStart
: Boolean read isLineStart write setLineStart
;
136 property flAlign
: Integer read getAlign write setAlign
;
137 property flExpand
: Boolean read getExpand write setExpand
;
138 property flHGroup
: AnsiString read getHGroup write setHGroup
;
139 property flVGroup
: AnsiString read getVGroup write setVGroup
;
142 function parsePos (par
: TTextParser
): TLayPos
;
143 function parseSize (par
: TTextParser
): TLaySize
;
144 function parseBool (par
: TTextParser
): Boolean;
145 function parseAnyAlign (par
: TTextParser
): Integer;
146 function parseHAlign (par
: TTextParser
): Integer;
147 function parseVAlign (par
: TTextParser
): Integer;
148 function parseOrientation (const prname
: AnsiString; par
: TTextParser
): Boolean;
149 procedure parseTextAlign (par
: TTextParser
; var h
, v
: Integer);
150 procedure parseChildren (par
: TTextParser
); // par should be on '{'; final '}' is eaten
153 // par is on property data
154 // there may be more data in text stream, don't eat it!
155 // return `true` if property name is valid and value was parsed
156 // return `false` if property name is invalid; don't advance parser in this case
157 // throw on property data errors
158 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; virtual;
160 // par should be on '{'; final '}' is eaten
161 procedure parseProperties (par
: TTextParser
);
164 constructor Create ();
165 constructor Create (ax
, ay
, aw
, ah
: Integer);
166 destructor Destroy (); override;
168 // `sx` and `sy` are screen coordinates
169 procedure drawControl (gx
, gy
: Integer); virtual;
171 // called after all children drawn
172 procedure drawControlPost (gx
, gy
: Integer); virtual;
174 procedure draw (); virtual;
176 function topLevel (): THControl
; inline;
178 // returns `true` if global coords are inside this control
179 function toLocal (var x
, y
: Integer): Boolean;
180 function toLocal (gx
, gy
: Integer; out x
, y
: Integer): Boolean; inline;
181 procedure toGlobal (var x
, y
: Integer);
182 procedure toGlobal (lx
, ly
: Integer; out x
, y
: Integer); inline;
184 // x and y are global coords
185 function controlAtXY (x
, y
: Integer): THControl
;
187 function mouseEvent (var ev
: THMouseEvent
): Boolean; virtual; // returns `true` if event was eaten
188 function keyEvent (var ev
: THKeyEvent
): Boolean; virtual; // returns `true` if event was eaten
190 function prevSibling (): THControl
;
191 function nextSibling (): THControl
;
192 function firstChild (): THControl
; inline;
193 function lastChild (): THControl
; inline;
195 procedure appendChild (ctl
: THControl
); virtual;
198 property id
: AnsiString read mId
;
199 property x0
: Integer read mX
;
200 property y0
: Integer read mY
;
201 property height
: Integer read mHeight
;
202 property width
: Integer read mWidth
;
203 property enabled
: Boolean read getEnabled write setEnabled
;
204 property parent
: THControl read mParent
;
205 property focused
: Boolean read getFocused write setFocused
;
206 property escClose
: Boolean read mEscClose write mEscClose
;
207 property eatKeys
: Boolean read mEatKeys write mEatKeys
;
211 THTopWindow
= class(THControl
)
215 mDragStartX
, mDragStartY
: Integer;
216 mWaitingClose
: Boolean;
218 mFreeOnClose
: Boolean; // default: false
219 mDoCenter
: Boolean; // after layouting
222 procedure activated (); override;
223 procedure blurred (); override;
226 closeCB
: TActionCB
; // called after window was removed from ui window list
229 constructor Create (const atitle
: AnsiString; ax
, ay
: Integer; aw
: Integer=-1; ah
: Integer=-1);
231 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
233 procedure centerInScreen ();
235 // `sx` and `sy` are screen coordinates
236 procedure drawControl (gx
, gy
: Integer); override;
237 procedure drawControlPost (gx
, gy
: Integer); override;
239 function keyEvent (var ev
: THKeyEvent
): Boolean; override; // returns `true` if event was eaten
240 function mouseEvent (var ev
: THMouseEvent
): Boolean; override; // returns `true` if event was eaten
243 property freeOnClose
: Boolean read mFreeOnClose write mFreeOnClose
;
247 THCtlSimpleText
= class(THControl
)
257 mItems
: array of TItem
;
260 constructor Create (ax
, ay
: Integer);
261 destructor Destroy (); override;
263 procedure appendItem (const atext
: AnsiString; acentered
: Boolean=false; ahline
: Boolean=false);
265 procedure drawControl (gx
, gy
: Integer); override;
267 function mouseEvent (var ev
: THMouseEvent
): Boolean; override;
268 function keyEvent (var ev
: THKeyEvent
): Boolean; override;
272 THCtlCBListBox
= class(THControl
)
282 mItems
: array of TItem
;
286 constructor Create (ax
, ay
: Integer);
287 destructor Destroy (); override;
289 procedure appendItem (const atext
: AnsiString; bv
: PBoolean; aaction
: TActionCB
=nil);
291 procedure drawControl (gx
, gy
: Integer); override;
293 function mouseEvent (var ev
: THMouseEvent
): Boolean; override;
294 function keyEvent (var ev
: THKeyEvent
): Boolean; override;
297 // ////////////////////////////////////////////////////////////////////// //
298 THCtlBox
= class(THControl
)
301 mCaption
: AnsiString;
304 constructor Create (ahoriz
: Boolean);
306 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
308 procedure drawControl (gx
, gy
: Integer); override;
310 function mouseEvent (var ev
: THMouseEvent
): Boolean; override;
311 function keyEvent (var ev
: THKeyEvent
): Boolean; override;
314 THCtlHBox
= class(THCtlBox
)
316 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
319 THCtlVBox
= class(THCtlBox
)
321 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
324 // ////////////////////////////////////////////////////////////////////// //
325 THCtlSpan
= class(THControl
)
327 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
329 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
331 procedure drawControl (gx
, gy
: Integer); override;
334 // ////////////////////////////////////////////////////////////////////// //
335 THCtlLine
= class(THControl
)
337 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
339 procedure drawControl (gx
, gy
: Integer); override;
342 THCtlHLine
= class(THCtlLine
)
344 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
347 THCtlVLine
= class(THCtlLine
)
349 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
352 // ////////////////////////////////////////////////////////////////////// //
353 THCtlTextLabel
= class(THControl
)
356 mHAlign
: Integer; // -1: left; 0: center; 1: right; default: left
357 mVAlign
: Integer; // -1: top; 0: center; 1: bottom; default: center
360 constructor Create (const atext
: AnsiString);
362 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
364 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
366 procedure drawControl (gx
, gy
: Integer); override;
368 function mouseEvent (var ev
: THMouseEvent
): Boolean; override;
369 function keyEvent (var ev
: THKeyEvent
): Boolean; override;
373 // ////////////////////////////////////////////////////////////////////////// //
374 function uiMouseEvent (ev
: THMouseEvent
): Boolean;
375 function uiKeyEvent (ev
: THKeyEvent
): Boolean;
379 // ////////////////////////////////////////////////////////////////////////// //
380 procedure uiAddWindow (ctl
: THControl
);
381 procedure uiRemoveWindow (ctl
: THControl
); // will free window if `mFreeOnClose` is `true`
382 function uiVisibleWindow (ctl
: THControl
): Boolean;
385 // ////////////////////////////////////////////////////////////////////////// //
387 procedure uiLayoutCtl (ctl
: THControl
);
390 // ////////////////////////////////////////////////////////////////////////// //
392 gh_ui_scale
: Single = 1.0;
402 // ////////////////////////////////////////////////////////////////////////// //
404 knownCtlClasses
: array of record
405 klass
: THControlClass
;
410 procedure registerCtlClass (aklass
: THControlClass
; const aname
: AnsiString);
412 assert(aklass
<> nil);
413 assert(Length(aname
) > 0);
414 SetLength(knownCtlClasses
, Length(knownCtlClasses
)+1);
415 knownCtlClasses
[High(knownCtlClasses
)].klass
:= aklass
;
416 knownCtlClasses
[High(knownCtlClasses
)].name
:= aname
;
420 function findCtlClass (const aname
: AnsiString): THControlClass
;
424 for f
:= 0 to High(knownCtlClasses
) do
426 if (strEquCI1251(aname
, knownCtlClasses
[f
].name
)) then
428 result
:= knownCtlClasses
[f
].klass
;
436 // ////////////////////////////////////////////////////////////////////////// //
438 TFlexLayouter
= specialize TFlexLayouterBase
<THControl
>;
440 procedure uiLayoutCtl (ctl
: THControl
);
444 if (ctl
= nil) then exit
;
445 lay
:= TFlexLayouter
.Create();
450 //writeln('============================'); lay.dumpFlat();
452 //writeln('=== initial ==='); lay.dump();
454 //lay.calcMaxSizeInternal(0);
457 writeln('=== after first pass ===');
461 writeln('=== after second pass ===');
466 //writeln('=== final ==='); lay.dump();
468 if (ctl
.mParent
= nil) and (ctl
is THTopWindow
) and (THTopWindow(ctl
).mDoCenter
) then
470 THTopWindow(ctl
).centerInScreen();
479 // ////////////////////////////////////////////////////////////////////////// //
481 uiTopList
: array of THControl
= nil;
484 function uiMouseEvent (ev
: THMouseEvent
): Boolean;
490 ev
.x
:= trunc(ev
.x
/gh_ui_scale
);
491 ev
.y
:= trunc(ev
.y
/gh_ui_scale
);
492 ev
.dx
:= trunc(ev
.dx
/gh_ui_scale
); //FIXME
493 ev
.dy
:= trunc(ev
.dy
/gh_ui_scale
); //FIXME
494 if (Length(uiTopList
) = 0) then result
:= false else result
:= uiTopList
[High(uiTopList
)].mouseEvent(ev
);
495 if not result
and (ev
.press
) then
497 for f
:= High(uiTopList
) downto 0 do
499 if uiTopList
[f
].toLocal(ev
.x
, ev
.y
, lx
, ly
) then
502 if uiTopList
[f
].mEnabled
and (f
<> High(uiTopList
)) then
504 uiTopList
[High(uiTopList
)].blurred();
505 ctmp
:= uiTopList
[f
];
507 for c
:= f
+1 to High(uiTopList
) do uiTopList
[c
-1] := uiTopList
[c
];
508 uiTopList
[High(uiTopList
)] := ctmp
;
510 result
:= ctmp
.mouseEvent(ev
);
519 function uiKeyEvent (ev
: THKeyEvent
): Boolean;
521 ev
.x
:= trunc(ev
.x
/gh_ui_scale
);
522 ev
.y
:= trunc(ev
.y
/gh_ui_scale
);
523 if (Length(uiTopList
) = 0) then result
:= false else result
:= uiTopList
[High(uiTopList
)].keyEvent(ev
);
524 if (ev
.release
) then begin result
:= true; exit
; end;
533 glMatrixMode(GL_MODELVIEW
);
537 glScalef(gh_ui_scale
, gh_ui_scale
, 1);
538 for f
:= 0 to High(uiTopList
) do
542 if (f
<> High(uiTopList
)) then darkenRect(ctl
.x0
, ctl
.y0
, ctl
.width
, ctl
.height
, 128);
545 glMatrixMode(GL_MODELVIEW
);
551 procedure uiAddWindow (ctl
: THControl
);
555 if (ctl
= nil) then exit
;
557 if not (ctl
is THTopWindow
) then exit
; // alas
558 for f
:= 0 to High(uiTopList
) do
560 if (uiTopList
[f
] = ctl
) then
562 if (f
<> High(uiTopList
)) then
564 uiTopList
[High(uiTopList
)].blurred();
565 for c
:= f
+1 to High(uiTopList
) do uiTopList
[c
-1] := uiTopList
[c
];
566 uiTopList
[High(uiTopList
)] := ctl
;
572 if (Length(uiTopList
) > 0) then uiTopList
[High(uiTopList
)].blurred();
573 SetLength(uiTopList
, Length(uiTopList
)+1);
574 uiTopList
[High(uiTopList
)] := ctl
;
579 procedure uiRemoveWindow (ctl
: THControl
);
583 if (ctl
= nil) then exit
;
585 if not (ctl
is THTopWindow
) then exit
; // alas
586 for f
:= 0 to High(uiTopList
) do
588 if (uiTopList
[f
] = ctl
) then
591 for c
:= f
+1 to High(uiTopList
) do uiTopList
[c
-1] := uiTopList
[c
];
592 SetLength(uiTopList
, Length(uiTopList
)-1);
593 if (ctl
is THTopWindow
) then
596 if assigned(THTopWindow(ctl
).closeCB
) then THTopWindow(ctl
).closeCB(ctl
, 0);
598 if (THTopWindow(ctl
).mFreeOnClose
) then FreeAndNil(ctl
);
607 function uiVisibleWindow (ctl
: THControl
): Boolean;
612 if (ctl
= nil) then exit
;
614 if not (ctl
is THTopWindow
) then exit
; // alas
615 for f
:= 0 to High(uiTopList
) do
617 if (uiTopList
[f
] = ctl
) then begin result
:= true; exit
; end;
622 // ////////////////////////////////////////////////////////////////////////// //
623 constructor THControl
.Create ();
640 mDrawShadow
:= false;
642 // layouter interface
643 //mDefSize := TLaySize.Create(64, 8); // default size
644 mDefSize
:= TLaySize
.Create(0, 0); // default size
645 mMaxSize
:= TLaySize
.Create(-1, -1); // maximum size
652 mAlign
:= -1; // left/top
657 constructor THControl
.Create (ax
, ay
, aw
, ah
: Integer);
667 destructor THControl
.Destroy ();
671 if (mParent
<> nil) then
674 for f
:= 0 to High(mParent
.mChildren
) do
676 if (mParent
.mChildren
[f
] = self
) then
678 for c
:= f
+1 to High(mParent
.mChildren
) do mParent
.mChildren
[c
-1] := mParent
.mChildren
[c
];
679 SetLength(mParent
.mChildren
, Length(mParent
.mChildren
)-1);
683 for f
:= 0 to High(mChildren
) do
685 mChildren
[f
].mParent
:= nil;
692 // ////////////////////////////////////////////////////////////////////////// //
693 function THControl
.getDefSize (): TLaySize
; inline; begin result
:= mLayDefSize
; end;
694 function THControl
.getMaxSize (): TLaySize
; inline; begin result
:= mLayMaxSize
; end;
695 function THControl
.getFlex (): Integer; inline; begin result
:= mFlex
; end;
696 function THControl
.isHorizBox (): Boolean; inline; begin result
:= mHoriz
; end;
697 procedure THControl
.setHorizBox (v
: Boolean); inline; begin mHoriz
:= v
; end;
698 function THControl
.canWrap (): Boolean; inline; begin result
:= mCanWrap
; end;
699 procedure THControl
.setCanWrap (v
: Boolean); inline; begin mCanWrap
:= v
; end;
700 function THControl
.isLineStart (): Boolean; inline; begin result
:= mLineStart
; end;
701 procedure THControl
.setLineStart (v
: Boolean); inline; begin mLineStart
:= v
; end;
702 function THControl
.getAlign (): Integer; inline; begin result
:= mAlign
; end;
703 procedure THControl
.setAlign (v
: Integer); inline; begin mAlign
:= v
; end;
704 function THControl
.getExpand (): Boolean; inline; begin result
:= mExpand
; end;
705 procedure THControl
.setExpand (v
: Boolean); inline; begin mExpand
:= v
; end;
706 function THControl
.getHGroup (): AnsiString; inline; begin result
:= mHGroup
; end;
707 procedure THControl
.setHGroup (const v
: AnsiString); inline; begin mHGroup
:= v
; end;
708 function THControl
.getVGroup (): AnsiString; inline; begin result
:= mVGroup
; end;
709 procedure THControl
.setVGroup (const v
: AnsiString); inline; begin mVGroup
:= v
; end;
711 function THControl
.getMargins (): TLayMargins
; inline;
713 result
:= TLayMargins
.Create(mFrameHeight
, mFrameWidth
, mFrameHeight
, mFrameWidth
);
716 procedure THControl
.setActualSizePos (constref apos
: TLayPos
; constref asize
: TLaySize
); inline; begin
717 //writeln(self.className, '; pos=', apos.toString, '; size=', asize.toString);
718 if (mParent
<> nil) then
727 procedure THControl
.layPrepare ();
729 mLayDefSize
:= mDefSize
;
730 mLayMaxSize
:= mMaxSize
;
731 if (mLayMaxSize
.w
>= 0) then mLayMaxSize
.w
+= mFrameWidth
*2;
732 if (mLayMaxSize
.h
>= 0) then mLayMaxSize
.h
+= mFrameHeight
*2;
736 // ////////////////////////////////////////////////////////////////////////// //
737 function THControl
.parsePos (par
: TTextParser
): TLayPos
;
741 if (par
.eatDelim('[')) then ech
:= ']' else par
.expectDelim('(');
742 result
.x
:= par
.expectInt();
743 par
.eatDelim(','); // optional comma
744 result
.y
:= par
.expectInt();
745 par
.eatDelim(','); // optional comma
746 par
.expectDelim(ech
);
749 function THControl
.parseSize (par
: TTextParser
): TLaySize
;
753 if (par
.eatDelim('[')) then ech
:= ']' else par
.expectDelim('(');
754 result
.w
:= par
.expectInt();
755 par
.eatDelim(','); // optional comma
756 result
.h
:= par
.expectInt();
757 par
.eatDelim(','); // optional comma
758 par
.expectDelim(ech
);
761 function THControl
.parseBool (par
: TTextParser
): Boolean;
764 par
.eatIdOrStr('true', false) or
765 par
.eatIdOrStr('yes', false) or
766 par
.eatIdOrStr('tan', false);
769 if (not par
.eatIdOrStr('false', false)) and (not par
.eatIdOrStr('no', false)) and (not par
.eatIdOrStr('ona', false)) then
771 par
.error('boolean value expected');
776 function THControl
.parseAnyAlign (par
: TTextParser
): Integer;
778 if (par
.eatIdOrStr('left', false)) or (par
.eatIdOrStr('top', false)) then result
:= -1
779 else if (par
.eatIdOrStr('right', false)) or (par
.eatIdOrStr('bottom', false)) then result
:= 1
780 else if (par
.eatIdOrStr('center', false)) then result
:= 0
781 else par
.error('invalid align value');
784 function THControl
.parseHAlign (par
: TTextParser
): Integer;
786 if (par
.eatIdOrStr('left', false)) then result
:= -1
787 else if (par
.eatIdOrStr('right', false)) then result
:= 1
788 else if (par
.eatIdOrStr('center', false)) then result
:= 0
789 else par
.error('invalid horizontal align value');
792 function THControl
.parseVAlign (par
: TTextParser
): Integer;
794 if (par
.eatIdOrStr('top', false)) then result
:= -1
795 else if (par
.eatIdOrStr('bottom', false)) then result
:= 1
796 else if (par
.eatIdOrStr('center', false)) then result
:= 0
797 else par
.error('invalid vertical align value');
800 procedure THControl
.parseTextAlign (par
: TTextParser
; var h
, v
: Integer);
802 wasH
: Boolean = false;
803 wasV
: Boolean = false;
807 if (par
.eatIdOrStr('left', false)) then
809 if wasH
then par
.error('too many align directives');
814 if (par
.eatIdOrStr('right', false)) then
816 if wasH
then par
.error('too many align directives');
821 if (par
.eatIdOrStr('hcenter', false)) then
823 if wasH
then par
.error('too many align directives');
828 if (par
.eatIdOrStr('top', false)) then
830 if wasV
then par
.error('too many align directives');
835 if (par
.eatIdOrStr('bottom', false)) then
837 if wasV
then par
.error('too many align directives');
842 if (par
.eatIdOrStr('vcenter', false)) then
844 if wasV
then par
.error('too many align directives');
849 if (par
.eatIdOrStr('center', false)) then
851 if wasV
or wasH
then par
.error('too many align directives');
860 if not wasV
and not wasH
then par
.error('invalid align value');
863 function THControl
.parseOrientation (const prname
: AnsiString; par
: TTextParser
): Boolean;
865 if (strEquCI1251(prname
, 'orientation')) or (strEquCI1251(prname
, 'orient')) then
867 if (par
.eatIdOrStr('horizontal', false)) or (par
.eatIdOrStr('horiz', false)) then mHoriz
:= true
868 else if (par
.eatIdOrStr('vertical', false)) or (par
.eatIdOrStr('vert', false)) then mHoriz
:= false
869 else par
.error('`horizontal` or `vertical` expected');
878 // par should be on '{'; final '}' is eaten
879 procedure THControl
.parseProperties (par
: TTextParser
);
883 if (not par
.eatDelim('{')) then exit
;
884 while (not par
.eatDelim('}')) do
886 if (not par
.isIdOrStr
) then par
.error('property name expected');
889 par
.eatDelim(':'); // optional
890 if not parseProperty(pn
, par
) then par
.errorfmt('invalid property name ''%s''', [pn
]);
891 par
.eatDelim(','); // optional
895 // par should be on '{'
896 procedure THControl
.parseChildren (par
: TTextParser
);
901 par
.expectDelim('{');
902 while (not par
.eatDelim('}')) do
904 if (not par
.isIdOrStr
) then par
.error('control name expected');
905 cc
:= findCtlClass(par
.tokStr
);
906 if (cc
= nil) then par
.errorfmt('unknown control name: ''%s''', [par
.tokStr
]);
907 //writeln('children for <', par.tokStr, '>: <', cc.className, '>');
909 par
.eatDelim(':'); // optional
911 //writeln(' mHoriz=', ctl.mHoriz);
913 ctl
.parseProperties(par
);
918 //writeln(': ', ctl.mDefSize.toString);
920 par
.eatDelim(','); // optional
925 function THControl
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
928 if (strEquCI1251(prname
, 'id')) then begin mId
:= par
.expectStrOrId(true); exit
; end; // allow empty strings
929 if (strEquCI1251(prname
, 'flex')) then begin flex
:= par
.expectInt(); exit
; end;
931 if (strEquCI1251(prname
, 'defsize')) or (strEquCI1251(prname
, 'size')) then begin mDefSize
:= parseSize(par
); exit
; end;
932 if (strEquCI1251(prname
, 'maxsize')) then begin mMaxSize
:= parseSize(par
); exit
; end;
933 if (strEquCI1251(prname
, 'defwidth')) or (strEquCI1251(prname
, 'width')) then begin mDefSize
.w
:= par
.expectInt(); exit
; end;
934 if (strEquCI1251(prname
, 'defheight')) or (strEquCI1251(prname
, 'height')) then begin mDefSize
.h
:= par
.expectInt(); exit
; end;
935 if (strEquCI1251(prname
, 'maxwidth')) then begin mMaxSize
.w
:= par
.expectInt(); exit
; end;
936 if (strEquCI1251(prname
, 'maxheight')) then begin mMaxSize
.h
:= par
.expectInt(); exit
; end;
938 if (strEquCI1251(prname
, 'wrap')) then begin mCanWrap
:= parseBool(par
); exit
; end;
939 if (strEquCI1251(prname
, 'linestart')) then begin mLineStart
:= parseBool(par
); exit
; end;
940 if (strEquCI1251(prname
, 'expand')) then begin mExpand
:= parseBool(par
); exit
; end;
942 if (strEquCI1251(prname
, 'align')) then begin mAlign
:= parseAnyAlign(par
); exit
; end;
943 if (strEquCI1251(prname
, 'hgroup')) then begin mHGroup
:= par
.expectStrOrId(true); exit
; end; // allow empty strings
944 if (strEquCI1251(prname
, 'vgroup')) then begin mVGroup
:= par
.expectStrOrId(true); exit
; end; // allow empty strings
946 if (strEquCI1251(prname
, 'canfocus')) then begin mCanFocus
:= parseBool(par
); exit
; end;
947 if (strEquCI1251(prname
, 'enabled')) then begin mEnabled
:= parseBool(par
); exit
; end;
948 if (strEquCI1251(prname
, 'disabled')) then begin mEnabled
:= not parseBool(par
); exit
; end;
949 if (strEquCI1251(prname
, 'escclose')) then begin mEscClose
:= not parseBool(par
); exit
; end;
950 if (strEquCI1251(prname
, 'eatkeys')) then begin mEatKeys
:= not parseBool(par
); exit
; end;
955 // ////////////////////////////////////////////////////////////////////////// //
956 procedure THControl
.activated ();
961 procedure THControl
.blurred ();
967 function THControl
.topLevel (): THControl
; inline;
970 while (result
.mParent
<> nil) do result
:= result
.mParent
;
974 function THControl
.getEnabled (): Boolean;
979 if (not mEnabled
) or (mWidth
< 1) or (mHeight
< 1) then exit
;
981 while (ctl
<> nil) do
983 if (not ctl
.mEnabled
) or (ctl
.mWidth
< 1) or (ctl
.mHeight
< 1) then exit
;
990 procedure THControl
.setEnabled (v
: Boolean); inline;
992 if (mEnabled
= v
) then exit
;
994 if not v
and focused
then setFocused(false);
998 function THControl
.getFocused (): Boolean; inline;
1000 if (mParent
= nil) then result
:= (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)] = self
) else result
:= (topLevel
.mFocused
= self
);
1004 procedure THControl
.setFocused (v
: Boolean); inline;
1011 if (tl
.mFocused
= self
) then
1014 tl
.mFocused
:= tl
.findNextFocus(self
);
1015 if (tl
.mFocused
= self
) then tl
.mFocused
:= nil;
1019 if (not mEnabled
) or (not mCanFocus
) then exit
;
1020 if (tl
.mFocused
<> self
) then
1022 if (tl
.mFocused
<> nil) then tl
.mFocused
.blurred();
1023 tl
.mFocused
:= self
;
1024 if (tl
.mGrab
<> self
) then tl
.mGrab
:= nil;
1030 function THControl
.isMyChild (ctl
: THControl
): Boolean;
1033 while (ctl
<> nil) do
1035 if (ctl
.mParent
= self
) then exit
;
1042 // returns `true` if global coords are inside this control
1043 function THControl
.toLocal (var x
, y
: Integer): Boolean;
1048 while (ctl
<> nil) do
1054 result
:= (x
>= 0) and (y
>= 0) and (x
< mWidth
) and (y
< mHeight
);
1057 function THControl
.toLocal (gx
, gy
: Integer; out x
, y
: Integer): Boolean; inline;
1061 result
:= toLocal(x
, y
);
1064 procedure THControl
.toGlobal (var x
, y
: Integer);
1069 while (ctl
<> nil) do
1077 procedure THControl
.toGlobal (lx
, ly
: Integer; out x
, y
: Integer); inline;
1085 // x and y are global coords
1086 function THControl
.controlAtXY (x
, y
: Integer): THControl
;
1092 if (not mEnabled
) or (mWidth
< 1) or (mHeight
< 1) then exit
;
1093 if not toLocal(x
, y
, lx
, ly
) then exit
;
1094 for f
:= High(mChildren
) downto 0 do
1096 result
:= mChildren
[f
].controlAtXY(x
, y
);
1097 if (result
<> nil) then exit
;
1103 function THControl
.prevSibling (): THControl
;
1107 if (mParent
<> nil) then
1109 for f
:= 1 to High(mParent
.mChildren
) do
1111 if (mParent
.mChildren
[f
] = self
) then begin result
:= mParent
.mChildren
[f
-1]; exit
; end;
1117 function THControl
.nextSibling (): THControl
;
1121 if (mParent
<> nil) then
1123 for f
:= 0 to High(mParent
.mChildren
)-1 do
1125 if (mParent
.mChildren
[f
] = self
) then begin result
:= mParent
.mChildren
[f
+1]; exit
; end;
1131 function THControl
.firstChild (): THControl
; inline;
1133 if (Length(mChildren
) <> 0) then result
:= mChildren
[0] else result
:= nil;
1136 function THControl
.lastChild (): THControl
; inline;
1138 if (Length(mChildren
) <> 0) then result
:= mChildren
[High(mChildren
)] else result
:= nil;
1142 function THControl
.findFirstFocus (): THControl
;
1149 for f
:= 0 to High(mChildren
) do
1151 result
:= mChildren
[f
].findFirstFocus();
1152 if (result
<> nil) then exit
;
1154 if mCanFocus
then result
:= self
;
1159 function THControl
.findLastFocus (): THControl
;
1166 for f
:= High(mChildren
) downto 0 do
1168 result
:= mChildren
[f
].findLastFocus();
1169 if (result
<> nil) then exit
;
1171 if mCanFocus
then result
:= self
;
1176 function THControl
.findNextFocus (cur
: THControl
): THControl
;
1181 if not isMyChild(cur
) then cur
:= nil;
1182 if (cur
= nil) then begin result
:= findFirstFocus(); exit
; end;
1183 result
:= cur
.findFirstFocus();
1184 if (result
<> nil) and (result
<> cur
) then exit
;
1187 cur
:= cur
.nextSibling
;
1188 if (cur
= nil) then break
;
1189 result
:= cur
.findFirstFocus();
1190 if (result
<> nil) then exit
;
1192 result
:= findFirstFocus();
1197 function THControl
.findPrevFocus (cur
: THControl
): THControl
;
1202 if not isMyChild(cur
) then cur
:= nil;
1203 if (cur
= nil) then begin result
:= findLastFocus(); exit
; end;
1205 result
:= cur
.findLastFocus();
1206 if (result
<> nil) and (result
<> cur
) then exit
;
1209 cur
:= cur
.prevSibling
;
1210 if (cur
= nil) then break
;
1211 result
:= cur
.findLastFocus();
1212 if (result
<> nil) then exit
;
1214 result
:= findLastFocus();
1219 procedure THControl
.appendChild (ctl
: THControl
);
1221 if (ctl
= nil) then exit
;
1222 if (ctl
.mParent
<> nil) then exit
;
1223 SetLength(mChildren
, Length(mChildren
)+1);
1224 mChildren
[High(mChildren
)] := ctl
;
1225 ctl
.mParent
:= self
;
1226 Inc(ctl
.mX
, mFrameWidth
);
1227 Inc(ctl
.mY
, mFrameHeight
);
1228 if (ctl
.mWidth
> 0) and (ctl
.mHeight
> 0) and
1229 (ctl
.mX
+ctl
.mWidth
> mFrameWidth
) and (ctl
.mY
+ctl
.mHeight
> mFrameHeight
) then
1231 if (mWidth
+mFrameWidth
< ctl
.mX
+ctl
.mWidth
) then mWidth
:= ctl
.mX
+ctl
.mWidth
+mFrameWidth
;
1232 if (mHeight
+mFrameHeight
< ctl
.mY
+ctl
.mHeight
) then mHeight
:= ctl
.mY
+ctl
.mHeight
+mFrameHeight
;
1234 //if (mFocused = nil) and ctl.mEnabled and ctl.mCanFocus and (ctl.mWidth > 0) and (ctl.mHeight > 0) then mFocused := ctl;
1238 // ////////////////////////////////////////////////////////////////////////// //
1239 procedure THControl
.setScissorGLInternal (x
, y
, w
, h
: Integer);
1241 if not scallowed
then exit
;
1242 x
:= trunc(x
*gh_ui_scale
);
1243 y
:= trunc(y
*gh_ui_scale
);
1244 w
:= trunc(w
*gh_ui_scale
);
1245 h
:= trunc(h
*gh_ui_scale
);
1246 scis
.combineRect(x
, y
, w
, h
);
1249 procedure THControl
.setScissor (lx
, ly
, lw
, lh
: Integer);
1252 //ox, oy, ow, oh: Integer;
1254 if not scallowed
then exit
;
1255 //ox := lx; oy := ly; ow := lw; oh := lh;
1256 if not intersectRect(lx
, ly
, lw
, lh
, 0, 0, mWidth
, mHeight
) then
1258 //writeln('oops: <', self.className, '>: old=(', ox, ',', oy, ')-[', ow, ',', oh, ']');
1259 glScissor(0, 0, 0, 0);
1262 toGlobal(lx
, ly
, gx
, gy
);
1263 setScissorGLInternal(gx
, gy
, lw
, lh
);
1266 procedure THControl
.resetScissor (fullArea
: Boolean); inline;
1268 if not scallowed
then exit
;
1271 setScissor(0, 0, mWidth
, mHeight
);
1275 setScissor(mFrameWidth
, mFrameHeight
, mWidth
-mFrameWidth
*2, mHeight
-mFrameHeight
*2);
1280 // ////////////////////////////////////////////////////////////////////////// //
1281 procedure THControl
.draw ();
1286 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1287 toGlobal(0, 0, gx
, gy
);
1288 //conwritefln('[%s]: (%d,%d)-(%d,%d) (%d,%d)', [ClassName, mX, mY, mWidth, mHeight, x, y]);
1290 scis
.save(true); // scissoring enabled
1293 resetScissor(true); // full area
1294 drawControl(gx
, gy
);
1295 resetScissor(false); // client area
1296 for f
:= 0 to High(mChildren
) do mChildren
[f
].draw();
1297 resetScissor(true); // full area
1298 drawControlPost(gx
, gy
);
1305 procedure THControl
.drawControl (gx
, gy
: Integer);
1307 if (mParent
= nil) then darkenRect(gx
, gy
, mWidth
, mHeight
, 64);
1310 procedure THControl
.drawControlPost (gx
, gy
: Integer);
1313 if mDrawShadow
and (mWidth
> 0) and (mHeight
> 0) then
1315 setScissorGLInternal(gx
+8, gy
+8, mWidth
, mHeight
);
1316 darkenRect(gx
+mWidth
, gy
+8, 8, mHeight
, 128);
1317 darkenRect(gx
+8, gy
+mHeight
, mWidth
-8, 8, 128);
1322 // ////////////////////////////////////////////////////////////////////////// //
1323 function THControl
.mouseEvent (var ev
: THMouseEvent
): Boolean;
1328 if not mEnabled
then exit
;
1329 if (mParent
= nil) then
1331 if (mGrab
<> nil) then
1333 result
:= mGrab
.mouseEvent(ev
);
1334 if (ev
.release
) then mGrab
:= nil;
1338 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1339 ctl
:= controlAtXY(ev
.x
, ev
.y
);
1340 if (ctl
<> nil) and (ctl
<> self
) then
1342 if (ctl
<> topLevel
.mFocused
) then ctl
.setFocused(true);
1343 result
:= ctl
.mouseEvent(ev
);
1345 else if (ctl
= self
) and assigned(actionCB
) then
1352 function THControl
.keyEvent (var ev
: THKeyEvent
): Boolean;
1357 if not mEnabled
then exit
;
1358 if (topLevel
.mFocused
<> self
) and isMyChild(topLevel
.mFocused
) and topLevel
.mFocused
.mEnabled
then result
:= topLevel
.mFocused
.keyEvent(ev
);
1359 if (mParent
= nil) then
1361 if (ev
= 'S-Tab') then
1364 ctl
:= findPrevFocus(mFocused
);
1365 if (ctl
<> mFocused
) then
1372 if (ev
= 'Tab') then
1375 ctl
:= findNextFocus(mFocused
);
1376 if (ctl
<> mFocused
) then
1383 if mEscClose
and (ev
= 'Escape') then
1386 uiRemoveWindow(self
);
1390 if mEatKeys
then result
:= true;
1394 // ////////////////////////////////////////////////////////////////////////// //
1395 constructor THTopWindow
.Create (const atitle
: AnsiString; ax
, ay
: Integer; aw
: Integer=-1; ah
: Integer=-1);
1397 inherited Create(ax
, ay
, aw
, ah
);
1401 if (mWidth
< mFrameWidth
*2+3*8) then mWidth
:= mFrameWidth
*2+3*8;
1402 if (mHeight
< mFrameHeight
*2) then mHeight
:= mFrameHeight
*2;
1403 if (Length(mTitle
) > 0) then
1405 if (mWidth
< Length(mTitle
)*8+mFrameWidth
*2+3*8) then mWidth
:= Length(mTitle
)*8+mFrameWidth
*2+3*8;
1408 mDrawShadow
:= true;
1409 mWaitingClose
:= false;
1415 function THTopWindow
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
1417 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) then
1419 mTitle
:= par
.expectStrOrId(true);
1423 if (strEquCI1251(prname
, 'children')) then
1429 if (strEquCI1251(prname
, 'position')) then
1431 if (par
.eatIdOrStr('default', false)) then mDoCenter
:= false
1432 else if (par
.eatIdOrStr('center', false)) then mDoCenter
:= true
1433 else par
.error('`center` or `default` expected');
1437 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
1438 result
:= inherited parseProperty(prname
, par
);
1442 procedure THTopWindow
.centerInScreen ();
1444 if (mWidth
> 0) and (mHeight
> 0) then
1446 mX
:= trunc((gScrWidth
/gh_ui_scale
-mWidth
)/2);
1447 mY
:= trunc((gScrHeight
/gh_ui_scale
-mHeight
)/2);
1452 procedure THTopWindow
.drawControl (gx
, gy
: Integer);
1454 fillRect(gx
, gy
, mWidth
, mHeight
, TGxRGBA
.Create(0, 0, 128));
1458 procedure THTopWindow
.drawControlPost (gx
, gy
: Integer);
1467 drawRectUI(mX
+4, mY
+4, mWidth
-8, mHeight
-8, TGxRGBA
.Create(r
, g
, b
));
1471 drawRectUI(mX
+3, mY
+3, mWidth
-6, mHeight
-6, TGxRGBA
.Create(r
, g
, b
));
1472 drawRectUI(mX
+5, mY
+5, mWidth
-10, mHeight
-10, TGxRGBA
.Create(r
, g
, b
));
1473 setScissor(mFrameWidth
, 0, 3*8, 8);
1474 fillRect(mX
+mFrameWidth
, mY
, 3*8, 8, TGxRGBA
.Create(0, 0, 128));
1475 drawText8(mX
+mFrameWidth
, mY
, '[ ]', TGxRGBA
.Create(r
, g
, b
));
1476 if mInClose
then drawText8(mX
+mFrameWidth
+7, mY
, '#', TGxRGBA
.Create(0, 255, 0))
1477 else drawText8(mX
+mFrameWidth
+7, mY
, '*', TGxRGBA
.Create(0, 255, 0));
1479 if (Length(mTitle
) > 0) then
1481 setScissor(mFrameWidth
+3*8, 0, mWidth
-mFrameWidth
*2-3*8, 8);
1482 tx
:= (mX
+3*8)+((mWidth
-3*8)-Length(mTitle
)*8) div 2;
1483 fillRect(tx
-3, mY
, Length(mTitle
)*8+3+2, 8, TGxRGBA
.Create(0, 0, 128));
1484 drawText8(tx
, mY
, mTitle
, TGxRGBA
.Create(r
, g
, b
));
1486 inherited drawControlPost(gx
, gy
);
1490 procedure THTopWindow
.activated ();
1492 if (mFocused
= nil) or (mFocused
= self
) then
1494 mFocused
:= findFirstFocus();
1495 if (mFocused
<> nil) and (mFocused
<> self
) then mFocused
.activated();
1501 procedure THTopWindow
.blurred ();
1504 mWaitingClose
:= false;
1510 function THTopWindow
.keyEvent (var ev
: THKeyEvent
): Boolean;
1512 result
:= inherited keyEvent(ev
);
1513 if not getFocused
then exit
;
1514 if (ev
= 'M-F3') then
1516 uiRemoveWindow(self
);
1523 function THTopWindow
.mouseEvent (var ev
: THMouseEvent
): Boolean;
1528 if not mEnabled
then exit
;
1529 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1533 mX
+= ev
.x
-mDragStartX
;
1534 mY
+= ev
.y
-mDragStartY
;
1535 mDragStartX
:= ev
.x
;
1536 mDragStartY
:= ev
.y
;
1537 if (ev
.release
) then mDragging
:= false;
1542 if toLocal(ev
.x
, ev
.y
, lx
, ly
) then
1548 if (lx
>= mFrameWidth
) and (lx
< mFrameWidth
+3*8) then
1550 //uiRemoveWindow(self);
1551 mWaitingClose
:= true;
1557 mDragStartX
:= ev
.x
;
1558 mDragStartY
:= ev
.y
;
1563 if (lx
< mFrameWidth
) or (lx
>= mWidth
-mFrameWidth
) or (ly
>= mHeight
-mFrameHeight
) then
1566 mDragStartX
:= ev
.x
;
1567 mDragStartY
:= ev
.y
;
1573 if (ev
.release
) then
1575 if mWaitingClose
and (lx
>= mFrameWidth
) and (lx
< mFrameWidth
+3*8) then
1577 uiRemoveWindow(self
);
1581 mWaitingClose
:= false;
1587 if mWaitingClose
then
1589 mInClose
:= (lx
>= mFrameWidth
) and (lx
< mFrameWidth
+3*8);
1598 if (not ev
.motion
) then mWaitingClose
:= false;
1601 result
:= inherited mouseEvent(ev
);
1605 // ////////////////////////////////////////////////////////////////////////// //
1606 constructor THCtlSimpleText
.Create (ax
, ay
: Integer);
1609 inherited Create(ax
, ay
, 4, 4);
1613 destructor THCtlSimpleText
.Destroy ();
1620 procedure THCtlSimpleText
.appendItem (const atext
: AnsiString; acentered
: Boolean=false; ahline
: Boolean=false);
1624 if (Length(atext
)*8+3*8+2 > mWidth
) then mWidth
:= Length(atext
)*8+3*8+2;
1625 SetLength(mItems
, Length(mItems
)+1);
1626 it
:= @mItems
[High(mItems
)];
1628 it
.centered
:= acentered
;
1630 if (Length(mItems
)*8 > mHeight
) then mHeight
:= Length(mItems
)*8;
1634 procedure THCtlSimpleText
.drawControl (gx
, gy
: Integer);
1640 for f
:= 0 to High(mItems
) do
1647 if it
.centered
then begin b
:= 255; tx
:= gx
+(mWidth
-Length(it
.title
)*8) div 2; end;
1651 if (Length(it
.title
) = 0) then
1653 drawHLine(gx
+4, gy
+3, mWidth
-8, TGxRGBA
.Create(r
, g
, b
));
1655 else if (tx
-3 > gx
+4) then
1657 drawHLine(gx
+4, gy
+3, tx
-3-(gx
+3), TGxRGBA
.Create(r
, g
, b
));
1658 drawHLine(tx
+Length(it
.title
)*8, gy
+3, mWidth
-4, TGxRGBA
.Create(r
, g
, b
));
1661 drawText8(tx
, gy
, it
.title
, TGxRGBA
.Create(r
, g
, b
));
1667 function THCtlSimpleText
.mouseEvent (var ev
: THMouseEvent
): Boolean;
1671 result
:= inherited mouseEvent(ev
);
1672 if not result
and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
1679 function THCtlSimpleText
.keyEvent (var ev
: THKeyEvent
): Boolean;
1681 result
:= inherited keyEvent(ev
);
1685 // ////////////////////////////////////////////////////////////////////////// //
1686 constructor THCtlCBListBox
.Create (ax
, ay
: Integer);
1690 inherited Create(ax
, ay
, 4, 4);
1694 destructor THCtlCBListBox
.Destroy ();
1701 procedure THCtlCBListBox
.appendItem (const atext
: AnsiString; bv
: PBoolean; aaction
: TActionCB
=nil);
1705 if (Length(atext
)*8+3*8+2 > mWidth
) then mWidth
:= Length(atext
)*8+3*8+2;
1706 SetLength(mItems
, Length(mItems
)+1);
1707 it
:= @mItems
[High(mItems
)];
1710 it
.actionCB
:= aaction
;
1711 if (Length(mItems
)*8 > mHeight
) then mHeight
:= Length(mItems
)*8;
1712 if (mCurIndex
< 0) then mCurIndex
:= 0;
1716 procedure THCtlCBListBox
.drawControl (gx
, gy
: Integer);
1721 for f
:= 0 to High(mItems
) do
1724 if (mCurIndex
= f
) then fillRect(gx
, gy
, mWidth
, 8, TGxRGBA
.Create(0, 128, 0));
1725 if (it
.varp
<> nil) then
1727 if it
.varp
^ then drawText8(gx
, gy
, '[x]', TGxRGBA
.Create(255, 255, 255)) else drawText8(gx
, gy
, '[ ]', TGxRGBA
.Create(255, 255, 255));
1728 drawText8(gx
+3*8+2, gy
, it
.title
, TGxRGBA
.Create(255, 255, 0));
1730 else if (Length(it
.title
) > 0) then
1732 tx
:= gx
+(mWidth
-Length(it
.title
)*8) div 2;
1733 if (tx
-3 > gx
+4) then
1735 drawHLine(gx
+4, gy
+3, tx
-3-(gx
+3), TGxRGBA
.Create(255, 255, 255));
1736 drawHLine(tx
+Length(it
.title
)*8, gy
+3, mWidth
-4, TGxRGBA
.Create(255, 255, 255));
1738 drawText8(tx
, gy
, it
.title
, TGxRGBA
.Create(255, 255, 255));
1742 drawHLine(gx
+4, gy
+3, mWidth
-8, TGxRGBA
.Create(255, 255, 255));
1749 function THCtlCBListBox
.mouseEvent (var ev
: THMouseEvent
): Boolean;
1754 result
:= inherited mouseEvent(ev
);
1755 if not result
and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
1758 if (ev
= 'lmb') then
1761 if (ly
>= 0) and (ly
< Length(mItems
)) then
1764 if (it
.varp
<> nil) then
1767 it
.varp
^ := not it
.varp
^;
1768 if assigned(it
.actionCB
) then it
.actionCB(self
, Integer(it
.varp
^));
1769 if assigned(actionCB
) then actionCB(self
, ly
);
1777 function THCtlCBListBox
.keyEvent (var ev
: THKeyEvent
): Boolean;
1781 result
:= inherited keyEvent(ev
);
1782 if not getFocused
then exit
;
1784 if (ev
= 'Home') or (ev
= 'PageUp') then
1789 if (ev
= 'End') or (ev
= 'PageDown') then
1792 mCurIndex
:= High(mItems
);
1797 if (Length(mItems
) > 0) then
1799 if (mCurIndex
< 0) then mCurIndex
:= Length(mItems
);
1800 while (mCurIndex
> 0) do
1803 if (mItems
[mCurIndex
].varp
<> nil) then break
;
1811 if (ev
= 'Down') then
1814 if (Length(mItems
) > 0) then
1816 if (mCurIndex
< 0) then mCurIndex
:= -1;
1817 while (mCurIndex
< High(mItems
)) do
1820 if (mItems
[mCurIndex
].varp
<> nil) then break
;
1828 if (ev
= 'Space') or (ev
= 'Enter') then
1831 if (mCurIndex
>= 0) and (mCurIndex
< Length(mItems
)) and (mItems
[mCurIndex
].varp
<> nil) then
1833 it
:= @mItems
[mCurIndex
];
1834 it
.varp
^ := not it
.varp
^;
1835 if assigned(it
.actionCB
) then it
.actionCB(self
, Integer(it
.varp
^));
1836 if assigned(actionCB
) then actionCB(self
, mCurIndex
);
1842 // ////////////////////////////////////////////////////////////////////////// //
1843 constructor THCtlBox
.Create (ahoriz
: Boolean);
1851 function THCtlBox
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
1853 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
1854 if (strEquCI1251(prname
, 'frame')) then
1856 mHasFrame
:= parseBool(par
);
1857 if (mHasFrame
) then begin mFrameWidth
:= 8; mFrameHeight
:= 8; end else begin mFrameWidth
:= 0; mFrameHeight
:= 0; end;
1861 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) then
1863 mCaption
:= par
.expectStrOrId(true);
1864 mDefSize
:= TLaySize
.Create(Length(mCaption
)*8+3, 8);
1868 if (strEquCI1251(prname
, 'children')) then
1874 result
:= inherited parseProperty(prname
, par
);
1878 procedure THCtlBox
.drawControl (gx
, gy
: Integer);
1883 if focused
then begin r
:= 255; g
:= 255; b
:= 255; end else begin r
:= 255; g
:= 255; b
:= 0; end;
1887 drawRectUI(gx
+3, gy
+3, mWidth
-6, mHeight
-6, TGxRGBA
.Create(r
, g
, b
));
1890 if (Length(mCaption
) > 0) then
1892 setScissor(mFrameWidth
+1, 0, mWidth
-mFrameWidth
-2, 8);
1893 tx
:= gx
+((mWidth
-Length(mCaption
)*8) div 2);
1894 if mHasFrame
then fillRect(tx
-2, gy
, Length(mCaption
)*8+3, 8, TGxRGBA
.Create(0, 0, 128));
1895 drawText8(tx
, gy
, mCaption
, TGxRGBA
.Create(r
, g
, b
));
1900 function THCtlBox
.mouseEvent (var ev
: THMouseEvent
): Boolean;
1904 result
:= inherited mouseEvent(ev
);
1905 if not result
and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
1912 //TODO: navigation with arrow keys, according to box orientation
1913 function THCtlBox
.keyEvent (var ev
: THKeyEvent
): Boolean;
1915 result
:= inherited keyEvent(ev
);
1919 // ////////////////////////////////////////////////////////////////////////// //
1920 procedure THCtlHBox
.AfterConstruction ();
1922 inherited AfterConstruction();
1927 // ////////////////////////////////////////////////////////////////////////// //
1928 procedure THCtlVBox
.AfterConstruction ();
1930 inherited AfterConstruction();
1936 // ////////////////////////////////////////////////////////////////////////// //
1937 procedure THCtlSpan
.AfterConstruction ();
1939 inherited AfterConstruction();
1945 function THCtlSpan
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
1947 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
1948 result
:= inherited parseProperty(prname
, par
);
1952 procedure THCtlSpan
.drawControl (gx
, gy
: Integer);
1957 // ////////////////////////////////////////////////////////////////////// //
1958 function THCtlLine
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
1960 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
1961 result
:= inherited parseProperty(prname
, par
);
1965 procedure THCtlLine
.drawControl (gx
, gy
: Integer);
1969 drawHLine(gx
, gy
+(mHeight
div 2), mWidth
, TGxRGBA
.Create(255, 255, 255));
1973 drawVLine(gx
+(mWidth
div 2), gy
, mHeight
, TGxRGBA
.Create(255, 255, 255));
1978 // ////////////////////////////////////////////////////////////////////////// //
1979 procedure THCtlHLine
.AfterConstruction ();
1987 // ////////////////////////////////////////////////////////////////////////// //
1988 procedure THCtlVLine
.AfterConstruction ();
1997 // ////////////////////////////////////////////////////////////////////////// //
1998 constructor THCtlTextLabel
.Create (const atext
: AnsiString);
2002 mDefSize
:= TLaySize
.Create(Length(atext
)*8, 8);
2006 procedure THCtlTextLabel
.AfterConstruction ();
2008 inherited AfterConstruction();
2012 if (mDefSize
.h
<= 0) then mDefSize
.h
:= 8;
2016 function THCtlTextLabel
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2018 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) then
2020 mText
:= par
.expectStrOrId(true);
2021 mDefSize
:= TLaySize
.Create(Length(mText
)*8, 8);
2025 if (strEquCI1251(prname
, 'textalign')) then
2027 parseTextAlign(par
, mHAlign
, mVAlign
);
2031 result
:= inherited parseProperty(prname
, par
);
2035 procedure THCtlTextLabel
.drawControl (gx
, gy
: Integer);
2037 xpos
, ypos
: Integer;
2040 fillRect(gx
, gy
, mWidth
, mHeight
, TGxRGBA
.Create(96, 96, 0));
2041 drawRectUI(gx
, gy
, mWidth
, mHeight
, TGxRGBA
.Create(96, 96, 96));
2043 if (Length(mText
) > 0) then
2045 if (mHAlign
< 0) then xpos
:= 0
2046 else if (mHAlign
> 0) then xpos
:= mWidth
-Length(mText
)*8
2047 else xpos
:= (mWidth
-Length(mText
)*8) div 2;
2049 if (mVAlign
< 0) then ypos
:= 0
2050 else if (mVAlign
> 0) then ypos
:= mHeight
-8
2051 else ypos
:= (mHeight
-8) div 2;
2053 drawText8(gx
+xpos
, gy
+ypos
, mText
, TGxRGBA
.Create(255, 255, 255));
2058 function THCtlTextLabel
.mouseEvent (var ev
: THMouseEvent
): Boolean;
2062 result
:= inherited mouseEvent(ev
);
2063 if not result
and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
2070 function THCtlTextLabel
.keyEvent (var ev
: THKeyEvent
): Boolean;
2072 result
:= inherited keyEvent(ev
);
2077 registerCtlClass(THCtlHBox
, 'hbox');
2078 registerCtlClass(THCtlVBox
, 'vbox');
2079 registerCtlClass(THCtlSpan
, 'span');
2080 registerCtlClass(THCtlHLine
, 'hline');
2081 registerCtlClass(THCtlVLine
, 'vline');
2082 registerCtlClass(THCtlTextLabel
, 'label');