1 (* coded by Ketmar // Invisible Vector <ketmar@ketmar.no-ip.org>
2 * Understanding is not required. Only obedience.
4 * This program is free software: you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation, either version 3 of the License, or
7 * (at your option) any later version.
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
14 * You should have received a copy of the GNU General Public License
15 * along with this program. If not, see <http://www.gnu.org/licenses/>.
17 {$INCLUDE ../shared/a_modes.inc}
31 // ////////////////////////////////////////////////////////////////////////// //
33 TUIControlClass
= class of TUIControl
;
37 type TActionCB
= procedure (me
: TUIControl
; uinfo
: Integer);
43 mWidth
, mHeight
: Integer;
44 mFrameWidth
, mFrameHeight
: Integer;
47 mChildren
: array of TUIControl
;
48 mFocused
: TUIControl
; // valid only for top-level controls
49 mGrab
: TUIControl
; // valid only for top-level controls
50 mEscClose
: Boolean; // valid only for top-level controls
59 function getEnabled (): Boolean;
60 procedure setEnabled (v
: Boolean); inline;
62 function getFocused (): Boolean; inline;
63 procedure setFocused (v
: Boolean); inline;
65 function isMyChild (ctl
: TUIControl
): Boolean;
67 function findFirstFocus (): TUIControl
;
68 function findLastFocus (): TUIControl
;
70 function findNextFocus (cur
: TUIControl
): TUIControl
;
71 function findPrevFocus (cur
: TUIControl
): TUIControl
;
73 procedure activated (); virtual;
74 procedure blurred (); virtual;
76 //WARNING! do not call scissor functions outside `.draw*()` API!
77 // set scissor to this rect (in local coords)
78 procedure setScissor (lx
, ly
, lw
, lh
: Integer);
79 // reset scissor to whole control
80 procedure resetScissor (fullArea
: Boolean); inline; // "full area" means "with frame"
83 // set scissor to this rect (in global coords)
84 procedure setScissorGLInternal (x
, y
, w
, h
: Integer);
90 mDefSize
: TLaySize
; // default size
91 mMaxSize
: TLaySize
; // maximum size
100 mLayDefSize
: TLaySize
;
101 mLayMaxSize
: TLaySize
;
104 // layouter interface
105 function getDefSize (): TLaySize
; inline; // default size; <0: use max size
106 //procedure setDefSize (const sz: TLaySize); inline; // default size; <0: use max size
107 function getMargins (): TLayMargins
; inline;
108 function getMaxSize (): TLaySize
; inline; // max size; <0: set to some huge value
109 //procedure setMaxSize (const sz: TLaySize); inline; // max size; <0: set to some huge value
110 function getFlex (): Integer; inline; // <=0: not flexible
111 function isHorizBox (): Boolean; inline; // horizontal layout for children?
112 procedure setHorizBox (v
: Boolean); inline; // horizontal layout for children?
113 function canWrap (): Boolean; inline; // for horizontal boxes: can wrap children? for child: `false` means 'nonbreakable at *next* ctl'
114 procedure setCanWrap (v
: Boolean); inline; // for horizontal boxes: can wrap children? for child: `false` means 'nonbreakable at *next* ctl'
115 function isLineStart (): Boolean; inline; // `true` if this ctl should start a new line; ignored for vertical boxes
116 procedure setLineStart (v
: Boolean); inline; // `true` if this ctl should start a new line; ignored for vertical boxes
117 function getAlign (): Integer; inline; // aligning in non-main direction: <0: left/up; 0: center; >0: right/down
118 procedure setAlign (v
: Integer); inline; // aligning in non-main direction: <0: left/up; 0: center; >0: right/down
119 function getExpand (): Boolean; inline; // expanding in non-main direction: `true` will ignore align and eat all available space
120 procedure setExpand (v
: Boolean); inline; // expanding in non-main direction: `true` will ignore align and eat all available space
121 function getHGroup (): AnsiString; inline; // empty: not grouped
122 procedure setHGroup (const v
: AnsiString); inline; // empty: not grouped
123 function getVGroup (): AnsiString; inline; // empty: not grouped
124 procedure setVGroup (const v
: AnsiString); inline; // empty: not grouped
126 procedure setActualSizePos (constref apos
: TLayPos
; constref asize
: TLaySize
); inline;
128 procedure layPrepare (); virtual; // called before registering control in layouter
131 property flex
: Integer read mFlex write mFlex
;
132 property flDefaultSize
: TLaySize read mDefSize write mDefSize
;
133 property flMaxSize
: TLaySize read mMaxSize write mMaxSize
;
134 property flHoriz
: Boolean read isHorizBox write setHorizBox
;
135 property flCanWrap
: Boolean read canWrap write setCanWrap
;
136 property flLineStart
: Boolean read isLineStart write setLineStart
;
137 property flAlign
: Integer read getAlign write setAlign
;
138 property flExpand
: Boolean read getExpand write setExpand
;
139 property flHGroup
: AnsiString read getHGroup write setHGroup
;
140 property flVGroup
: AnsiString read getVGroup write setVGroup
;
143 function parsePos (par
: TTextParser
): TLayPos
;
144 function parseSize (par
: TTextParser
): TLaySize
;
145 function parseBool (par
: TTextParser
): Boolean;
146 function parseAnyAlign (par
: TTextParser
): Integer;
147 function parseHAlign (par
: TTextParser
): Integer;
148 function parseVAlign (par
: TTextParser
): Integer;
149 function parseOrientation (const prname
: AnsiString; par
: TTextParser
): Boolean;
150 procedure parseTextAlign (par
: TTextParser
; var h
, v
: Integer);
151 procedure parseChildren (par
: TTextParser
); // par should be on '{'; final '}' is eaten
154 // par is on property data
155 // there may be more data in text stream, don't eat it!
156 // return `true` if property name is valid and value was parsed
157 // return `false` if property name is invalid; don't advance parser in this case
158 // throw on property data errors
159 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; virtual;
161 // par should be on '{'; final '}' is eaten
162 procedure parseProperties (par
: TTextParser
);
165 constructor Create ();
166 constructor Create (ax
, ay
, aw
, ah
: Integer);
167 destructor Destroy (); override;
169 // `sx` and `sy` are screen coordinates
170 procedure drawControl (gx
, gy
: Integer); virtual;
172 // called after all children drawn
173 procedure drawControlPost (gx
, gy
: Integer); virtual;
175 procedure draw (); virtual;
177 function topLevel (): TUIControl
; inline;
179 // returns `true` if global coords are inside this control
180 function toLocal (var x
, y
: Integer): Boolean;
181 function toLocal (gx
, gy
: Integer; out x
, y
: Integer): Boolean; inline;
182 procedure toGlobal (var x
, y
: Integer);
183 procedure toGlobal (lx
, ly
: Integer; out x
, y
: Integer); inline;
185 // x and y are global coords
186 function controlAtXY (x
, y
: Integer): TUIControl
;
188 function mouseEvent (var ev
: THMouseEvent
): Boolean; virtual; // returns `true` if event was eaten
189 function keyEvent (var ev
: THKeyEvent
): Boolean; virtual; // returns `true` if event was eaten
191 function prevSibling (): TUIControl
;
192 function nextSibling (): TUIControl
;
193 function firstChild (): TUIControl
; inline;
194 function lastChild (): TUIControl
; inline;
196 procedure appendChild (ctl
: TUIControl
); virtual;
199 property id
: AnsiString read mId
;
200 property x0
: Integer read mX
;
201 property y0
: Integer read mY
;
202 property height
: Integer read mHeight
;
203 property width
: Integer read mWidth
;
204 property enabled
: Boolean read getEnabled write setEnabled
;
205 property parent
: TUIControl read mParent
;
206 property focused
: Boolean read getFocused write setFocused
;
207 property escClose
: Boolean read mEscClose write mEscClose
;
208 property eatKeys
: Boolean read mEatKeys write mEatKeys
;
212 TUITopWindow
= class(TUIControl
)
216 mDragStartX
, mDragStartY
: Integer;
217 mWaitingClose
: Boolean;
219 mFreeOnClose
: Boolean; // default: false
220 mDoCenter
: Boolean; // after layouting
223 procedure activated (); override;
224 procedure blurred (); override;
227 closeCB
: TActionCB
; // called after window was removed from ui window list
230 constructor Create (const atitle
: AnsiString; ax
, ay
: Integer; aw
: Integer=-1; ah
: Integer=-1);
232 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
234 procedure centerInScreen ();
236 // `sx` and `sy` are screen coordinates
237 procedure drawControl (gx
, gy
: Integer); override;
238 procedure drawControlPost (gx
, gy
: Integer); override;
240 function keyEvent (var ev
: THKeyEvent
): Boolean; override; // returns `true` if event was eaten
241 function mouseEvent (var ev
: THMouseEvent
): Boolean; override; // returns `true` if event was eaten
244 property freeOnClose
: Boolean read mFreeOnClose write mFreeOnClose
;
248 TUISimpleText
= class(TUIControl
)
258 mItems
: array of TItem
;
261 constructor Create (ax
, ay
: Integer);
262 destructor Destroy (); override;
264 procedure appendItem (const atext
: AnsiString; acentered
: Boolean=false; ahline
: Boolean=false);
266 procedure drawControl (gx
, gy
: Integer); override;
268 function mouseEvent (var ev
: THMouseEvent
): Boolean; override;
269 function keyEvent (var ev
: THKeyEvent
): Boolean; override;
273 TUICBListBox
= class(TUIControl
)
283 mItems
: array of TItem
;
287 constructor Create (ax
, ay
: Integer);
288 destructor Destroy (); override;
290 procedure appendItem (const atext
: AnsiString; bv
: PBoolean; aaction
: TActionCB
=nil);
292 procedure drawControl (gx
, gy
: Integer); override;
294 function mouseEvent (var ev
: THMouseEvent
): Boolean; override;
295 function keyEvent (var ev
: THKeyEvent
): Boolean; override;
298 // ////////////////////////////////////////////////////////////////////// //
299 TUIBox
= class(TUIControl
)
302 mCaption
: AnsiString;
305 constructor Create (ahoriz
: Boolean);
307 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
309 procedure drawControl (gx
, gy
: Integer); override;
311 function mouseEvent (var ev
: THMouseEvent
): Boolean; override;
312 function keyEvent (var ev
: THKeyEvent
): Boolean; override;
315 TUIHBox
= class(TUIBox
)
317 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
320 TUIVBox
= class(TUIBox
)
322 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
325 // ////////////////////////////////////////////////////////////////////// //
326 TUISpan
= class(TUIControl
)
328 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
330 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
332 procedure drawControl (gx
, gy
: Integer); override;
335 // ////////////////////////////////////////////////////////////////////// //
336 TUILine
= class(TUIControl
)
338 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
340 procedure drawControl (gx
, gy
: Integer); override;
343 TUIHLine
= class(TUILine
)
345 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
348 TUIVLine
= class(TUILine
)
350 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
353 // ////////////////////////////////////////////////////////////////////// //
354 TUITextLabel
= class(TUIControl
)
357 mHAlign
: Integer; // -1: left; 0: center; 1: right; default: left
358 mVAlign
: Integer; // -1: top; 0: center; 1: bottom; default: center
361 constructor Create (const atext
: AnsiString);
363 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
365 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
367 procedure drawControl (gx
, gy
: Integer); override;
369 function mouseEvent (var ev
: THMouseEvent
): Boolean; override;
370 function keyEvent (var ev
: THKeyEvent
): Boolean; override;
374 // ////////////////////////////////////////////////////////////////////////// //
375 function uiMouseEvent (ev
: THMouseEvent
): Boolean;
376 function uiKeyEvent (ev
: THKeyEvent
): Boolean;
380 // ////////////////////////////////////////////////////////////////////////// //
381 procedure uiAddWindow (ctl
: TUIControl
);
382 procedure uiRemoveWindow (ctl
: TUIControl
); // will free window if `mFreeOnClose` is `true`
383 function uiVisibleWindow (ctl
: TUIControl
): Boolean;
386 // ////////////////////////////////////////////////////////////////////////// //
388 procedure uiLayoutCtl (ctl
: TUIControl
);
391 // ////////////////////////////////////////////////////////////////////////// //
393 gh_ui_scale
: Single = 1.0;
403 // ////////////////////////////////////////////////////////////////////////// //
405 knownCtlClasses
: array of record
406 klass
: TUIControlClass
;
411 procedure registerCtlClass (aklass
: TUIControlClass
; const aname
: AnsiString);
413 assert(aklass
<> nil);
414 assert(Length(aname
) > 0);
415 SetLength(knownCtlClasses
, Length(knownCtlClasses
)+1);
416 knownCtlClasses
[High(knownCtlClasses
)].klass
:= aklass
;
417 knownCtlClasses
[High(knownCtlClasses
)].name
:= aname
;
421 function findCtlClass (const aname
: AnsiString): TUIControlClass
;
425 for f
:= 0 to High(knownCtlClasses
) do
427 if (strEquCI1251(aname
, knownCtlClasses
[f
].name
)) then
429 result
:= knownCtlClasses
[f
].klass
;
437 // ////////////////////////////////////////////////////////////////////////// //
439 TFlexLayouter
= specialize TFlexLayouterBase
<TUIControl
>;
441 procedure uiLayoutCtl (ctl
: TUIControl
);
445 if (ctl
= nil) then exit
;
446 lay
:= TFlexLayouter
.Create();
451 //writeln('============================'); lay.dumpFlat();
453 //writeln('=== initial ==='); lay.dump();
455 //lay.calcMaxSizeInternal(0);
458 writeln('=== after first pass ===');
462 writeln('=== after second pass ===');
467 //writeln('=== final ==='); lay.dump();
469 if (ctl
.mParent
= nil) and (ctl
is TUITopWindow
) and (TUITopWindow(ctl
).mDoCenter
) then
471 TUITopWindow(ctl
).centerInScreen();
480 // ////////////////////////////////////////////////////////////////////////// //
482 uiTopList
: array of TUIControl
= nil;
485 function uiMouseEvent (ev
: THMouseEvent
): Boolean;
491 ev
.x
:= trunc(ev
.x
/gh_ui_scale
);
492 ev
.y
:= trunc(ev
.y
/gh_ui_scale
);
493 ev
.dx
:= trunc(ev
.dx
/gh_ui_scale
); //FIXME
494 ev
.dy
:= trunc(ev
.dy
/gh_ui_scale
); //FIXME
495 if (Length(uiTopList
) = 0) then result
:= false else result
:= uiTopList
[High(uiTopList
)].mouseEvent(ev
);
496 if not result
and (ev
.press
) then
498 for f
:= High(uiTopList
) downto 0 do
500 if uiTopList
[f
].toLocal(ev
.x
, ev
.y
, lx
, ly
) then
503 if uiTopList
[f
].mEnabled
and (f
<> High(uiTopList
)) then
505 uiTopList
[High(uiTopList
)].blurred();
506 ctmp
:= uiTopList
[f
];
508 for c
:= f
+1 to High(uiTopList
) do uiTopList
[c
-1] := uiTopList
[c
];
509 uiTopList
[High(uiTopList
)] := ctmp
;
511 result
:= ctmp
.mouseEvent(ev
);
520 function uiKeyEvent (ev
: THKeyEvent
): Boolean;
522 ev
.x
:= trunc(ev
.x
/gh_ui_scale
);
523 ev
.y
:= trunc(ev
.y
/gh_ui_scale
);
524 if (Length(uiTopList
) = 0) then result
:= false else result
:= uiTopList
[High(uiTopList
)].keyEvent(ev
);
525 if (ev
.release
) then begin result
:= true; exit
; end;
534 glMatrixMode(GL_MODELVIEW
);
538 glScalef(gh_ui_scale
, gh_ui_scale
, 1);
539 for f
:= 0 to High(uiTopList
) do
543 if (f
<> High(uiTopList
)) then darkenRect(ctl
.x0
, ctl
.y0
, ctl
.width
, ctl
.height
, 128);
546 glMatrixMode(GL_MODELVIEW
);
552 procedure uiAddWindow (ctl
: TUIControl
);
556 if (ctl
= nil) then exit
;
558 if not (ctl
is TUITopWindow
) then exit
; // alas
559 for f
:= 0 to High(uiTopList
) do
561 if (uiTopList
[f
] = ctl
) then
563 if (f
<> High(uiTopList
)) then
565 uiTopList
[High(uiTopList
)].blurred();
566 for c
:= f
+1 to High(uiTopList
) do uiTopList
[c
-1] := uiTopList
[c
];
567 uiTopList
[High(uiTopList
)] := ctl
;
573 if (Length(uiTopList
) > 0) then uiTopList
[High(uiTopList
)].blurred();
574 SetLength(uiTopList
, Length(uiTopList
)+1);
575 uiTopList
[High(uiTopList
)] := ctl
;
580 procedure uiRemoveWindow (ctl
: TUIControl
);
584 if (ctl
= nil) then exit
;
586 if not (ctl
is TUITopWindow
) then exit
; // alas
587 for f
:= 0 to High(uiTopList
) do
589 if (uiTopList
[f
] = ctl
) then
592 for c
:= f
+1 to High(uiTopList
) do uiTopList
[c
-1] := uiTopList
[c
];
593 SetLength(uiTopList
, Length(uiTopList
)-1);
594 if (ctl
is TUITopWindow
) then
597 if assigned(TUITopWindow(ctl
).closeCB
) then TUITopWindow(ctl
).closeCB(ctl
, 0);
599 if (TUITopWindow(ctl
).mFreeOnClose
) then FreeAndNil(ctl
);
608 function uiVisibleWindow (ctl
: TUIControl
): Boolean;
613 if (ctl
= nil) then exit
;
615 if not (ctl
is TUITopWindow
) then exit
; // alas
616 for f
:= 0 to High(uiTopList
) do
618 if (uiTopList
[f
] = ctl
) then begin result
:= true; exit
; end;
623 // ////////////////////////////////////////////////////////////////////////// //
624 constructor TUIControl
.Create ();
641 mDrawShadow
:= false;
643 // layouter interface
644 //mDefSize := TLaySize.Create(64, 8); // default size
645 mDefSize
:= TLaySize
.Create(0, 0); // default size
646 mMaxSize
:= TLaySize
.Create(-1, -1); // maximum size
653 mAlign
:= -1; // left/top
658 constructor TUIControl
.Create (ax
, ay
, aw
, ah
: Integer);
668 destructor TUIControl
.Destroy ();
672 if (mParent
<> nil) then
675 for f
:= 0 to High(mParent
.mChildren
) do
677 if (mParent
.mChildren
[f
] = self
) then
679 for c
:= f
+1 to High(mParent
.mChildren
) do mParent
.mChildren
[c
-1] := mParent
.mChildren
[c
];
680 SetLength(mParent
.mChildren
, Length(mParent
.mChildren
)-1);
684 for f
:= 0 to High(mChildren
) do
686 mChildren
[f
].mParent
:= nil;
693 // ////////////////////////////////////////////////////////////////////////// //
694 function TUIControl
.getDefSize (): TLaySize
; inline; begin result
:= mLayDefSize
; end;
695 function TUIControl
.getMaxSize (): TLaySize
; inline; begin result
:= mLayMaxSize
; end;
696 function TUIControl
.getFlex (): Integer; inline; begin result
:= mFlex
; end;
697 function TUIControl
.isHorizBox (): Boolean; inline; begin result
:= mHoriz
; end;
698 procedure TUIControl
.setHorizBox (v
: Boolean); inline; begin mHoriz
:= v
; end;
699 function TUIControl
.canWrap (): Boolean; inline; begin result
:= mCanWrap
; end;
700 procedure TUIControl
.setCanWrap (v
: Boolean); inline; begin mCanWrap
:= v
; end;
701 function TUIControl
.isLineStart (): Boolean; inline; begin result
:= mLineStart
; end;
702 procedure TUIControl
.setLineStart (v
: Boolean); inline; begin mLineStart
:= v
; end;
703 function TUIControl
.getAlign (): Integer; inline; begin result
:= mAlign
; end;
704 procedure TUIControl
.setAlign (v
: Integer); inline; begin mAlign
:= v
; end;
705 function TUIControl
.getExpand (): Boolean; inline; begin result
:= mExpand
; end;
706 procedure TUIControl
.setExpand (v
: Boolean); inline; begin mExpand
:= v
; end;
707 function TUIControl
.getHGroup (): AnsiString; inline; begin result
:= mHGroup
; end;
708 procedure TUIControl
.setHGroup (const v
: AnsiString); inline; begin mHGroup
:= v
; end;
709 function TUIControl
.getVGroup (): AnsiString; inline; begin result
:= mVGroup
; end;
710 procedure TUIControl
.setVGroup (const v
: AnsiString); inline; begin mVGroup
:= v
; end;
712 function TUIControl
.getMargins (): TLayMargins
; inline;
714 result
:= TLayMargins
.Create(mFrameHeight
, mFrameWidth
, mFrameHeight
, mFrameWidth
);
717 procedure TUIControl
.setActualSizePos (constref apos
: TLayPos
; constref asize
: TLaySize
); inline; begin
718 //writeln(self.className, '; pos=', apos.toString, '; size=', asize.toString);
719 if (mParent
<> nil) then
728 procedure TUIControl
.layPrepare ();
730 mLayDefSize
:= mDefSize
;
731 mLayMaxSize
:= mMaxSize
;
732 if (mLayMaxSize
.w
>= 0) then mLayMaxSize
.w
+= mFrameWidth
*2;
733 if (mLayMaxSize
.h
>= 0) then mLayMaxSize
.h
+= mFrameHeight
*2;
737 // ////////////////////////////////////////////////////////////////////////// //
738 function TUIControl
.parsePos (par
: TTextParser
): TLayPos
;
742 if (par
.eatDelim('[')) then ech
:= ']' else par
.expectDelim('(');
743 result
.x
:= par
.expectInt();
744 par
.eatDelim(','); // optional comma
745 result
.y
:= par
.expectInt();
746 par
.eatDelim(','); // optional comma
747 par
.expectDelim(ech
);
750 function TUIControl
.parseSize (par
: TTextParser
): TLaySize
;
754 if (par
.eatDelim('[')) then ech
:= ']' else par
.expectDelim('(');
755 result
.w
:= par
.expectInt();
756 par
.eatDelim(','); // optional comma
757 result
.h
:= par
.expectInt();
758 par
.eatDelim(','); // optional comma
759 par
.expectDelim(ech
);
762 function TUIControl
.parseBool (par
: TTextParser
): Boolean;
765 par
.eatIdOrStrCI('true') or
766 par
.eatIdOrStrCI('yes') or
767 par
.eatIdOrStrCI('tan');
770 if (not par
.eatIdOrStrCI('false')) and (not par
.eatIdOrStrCI('no')) and (not par
.eatIdOrStrCI('ona')) then
772 par
.error('boolean value expected');
777 function TUIControl
.parseAnyAlign (par
: TTextParser
): Integer;
779 if (par
.eatIdOrStrCI('left')) or (par
.eatIdOrStrCI('top')) then result
:= -1
780 else if (par
.eatIdOrStrCI('right')) or (par
.eatIdOrStrCI('bottom')) then result
:= 1
781 else if (par
.eatIdOrStrCI('center')) then result
:= 0
782 else par
.error('invalid align value');
785 function TUIControl
.parseHAlign (par
: TTextParser
): Integer;
787 if (par
.eatIdOrStrCI('left')) then result
:= -1
788 else if (par
.eatIdOrStrCI('right')) then result
:= 1
789 else if (par
.eatIdOrStrCI('center')) then result
:= 0
790 else par
.error('invalid horizontal align value');
793 function TUIControl
.parseVAlign (par
: TTextParser
): Integer;
795 if (par
.eatIdOrStrCI('top')) then result
:= -1
796 else if (par
.eatIdOrStrCI('bottom')) then result
:= 1
797 else if (par
.eatIdOrStrCI('center')) then result
:= 0
798 else par
.error('invalid vertical align value');
801 procedure TUIControl
.parseTextAlign (par
: TTextParser
; var h
, v
: Integer);
803 wasH
: Boolean = false;
804 wasV
: Boolean = false;
808 if (par
.eatIdOrStrCI('left')) then
810 if wasH
then par
.error('too many align directives');
815 if (par
.eatIdOrStrCI('right')) then
817 if wasH
then par
.error('too many align directives');
822 if (par
.eatIdOrStrCI('hcenter')) then
824 if wasH
then par
.error('too many align directives');
829 if (par
.eatIdOrStrCI('top')) then
831 if wasV
then par
.error('too many align directives');
836 if (par
.eatIdOrStrCI('bottom')) then
838 if wasV
then par
.error('too many align directives');
843 if (par
.eatIdOrStrCI('vcenter')) then
845 if wasV
then par
.error('too many align directives');
850 if (par
.eatIdOrStrCI('center')) then
852 if wasV
or wasH
then par
.error('too many align directives');
861 if not wasV
and not wasH
then par
.error('invalid align value');
864 function TUIControl
.parseOrientation (const prname
: AnsiString; par
: TTextParser
): Boolean;
866 if (strEquCI1251(prname
, 'orientation')) or (strEquCI1251(prname
, 'orient')) then
868 if (par
.eatIdOrStrCI('horizontal')) or (par
.eatIdOrStrCI('horiz')) then mHoriz
:= true
869 else if (par
.eatIdOrStrCI('vertical')) or (par
.eatIdOrStrCI('vert')) then mHoriz
:= false
870 else par
.error('`horizontal` or `vertical` expected');
879 // par should be on '{'; final '}' is eaten
880 procedure TUIControl
.parseProperties (par
: TTextParser
);
884 if (not par
.eatDelim('{')) then exit
;
885 while (not par
.eatDelim('}')) do
887 if (not par
.isIdOrStr
) then par
.error('property name expected');
890 par
.eatDelim(':'); // optional
891 if not parseProperty(pn
, par
) then par
.errorfmt('invalid property name ''%s''', [pn
]);
892 par
.eatDelim(','); // optional
896 // par should be on '{'
897 procedure TUIControl
.parseChildren (par
: TTextParser
);
902 par
.expectDelim('{');
903 while (not par
.eatDelim('}')) do
905 if (not par
.isIdOrStr
) then par
.error('control name expected');
906 cc
:= findCtlClass(par
.tokStr
);
907 if (cc
= nil) then par
.errorfmt('unknown control name: ''%s''', [par
.tokStr
]);
908 //writeln('children for <', par.tokStr, '>: <', cc.className, '>');
910 par
.eatDelim(':'); // optional
912 //writeln(' mHoriz=', ctl.mHoriz);
914 ctl
.parseProperties(par
);
919 //writeln(': ', ctl.mDefSize.toString);
921 par
.eatDelim(','); // optional
926 function TUIControl
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
929 if (strEquCI1251(prname
, 'id')) then begin mId
:= par
.expectStrOrId(true); exit
; end; // allow empty strings
930 if (strEquCI1251(prname
, 'flex')) then begin flex
:= par
.expectInt(); exit
; end;
932 if (strEquCI1251(prname
, 'defsize')) or (strEquCI1251(prname
, 'size')) then begin mDefSize
:= parseSize(par
); exit
; end;
933 if (strEquCI1251(prname
, 'maxsize')) then begin mMaxSize
:= parseSize(par
); exit
; end;
934 if (strEquCI1251(prname
, 'defwidth')) or (strEquCI1251(prname
, 'width')) then begin mDefSize
.w
:= par
.expectInt(); exit
; end;
935 if (strEquCI1251(prname
, 'defheight')) or (strEquCI1251(prname
, 'height')) then begin mDefSize
.h
:= par
.expectInt(); exit
; end;
936 if (strEquCI1251(prname
, 'maxwidth')) then begin mMaxSize
.w
:= par
.expectInt(); exit
; end;
937 if (strEquCI1251(prname
, 'maxheight')) then begin mMaxSize
.h
:= par
.expectInt(); exit
; end;
939 if (strEquCI1251(prname
, 'wrap')) then begin mCanWrap
:= parseBool(par
); exit
; end;
940 if (strEquCI1251(prname
, 'linestart')) then begin mLineStart
:= parseBool(par
); exit
; end;
941 if (strEquCI1251(prname
, 'expand')) then begin mExpand
:= parseBool(par
); exit
; end;
943 if (strEquCI1251(prname
, 'align')) then begin mAlign
:= parseAnyAlign(par
); exit
; end;
944 if (strEquCI1251(prname
, 'hgroup')) then begin mHGroup
:= par
.expectStrOrId(true); exit
; end; // allow empty strings
945 if (strEquCI1251(prname
, 'vgroup')) then begin mVGroup
:= par
.expectStrOrId(true); exit
; end; // allow empty strings
947 if (strEquCI1251(prname
, 'canfocus')) then begin mCanFocus
:= parseBool(par
); exit
; end;
948 if (strEquCI1251(prname
, 'enabled')) then begin mEnabled
:= parseBool(par
); exit
; end;
949 if (strEquCI1251(prname
, 'disabled')) then begin mEnabled
:= not parseBool(par
); exit
; end;
950 if (strEquCI1251(prname
, 'escclose')) then begin mEscClose
:= not parseBool(par
); exit
; end;
951 if (strEquCI1251(prname
, 'eatkeys')) then begin mEatKeys
:= not parseBool(par
); exit
; end;
956 // ////////////////////////////////////////////////////////////////////////// //
957 procedure TUIControl
.activated ();
962 procedure TUIControl
.blurred ();
968 function TUIControl
.topLevel (): TUIControl
; inline;
971 while (result
.mParent
<> nil) do result
:= result
.mParent
;
975 function TUIControl
.getEnabled (): Boolean;
980 if (not mEnabled
) or (mWidth
< 1) or (mHeight
< 1) then exit
;
982 while (ctl
<> nil) do
984 if (not ctl
.mEnabled
) or (ctl
.mWidth
< 1) or (ctl
.mHeight
< 1) then exit
;
991 procedure TUIControl
.setEnabled (v
: Boolean); inline;
993 if (mEnabled
= v
) then exit
;
995 if not v
and focused
then setFocused(false);
999 function TUIControl
.getFocused (): Boolean; inline;
1001 if (mParent
= nil) then result
:= (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)] = self
) else result
:= (topLevel
.mFocused
= self
);
1005 procedure TUIControl
.setFocused (v
: Boolean); inline;
1012 if (tl
.mFocused
= self
) then
1015 tl
.mFocused
:= tl
.findNextFocus(self
);
1016 if (tl
.mFocused
= self
) then tl
.mFocused
:= nil;
1020 if (not mEnabled
) or (not mCanFocus
) then exit
;
1021 if (tl
.mFocused
<> self
) then
1023 if (tl
.mFocused
<> nil) then tl
.mFocused
.blurred();
1024 tl
.mFocused
:= self
;
1025 if (tl
.mGrab
<> self
) then tl
.mGrab
:= nil;
1031 function TUIControl
.isMyChild (ctl
: TUIControl
): Boolean;
1034 while (ctl
<> nil) do
1036 if (ctl
.mParent
= self
) then exit
;
1043 // returns `true` if global coords are inside this control
1044 function TUIControl
.toLocal (var x
, y
: Integer): Boolean;
1049 while (ctl
<> nil) do
1055 result
:= (x
>= 0) and (y
>= 0) and (x
< mWidth
) and (y
< mHeight
);
1058 function TUIControl
.toLocal (gx
, gy
: Integer; out x
, y
: Integer): Boolean; inline;
1062 result
:= toLocal(x
, y
);
1065 procedure TUIControl
.toGlobal (var x
, y
: Integer);
1070 while (ctl
<> nil) do
1078 procedure TUIControl
.toGlobal (lx
, ly
: Integer; out x
, y
: Integer); inline;
1086 // x and y are global coords
1087 function TUIControl
.controlAtXY (x
, y
: Integer): TUIControl
;
1093 if (not mEnabled
) or (mWidth
< 1) or (mHeight
< 1) then exit
;
1094 if not toLocal(x
, y
, lx
, ly
) then exit
;
1095 for f
:= High(mChildren
) downto 0 do
1097 result
:= mChildren
[f
].controlAtXY(x
, y
);
1098 if (result
<> nil) then exit
;
1104 function TUIControl
.prevSibling (): TUIControl
;
1108 if (mParent
<> nil) then
1110 for f
:= 1 to High(mParent
.mChildren
) do
1112 if (mParent
.mChildren
[f
] = self
) then begin result
:= mParent
.mChildren
[f
-1]; exit
; end;
1118 function TUIControl
.nextSibling (): TUIControl
;
1122 if (mParent
<> nil) then
1124 for f
:= 0 to High(mParent
.mChildren
)-1 do
1126 if (mParent
.mChildren
[f
] = self
) then begin result
:= mParent
.mChildren
[f
+1]; exit
; end;
1132 function TUIControl
.firstChild (): TUIControl
; inline;
1134 if (Length(mChildren
) <> 0) then result
:= mChildren
[0] else result
:= nil;
1137 function TUIControl
.lastChild (): TUIControl
; inline;
1139 if (Length(mChildren
) <> 0) then result
:= mChildren
[High(mChildren
)] else result
:= nil;
1143 function TUIControl
.findFirstFocus (): TUIControl
;
1150 for f
:= 0 to High(mChildren
) do
1152 result
:= mChildren
[f
].findFirstFocus();
1153 if (result
<> nil) then exit
;
1155 if mCanFocus
then result
:= self
;
1160 function TUIControl
.findLastFocus (): TUIControl
;
1167 for f
:= High(mChildren
) downto 0 do
1169 result
:= mChildren
[f
].findLastFocus();
1170 if (result
<> nil) then exit
;
1172 if mCanFocus
then result
:= self
;
1177 function TUIControl
.findNextFocus (cur
: TUIControl
): TUIControl
;
1182 if not isMyChild(cur
) then cur
:= nil;
1183 if (cur
= nil) then begin result
:= findFirstFocus(); exit
; end;
1184 result
:= cur
.findFirstFocus();
1185 if (result
<> nil) and (result
<> cur
) then exit
;
1188 cur
:= cur
.nextSibling
;
1189 if (cur
= nil) then break
;
1190 result
:= cur
.findFirstFocus();
1191 if (result
<> nil) then exit
;
1193 result
:= findFirstFocus();
1198 function TUIControl
.findPrevFocus (cur
: TUIControl
): TUIControl
;
1203 if not isMyChild(cur
) then cur
:= nil;
1204 if (cur
= nil) then begin result
:= findLastFocus(); exit
; end;
1206 result
:= cur
.findLastFocus();
1207 if (result
<> nil) and (result
<> cur
) then exit
;
1210 cur
:= cur
.prevSibling
;
1211 if (cur
= nil) then break
;
1212 result
:= cur
.findLastFocus();
1213 if (result
<> nil) then exit
;
1215 result
:= findLastFocus();
1220 procedure TUIControl
.appendChild (ctl
: TUIControl
);
1222 if (ctl
= nil) then exit
;
1223 if (ctl
.mParent
<> nil) then exit
;
1224 SetLength(mChildren
, Length(mChildren
)+1);
1225 mChildren
[High(mChildren
)] := ctl
;
1226 ctl
.mParent
:= self
;
1227 Inc(ctl
.mX
, mFrameWidth
);
1228 Inc(ctl
.mY
, mFrameHeight
);
1229 if (ctl
.mWidth
> 0) and (ctl
.mHeight
> 0) and
1230 (ctl
.mX
+ctl
.mWidth
> mFrameWidth
) and (ctl
.mY
+ctl
.mHeight
> mFrameHeight
) then
1232 if (mWidth
+mFrameWidth
< ctl
.mX
+ctl
.mWidth
) then mWidth
:= ctl
.mX
+ctl
.mWidth
+mFrameWidth
;
1233 if (mHeight
+mFrameHeight
< ctl
.mY
+ctl
.mHeight
) then mHeight
:= ctl
.mY
+ctl
.mHeight
+mFrameHeight
;
1235 //if (mFocused = nil) and ctl.mEnabled and ctl.mCanFocus and (ctl.mWidth > 0) and (ctl.mHeight > 0) then mFocused := ctl;
1239 // ////////////////////////////////////////////////////////////////////////// //
1240 procedure TUIControl
.setScissorGLInternal (x
, y
, w
, h
: Integer);
1242 if not scallowed
then exit
;
1243 x
:= trunc(x
*gh_ui_scale
);
1244 y
:= trunc(y
*gh_ui_scale
);
1245 w
:= trunc(w
*gh_ui_scale
);
1246 h
:= trunc(h
*gh_ui_scale
);
1247 scis
.combineRect(x
, y
, w
, h
);
1250 procedure TUIControl
.setScissor (lx
, ly
, lw
, lh
: Integer);
1253 //ox, oy, ow, oh: Integer;
1255 if not scallowed
then exit
;
1256 //ox := lx; oy := ly; ow := lw; oh := lh;
1257 if not intersectRect(lx
, ly
, lw
, lh
, 0, 0, mWidth
, mHeight
) then
1259 //writeln('oops: <', self.className, '>: old=(', ox, ',', oy, ')-[', ow, ',', oh, ']');
1260 glScissor(0, 0, 0, 0);
1263 toGlobal(lx
, ly
, gx
, gy
);
1264 setScissorGLInternal(gx
, gy
, lw
, lh
);
1267 procedure TUIControl
.resetScissor (fullArea
: Boolean); inline;
1269 if not scallowed
then exit
;
1272 setScissor(0, 0, mWidth
, mHeight
);
1276 setScissor(mFrameWidth
, mFrameHeight
, mWidth
-mFrameWidth
*2, mHeight
-mFrameHeight
*2);
1281 // ////////////////////////////////////////////////////////////////////////// //
1282 procedure TUIControl
.draw ();
1287 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1288 toGlobal(0, 0, gx
, gy
);
1289 //conwritefln('[%s]: (%d,%d)-(%d,%d) (%d,%d)', [ClassName, mX, mY, mWidth, mHeight, x, y]);
1291 scis
.save(true); // scissoring enabled
1294 resetScissor(true); // full area
1295 drawControl(gx
, gy
);
1296 resetScissor(false); // client area
1297 for f
:= 0 to High(mChildren
) do mChildren
[f
].draw();
1298 resetScissor(true); // full area
1299 drawControlPost(gx
, gy
);
1306 procedure TUIControl
.drawControl (gx
, gy
: Integer);
1308 if (mParent
= nil) then darkenRect(gx
, gy
, mWidth
, mHeight
, 64);
1311 procedure TUIControl
.drawControlPost (gx
, gy
: Integer);
1314 if mDrawShadow
and (mWidth
> 0) and (mHeight
> 0) then
1316 setScissorGLInternal(gx
+8, gy
+8, mWidth
, mHeight
);
1317 darkenRect(gx
+mWidth
, gy
+8, 8, mHeight
, 128);
1318 darkenRect(gx
+8, gy
+mHeight
, mWidth
-8, 8, 128);
1323 // ////////////////////////////////////////////////////////////////////////// //
1324 function TUIControl
.mouseEvent (var ev
: THMouseEvent
): Boolean;
1329 if not mEnabled
then exit
;
1330 if (mParent
= nil) then
1332 if (mGrab
<> nil) then
1334 result
:= mGrab
.mouseEvent(ev
);
1335 if (ev
.release
) then mGrab
:= nil;
1339 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1340 ctl
:= controlAtXY(ev
.x
, ev
.y
);
1341 if (ctl
<> nil) and (ctl
<> self
) then
1343 if (ctl
<> topLevel
.mFocused
) then ctl
.setFocused(true);
1344 result
:= ctl
.mouseEvent(ev
);
1346 else if (ctl
= self
) and assigned(actionCB
) then
1353 function TUIControl
.keyEvent (var ev
: THKeyEvent
): Boolean;
1358 if not mEnabled
then exit
;
1359 if (topLevel
.mFocused
<> self
) and isMyChild(topLevel
.mFocused
) and topLevel
.mFocused
.mEnabled
then result
:= topLevel
.mFocused
.keyEvent(ev
);
1360 if (mParent
= nil) then
1362 if (ev
= 'S-Tab') then
1365 ctl
:= findPrevFocus(mFocused
);
1366 if (ctl
<> mFocused
) then
1373 if (ev
= 'Tab') then
1376 ctl
:= findNextFocus(mFocused
);
1377 if (ctl
<> mFocused
) then
1384 if mEscClose
and (ev
= 'Escape') then
1387 uiRemoveWindow(self
);
1391 if mEatKeys
then result
:= true;
1395 // ////////////////////////////////////////////////////////////////////////// //
1396 constructor TUITopWindow
.Create (const atitle
: AnsiString; ax
, ay
: Integer; aw
: Integer=-1; ah
: Integer=-1);
1398 inherited Create(ax
, ay
, aw
, ah
);
1402 if (mWidth
< mFrameWidth
*2+3*8) then mWidth
:= mFrameWidth
*2+3*8;
1403 if (mHeight
< mFrameHeight
*2) then mHeight
:= mFrameHeight
*2;
1404 if (Length(mTitle
) > 0) then
1406 if (mWidth
< Length(mTitle
)*8+mFrameWidth
*2+3*8) then mWidth
:= Length(mTitle
)*8+mFrameWidth
*2+3*8;
1409 mDrawShadow
:= true;
1410 mWaitingClose
:= false;
1416 function TUITopWindow
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
1418 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) then
1420 mTitle
:= par
.expectStrOrId(true);
1424 if (strEquCI1251(prname
, 'children')) then
1430 if (strEquCI1251(prname
, 'position')) then
1432 if (par
.eatIdOrStrCI('default')) then mDoCenter
:= false
1433 else if (par
.eatIdOrStrCI('center')) then mDoCenter
:= true
1434 else par
.error('`center` or `default` expected');
1438 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
1439 result
:= inherited parseProperty(prname
, par
);
1443 procedure TUITopWindow
.centerInScreen ();
1445 if (mWidth
> 0) and (mHeight
> 0) then
1447 mX
:= trunc((gScrWidth
/gh_ui_scale
-mWidth
)/2);
1448 mY
:= trunc((gScrHeight
/gh_ui_scale
-mHeight
)/2);
1453 procedure TUITopWindow
.drawControl (gx
, gy
: Integer);
1455 fillRect(gx
, gy
, mWidth
, mHeight
, TGxRGBA
.Create(0, 0, 128));
1459 procedure TUITopWindow
.drawControlPost (gx
, gy
: Integer);
1468 drawRectUI(mX
+4, mY
+4, mWidth
-8, mHeight
-8, TGxRGBA
.Create(r
, g
, b
));
1472 drawRectUI(mX
+3, mY
+3, mWidth
-6, mHeight
-6, TGxRGBA
.Create(r
, g
, b
));
1473 drawRectUI(mX
+5, mY
+5, mWidth
-10, mHeight
-10, TGxRGBA
.Create(r
, g
, b
));
1474 setScissor(mFrameWidth
, 0, 3*8, 8);
1475 fillRect(mX
+mFrameWidth
, mY
, 3*8, 8, TGxRGBA
.Create(0, 0, 128));
1476 drawText8(mX
+mFrameWidth
, mY
, '[ ]', TGxRGBA
.Create(r
, g
, b
));
1477 if mInClose
then drawText8(mX
+mFrameWidth
+7, mY
, '#', TGxRGBA
.Create(0, 255, 0))
1478 else drawText8(mX
+mFrameWidth
+7, mY
, '*', TGxRGBA
.Create(0, 255, 0));
1480 if (Length(mTitle
) > 0) then
1482 setScissor(mFrameWidth
+3*8, 0, mWidth
-mFrameWidth
*2-3*8, 8);
1483 tx
:= (mX
+3*8)+((mWidth
-3*8)-Length(mTitle
)*8) div 2;
1484 fillRect(tx
-3, mY
, Length(mTitle
)*8+3+2, 8, TGxRGBA
.Create(0, 0, 128));
1485 drawText8(tx
, mY
, mTitle
, TGxRGBA
.Create(r
, g
, b
));
1487 inherited drawControlPost(gx
, gy
);
1491 procedure TUITopWindow
.activated ();
1493 if (mFocused
= nil) or (mFocused
= self
) then
1495 mFocused
:= findFirstFocus();
1496 if (mFocused
<> nil) and (mFocused
<> self
) then mFocused
.activated();
1502 procedure TUITopWindow
.blurred ();
1505 mWaitingClose
:= false;
1511 function TUITopWindow
.keyEvent (var ev
: THKeyEvent
): Boolean;
1513 result
:= inherited keyEvent(ev
);
1514 if not getFocused
then exit
;
1515 if (ev
= 'M-F3') then
1517 uiRemoveWindow(self
);
1524 function TUITopWindow
.mouseEvent (var ev
: THMouseEvent
): Boolean;
1529 if not mEnabled
then exit
;
1530 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1534 mX
+= ev
.x
-mDragStartX
;
1535 mY
+= ev
.y
-mDragStartY
;
1536 mDragStartX
:= ev
.x
;
1537 mDragStartY
:= ev
.y
;
1538 if (ev
.release
) then mDragging
:= false;
1543 if toLocal(ev
.x
, ev
.y
, lx
, ly
) then
1549 if (lx
>= mFrameWidth
) and (lx
< mFrameWidth
+3*8) then
1551 //uiRemoveWindow(self);
1552 mWaitingClose
:= true;
1558 mDragStartX
:= ev
.x
;
1559 mDragStartY
:= ev
.y
;
1564 if (lx
< mFrameWidth
) or (lx
>= mWidth
-mFrameWidth
) or (ly
>= mHeight
-mFrameHeight
) then
1567 mDragStartX
:= ev
.x
;
1568 mDragStartY
:= ev
.y
;
1574 if (ev
.release
) then
1576 if mWaitingClose
and (lx
>= mFrameWidth
) and (lx
< mFrameWidth
+3*8) then
1578 uiRemoveWindow(self
);
1582 mWaitingClose
:= false;
1588 if mWaitingClose
then
1590 mInClose
:= (lx
>= mFrameWidth
) and (lx
< mFrameWidth
+3*8);
1599 if (not ev
.motion
) then mWaitingClose
:= false;
1602 result
:= inherited mouseEvent(ev
);
1606 // ////////////////////////////////////////////////////////////////////////// //
1607 constructor TUISimpleText
.Create (ax
, ay
: Integer);
1610 inherited Create(ax
, ay
, 4, 4);
1614 destructor TUISimpleText
.Destroy ();
1621 procedure TUISimpleText
.appendItem (const atext
: AnsiString; acentered
: Boolean=false; ahline
: Boolean=false);
1625 if (Length(atext
)*8+3*8+2 > mWidth
) then mWidth
:= Length(atext
)*8+3*8+2;
1626 SetLength(mItems
, Length(mItems
)+1);
1627 it
:= @mItems
[High(mItems
)];
1629 it
.centered
:= acentered
;
1631 if (Length(mItems
)*8 > mHeight
) then mHeight
:= Length(mItems
)*8;
1635 procedure TUISimpleText
.drawControl (gx
, gy
: Integer);
1641 for f
:= 0 to High(mItems
) do
1648 if it
.centered
then begin b
:= 255; tx
:= gx
+(mWidth
-Length(it
.title
)*8) div 2; end;
1652 if (Length(it
.title
) = 0) then
1654 drawHLine(gx
+4, gy
+3, mWidth
-8, TGxRGBA
.Create(r
, g
, b
));
1656 else if (tx
-3 > gx
+4) then
1658 drawHLine(gx
+4, gy
+3, tx
-3-(gx
+3), TGxRGBA
.Create(r
, g
, b
));
1659 drawHLine(tx
+Length(it
.title
)*8, gy
+3, mWidth
-4, TGxRGBA
.Create(r
, g
, b
));
1662 drawText8(tx
, gy
, it
.title
, TGxRGBA
.Create(r
, g
, b
));
1668 function TUISimpleText
.mouseEvent (var ev
: THMouseEvent
): Boolean;
1672 result
:= inherited mouseEvent(ev
);
1673 if not result
and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
1680 function TUISimpleText
.keyEvent (var ev
: THKeyEvent
): Boolean;
1682 result
:= inherited keyEvent(ev
);
1686 // ////////////////////////////////////////////////////////////////////////// //
1687 constructor TUICBListBox
.Create (ax
, ay
: Integer);
1691 inherited Create(ax
, ay
, 4, 4);
1695 destructor TUICBListBox
.Destroy ();
1702 procedure TUICBListBox
.appendItem (const atext
: AnsiString; bv
: PBoolean; aaction
: TActionCB
=nil);
1706 if (Length(atext
)*8+3*8+2 > mWidth
) then mWidth
:= Length(atext
)*8+3*8+2;
1707 SetLength(mItems
, Length(mItems
)+1);
1708 it
:= @mItems
[High(mItems
)];
1711 it
.actionCB
:= aaction
;
1712 if (Length(mItems
)*8 > mHeight
) then mHeight
:= Length(mItems
)*8;
1713 if (mCurIndex
< 0) then mCurIndex
:= 0;
1717 procedure TUICBListBox
.drawControl (gx
, gy
: Integer);
1722 for f
:= 0 to High(mItems
) do
1725 if (mCurIndex
= f
) then fillRect(gx
, gy
, mWidth
, 8, TGxRGBA
.Create(0, 128, 0));
1726 if (it
.varp
<> nil) then
1728 if it
.varp
^ then drawText8(gx
, gy
, '[x]', TGxRGBA
.Create(255, 255, 255)) else drawText8(gx
, gy
, '[ ]', TGxRGBA
.Create(255, 255, 255));
1729 drawText8(gx
+3*8+2, gy
, it
.title
, TGxRGBA
.Create(255, 255, 0));
1731 else if (Length(it
.title
) > 0) then
1733 tx
:= gx
+(mWidth
-Length(it
.title
)*8) div 2;
1734 if (tx
-3 > gx
+4) then
1736 drawHLine(gx
+4, gy
+3, tx
-3-(gx
+3), TGxRGBA
.Create(255, 255, 255));
1737 drawHLine(tx
+Length(it
.title
)*8, gy
+3, mWidth
-4, TGxRGBA
.Create(255, 255, 255));
1739 drawText8(tx
, gy
, it
.title
, TGxRGBA
.Create(255, 255, 255));
1743 drawHLine(gx
+4, gy
+3, mWidth
-8, TGxRGBA
.Create(255, 255, 255));
1750 function TUICBListBox
.mouseEvent (var ev
: THMouseEvent
): Boolean;
1755 result
:= inherited mouseEvent(ev
);
1756 if not result
and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
1759 if (ev
= 'lmb') then
1762 if (ly
>= 0) and (ly
< Length(mItems
)) then
1765 if (it
.varp
<> nil) then
1768 it
.varp
^ := not it
.varp
^;
1769 if assigned(it
.actionCB
) then it
.actionCB(self
, Integer(it
.varp
^));
1770 if assigned(actionCB
) then actionCB(self
, ly
);
1778 function TUICBListBox
.keyEvent (var ev
: THKeyEvent
): Boolean;
1782 result
:= inherited keyEvent(ev
);
1783 if not getFocused
then exit
;
1785 if (ev
= 'Home') or (ev
= 'PageUp') then
1790 if (ev
= 'End') or (ev
= 'PageDown') then
1793 mCurIndex
:= High(mItems
);
1798 if (Length(mItems
) > 0) then
1800 if (mCurIndex
< 0) then mCurIndex
:= Length(mItems
);
1801 while (mCurIndex
> 0) do
1804 if (mItems
[mCurIndex
].varp
<> nil) then break
;
1812 if (ev
= 'Down') then
1815 if (Length(mItems
) > 0) then
1817 if (mCurIndex
< 0) then mCurIndex
:= -1;
1818 while (mCurIndex
< High(mItems
)) do
1821 if (mItems
[mCurIndex
].varp
<> nil) then break
;
1829 if (ev
= 'Space') or (ev
= 'Enter') then
1832 if (mCurIndex
>= 0) and (mCurIndex
< Length(mItems
)) and (mItems
[mCurIndex
].varp
<> nil) then
1834 it
:= @mItems
[mCurIndex
];
1835 it
.varp
^ := not it
.varp
^;
1836 if assigned(it
.actionCB
) then it
.actionCB(self
, Integer(it
.varp
^));
1837 if assigned(actionCB
) then actionCB(self
, mCurIndex
);
1843 // ////////////////////////////////////////////////////////////////////////// //
1844 constructor TUIBox
.Create (ahoriz
: Boolean);
1852 function TUIBox
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
1854 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
1855 if (strEquCI1251(prname
, 'frame')) then
1857 mHasFrame
:= parseBool(par
);
1858 if (mHasFrame
) then begin mFrameWidth
:= 8; mFrameHeight
:= 8; end else begin mFrameWidth
:= 0; mFrameHeight
:= 0; end;
1862 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) then
1864 mCaption
:= par
.expectStrOrId(true);
1865 mDefSize
:= TLaySize
.Create(Length(mCaption
)*8+3, 8);
1869 if (strEquCI1251(prname
, 'children')) then
1875 result
:= inherited parseProperty(prname
, par
);
1879 procedure TUIBox
.drawControl (gx
, gy
: Integer);
1884 if focused
then begin r
:= 255; g
:= 255; b
:= 255; end else begin r
:= 255; g
:= 255; b
:= 0; end;
1888 drawRectUI(gx
+3, gy
+3, mWidth
-6, mHeight
-6, TGxRGBA
.Create(r
, g
, b
));
1891 if (Length(mCaption
) > 0) then
1893 setScissor(mFrameWidth
+1, 0, mWidth
-mFrameWidth
-2, 8);
1894 tx
:= gx
+((mWidth
-Length(mCaption
)*8) div 2);
1895 if mHasFrame
then fillRect(tx
-2, gy
, Length(mCaption
)*8+3, 8, TGxRGBA
.Create(0, 0, 128));
1896 drawText8(tx
, gy
, mCaption
, TGxRGBA
.Create(r
, g
, b
));
1901 function TUIBox
.mouseEvent (var ev
: THMouseEvent
): Boolean;
1905 result
:= inherited mouseEvent(ev
);
1906 if not result
and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
1913 //TODO: navigation with arrow keys, according to box orientation
1914 function TUIBox
.keyEvent (var ev
: THKeyEvent
): Boolean;
1916 result
:= inherited keyEvent(ev
);
1920 // ////////////////////////////////////////////////////////////////////////// //
1921 procedure TUIHBox
.AfterConstruction ();
1923 inherited AfterConstruction();
1928 // ////////////////////////////////////////////////////////////////////////// //
1929 procedure TUIVBox
.AfterConstruction ();
1931 inherited AfterConstruction();
1937 // ////////////////////////////////////////////////////////////////////////// //
1938 procedure TUISpan
.AfterConstruction ();
1940 inherited AfterConstruction();
1946 function TUISpan
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
1948 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
1949 result
:= inherited parseProperty(prname
, par
);
1953 procedure TUISpan
.drawControl (gx
, gy
: Integer);
1958 // ////////////////////////////////////////////////////////////////////// //
1959 function TUILine
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
1961 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
1962 result
:= inherited parseProperty(prname
, par
);
1966 procedure TUILine
.drawControl (gx
, gy
: Integer);
1970 drawHLine(gx
, gy
+(mHeight
div 2), mWidth
, TGxRGBA
.Create(255, 255, 255));
1974 drawVLine(gx
+(mWidth
div 2), gy
, mHeight
, TGxRGBA
.Create(255, 255, 255));
1979 // ////////////////////////////////////////////////////////////////////////// //
1980 procedure TUIHLine
.AfterConstruction ();
1988 // ////////////////////////////////////////////////////////////////////////// //
1989 procedure TUIVLine
.AfterConstruction ();
1998 // ////////////////////////////////////////////////////////////////////////// //
1999 constructor TUITextLabel
.Create (const atext
: AnsiString);
2003 mDefSize
:= TLaySize
.Create(Length(atext
)*8, 8);
2007 procedure TUITextLabel
.AfterConstruction ();
2009 inherited AfterConstruction();
2013 if (mDefSize
.h
<= 0) then mDefSize
.h
:= 8;
2017 function TUITextLabel
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2019 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) then
2021 mText
:= par
.expectStrOrId(true);
2022 mDefSize
:= TLaySize
.Create(Length(mText
)*8, 8);
2026 if (strEquCI1251(prname
, 'textalign')) then
2028 parseTextAlign(par
, mHAlign
, mVAlign
);
2032 result
:= inherited parseProperty(prname
, par
);
2036 procedure TUITextLabel
.drawControl (gx
, gy
: Integer);
2038 xpos
, ypos
: Integer;
2041 fillRect(gx
, gy
, mWidth
, mHeight
, TGxRGBA
.Create(96, 96, 0));
2042 drawRectUI(gx
, gy
, mWidth
, mHeight
, TGxRGBA
.Create(96, 96, 96));
2044 if (Length(mText
) > 0) then
2046 if (mHAlign
< 0) then xpos
:= 0
2047 else if (mHAlign
> 0) then xpos
:= mWidth
-Length(mText
)*8
2048 else xpos
:= (mWidth
-Length(mText
)*8) div 2;
2050 if (mVAlign
< 0) then ypos
:= 0
2051 else if (mVAlign
> 0) then ypos
:= mHeight
-8
2052 else ypos
:= (mHeight
-8) div 2;
2054 drawText8(gx
+xpos
, gy
+ypos
, mText
, TGxRGBA
.Create(255, 255, 255));
2059 function TUITextLabel
.mouseEvent (var ev
: THMouseEvent
): Boolean;
2063 result
:= inherited mouseEvent(ev
);
2064 if not result
and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
2071 function TUITextLabel
.keyEvent (var ev
: THKeyEvent
): Boolean;
2073 result
:= inherited keyEvent(ev
);
2078 registerCtlClass(TUIHBox
, 'hbox');
2079 registerCtlClass(TUIVBox
, 'vbox');
2080 registerCtlClass(TUISpan
, 'span');
2081 registerCtlClass(TUIHLine
, 'hline');
2082 registerCtlClass(TUIVLine
, 'vline');
2083 registerCtlClass(TUITextLabel
, 'label');