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}
32 // ////////////////////////////////////////////////////////////////////////// //
34 TUIControlClass
= class of TUIControl
;
38 type TActionCB
= procedure (me
: TUIControl
);
39 type TCloseRequestCB
= function (me
: TUIControl
): Boolean; // top-level windows will call this before closing with icon/keyboard
41 // return `true` to stop
42 type TCtlEnumCB
= function (ctl
: TUIControl
): Boolean is nested
;
45 const ClrIdxActive
= 0;
46 const ClrIdxDisabled
= 1;
47 const ClrIdxInactive
= 2;
55 mWidth
, mHeight
: Integer;
56 mFrameWidth
, mFrameHeight
: Integer;
57 mScrollX
, mScrollY
: Integer;
60 mChildren
: array of TUIControl
;
61 mFocused
: TUIControl
; // valid only for top-level controls
62 mEscClose
: Boolean; // valid only for top-level controls
67 mCtl4Style
: AnsiString;
68 mBackColor
: array[0..ClrIdxMax
] of TGxRGBA
;
69 mTextColor
: array[0..ClrIdxMax
] of TGxRGBA
;
70 mFrameColor
: array[0..ClrIdxMax
] of TGxRGBA
;
71 mFrameTextColor
: array[0..ClrIdxMax
] of TGxRGBA
;
72 mFrameIconColor
: array[0..ClrIdxMax
] of TGxRGBA
;
73 mDarken
: array[0..ClrIdxMax
] of Integer; // -1: none
80 procedure updateStyle (); virtual;
81 procedure cacheStyle (root
: TUIStyle
); virtual;
82 function getColorIndex (): Integer; inline;
85 function getEnabled (): Boolean;
86 procedure setEnabled (v
: Boolean); inline;
88 function getFocused (): Boolean; inline;
89 procedure setFocused (v
: Boolean); inline;
91 function getActive (): Boolean; inline;
93 function getCanFocus (): Boolean; inline;
95 function isMyChild (ctl
: TUIControl
): Boolean;
97 function findFirstFocus (): TUIControl
;
98 function findLastFocus (): TUIControl
;
100 function findNextFocus (cur
: TUIControl
; wrap
: Boolean): TUIControl
;
101 function findPrevFocus (cur
: TUIControl
; wrap
: Boolean): TUIControl
;
103 function findCancelControl (): TUIControl
;
104 function findDefaulControl (): TUIControl
;
106 function findControlById (const aid
: AnsiString): TUIControl
;
108 procedure activated (); virtual;
109 procedure blurred (); virtual;
111 procedure calcFullClientSize ();
113 //WARNING! do not call scissor functions outside `.draw*()` API!
114 // set scissor to this rect (in local coords)
115 procedure setScissor (lx
, ly
, lw
, lh
: Integer);
116 // reset scissor to whole control
117 procedure resetScissor (fullArea
: Boolean); inline; // "full area" means "with frame"
120 // set scissor to this rect (in global coords)
121 procedure setScissorGLInternal (x
, y
, w
, h
: Integer);
125 closeRequestCB
: TCloseRequestCB
;
128 mDefSize
: TLaySize
; // default size
129 mMaxSize
: TLaySize
; // maximum size
138 mLayDefSize
: TLaySize
;
139 mLayMaxSize
: TLaySize
;
143 // layouter interface
144 function getDefSize (): TLaySize
; inline; // default size; <0: use max size
145 //procedure setDefSize (const sz: TLaySize); inline; // default size; <0: use max size
146 function getMargins (): TLayMargins
; inline;
147 function getMaxSize (): TLaySize
; inline; // max size; <0: set to some huge value
148 //procedure setMaxSize (const sz: TLaySize); inline; // max size; <0: set to some huge value
149 function getFlex (): Integer; inline; // <=0: not flexible
150 function isHorizBox (): Boolean; inline; // horizontal layout for children?
151 procedure setHorizBox (v
: Boolean); inline; // horizontal layout for children?
152 function canWrap (): Boolean; inline; // for horizontal boxes: can wrap children? for child: `false` means 'nonbreakable at *next* ctl'
153 procedure setCanWrap (v
: Boolean); inline; // for horizontal boxes: can wrap children? for child: `false` means 'nonbreakable at *next* ctl'
154 function isLineStart (): Boolean; inline; // `true` if this ctl should start a new line; ignored for vertical boxes
155 procedure setLineStart (v
: Boolean); inline; // `true` if this ctl should start a new line; ignored for vertical boxes
156 function getAlign (): Integer; inline; // aligning in non-main direction: <0: left/up; 0: center; >0: right/down
157 procedure setAlign (v
: Integer); inline; // aligning in non-main direction: <0: left/up; 0: center; >0: right/down
158 function getExpand (): Boolean; inline; // expanding in non-main direction: `true` will ignore align and eat all available space
159 procedure setExpand (v
: Boolean); inline; // expanding in non-main direction: `true` will ignore align and eat all available space
160 function getHGroup (): AnsiString; inline; // empty: not grouped
161 procedure setHGroup (const v
: AnsiString); inline; // empty: not grouped
162 function getVGroup (): AnsiString; inline; // empty: not grouped
163 procedure setVGroup (const v
: AnsiString); inline; // empty: not grouped
165 procedure setActualSizePos (constref apos
: TLayPos
; constref asize
: TLaySize
); inline;
167 procedure layPrepare (); virtual; // called before registering control in layouter
170 property flex
: Integer read mFlex write mFlex
;
171 property flDefaultSize
: TLaySize read mDefSize write mDefSize
;
172 property flMaxSize
: TLaySize read mMaxSize write mMaxSize
;
173 property flHoriz
: Boolean read isHorizBox write setHorizBox
;
174 property flCanWrap
: Boolean read canWrap write setCanWrap
;
175 property flLineStart
: Boolean read isLineStart write setLineStart
;
176 property flAlign
: Integer read getAlign write setAlign
;
177 property flExpand
: Boolean read getExpand write setExpand
;
178 property flHGroup
: AnsiString read getHGroup write setHGroup
;
179 property flVGroup
: AnsiString read getVGroup write setVGroup
;
180 property fullSize
: TLaySize read mFullSize
;
183 function parsePos (par
: TTextParser
): TLayPos
;
184 function parseSize (par
: TTextParser
): TLaySize
;
185 function parseBool (par
: TTextParser
): Boolean;
186 function parseAnyAlign (par
: TTextParser
): Integer;
187 function parseHAlign (par
: TTextParser
): Integer;
188 function parseVAlign (par
: TTextParser
): Integer;
189 function parseOrientation (const prname
: AnsiString; par
: TTextParser
): Boolean;
190 procedure parseTextAlign (par
: TTextParser
; var h
, v
: Integer);
191 procedure parseChildren (par
: TTextParser
); // par should be on '{'; final '}' is eaten
194 // par is on property data
195 // there may be more data in text stream, don't eat it!
196 // return `true` if property name is valid and value was parsed
197 // return `false` if property name is invalid; don't advance parser in this case
198 // throw on property data errors
199 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; virtual;
201 // par should be on '{'; final '}' is eaten
202 procedure parseProperties (par
: TTextParser
);
205 constructor Create ();
206 destructor Destroy (); override;
208 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
210 // `sx` and `sy` are screen coordinates
211 procedure drawControl (gx
, gy
: Integer); virtual;
213 // called after all children drawn
214 procedure drawControlPost (gx
, gy
: Integer); virtual;
216 procedure draw (); virtual;
218 function topLevel (): TUIControl
; inline;
220 // returns `true` if global coords are inside this control
221 function toLocal (var x
, y
: Integer): Boolean;
222 function toLocal (gx
, gy
: Integer; out x
, y
: Integer): Boolean; inline;
223 procedure toGlobal (var x
, y
: Integer);
224 procedure toGlobal (lx
, ly
: Integer; out x
, y
: Integer); inline;
226 procedure getDrawRect (out gx
, gy
, wdt
, hgt
: Integer);
228 // x and y are global coords
229 function controlAtXY (x
, y
: Integer; allowDisabled
: Boolean=false): TUIControl
;
231 function parentScrollX (): Integer; inline;
232 function parentScrollY (): Integer; inline;
234 procedure makeVisibleInParent ();
236 procedure doAction (); virtual; // so user controls can override it
238 procedure mouseEvent (var ev
: THMouseEvent
); virtual; // returns `true` if event was eaten
239 procedure keyEvent (var ev
: THKeyEvent
); virtual; // returns `true` if event was eaten
240 procedure keyEventPre (var ev
: THKeyEvent
); virtual; // will be called before dispatching the event
241 procedure keyEventPost (var ev
: THKeyEvent
); virtual; // will be called after if nobody processed the event
243 function prevSibling (): TUIControl
;
244 function nextSibling (): TUIControl
;
245 function firstChild (): TUIControl
; inline;
246 function lastChild (): TUIControl
; inline;
248 procedure appendChild (ctl
: TUIControl
); virtual;
250 function setActionCBFor (const aid
: AnsiString; cb
: TActionCB
): TActionCB
; // returns previous cb
252 function forEachChildren (cb
: TCtlEnumCB
): TUIControl
; // doesn't recurse
253 function forEachControl (cb
: TCtlEnumCB
; includeSelf
: Boolean=true): TUIControl
;
255 procedure close (); // this closes *top-level* control
258 property id
: AnsiString read mId
;
259 property styleId
: AnsiString read mStyleId
;
260 property scrollX
: Integer read mScrollX write mScrollX
;
261 property scrollY
: Integer read mScrollY write mScrollY
;
262 property x0
: Integer read mX write mX
;
263 property y0
: Integer read mY write mY
;
264 property width
: Integer read mWidth write mWidth
;
265 property height
: Integer read mHeight write mHeight
;
266 property enabled
: Boolean read getEnabled write setEnabled
;
267 property parent
: TUIControl read mParent
;
268 property focused
: Boolean read getFocused write setFocused
;
269 property active
: Boolean read getActive
;
270 property escClose
: Boolean read mEscClose write mEscClose
;
271 property cancel
: Boolean read mCancel write mCancel
;
272 property defctl
: Boolean read mDefault write mDefault
;
273 property canFocus
: Boolean read getCanFocus write mCanFocus
;
274 property ctlById
[const aid
: AnsiString]: TUIControl read findControlById
; default
;
278 TUITopWindow
= class(TUIControl
)
280 type TXMode
= (None
, Drag
, Scroll
);
285 mDragStartX
, mDragStartY
: Integer;
286 mWaitingClose
: Boolean;
288 mFreeOnClose
: Boolean; // default: false
289 mDoCenter
: Boolean; // after layouting
292 procedure activated (); override;
293 procedure blurred (); override;
296 closeCB
: TActionCB
; // called after window was removed from ui window list
299 constructor Create (const atitle
: AnsiString);
301 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
303 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
305 procedure centerInScreen ();
307 // `sx` and `sy` are screen coordinates
308 procedure drawControl (gx
, gy
: Integer); override;
309 procedure drawControlPost (gx
, gy
: Integer); override;
311 procedure keyEvent (var ev
: THKeyEvent
); override; // returns `true` if event was eaten
312 procedure mouseEvent (var ev
: THMouseEvent
); override; // returns `true` if event was eaten
315 property freeOnClose
: Boolean read mFreeOnClose write mFreeOnClose
;
318 // ////////////////////////////////////////////////////////////////////// //
319 TUIBox
= class(TUIControl
)
322 mCaption
: AnsiString;
323 mHAlign
: Integer; // -1: left; 0: center; 1: right; default: left
326 procedure setCaption (const acap
: AnsiString);
327 procedure setHasFrame (v
: Boolean);
330 constructor Create (ahoriz
: Boolean);
332 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
334 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
336 procedure drawControl (gx
, gy
: Integer); override;
338 procedure mouseEvent (var ev
: THMouseEvent
); override;
339 procedure keyEvent (var ev
: THKeyEvent
); override;
342 property caption
: AnsiString read mCaption write setCaption
;
343 property hasFrame
: Boolean read mHasFrame write setHasFrame
;
344 property captionAlign
: Integer read mHAlign write mHAlign
;
347 TUIHBox
= class(TUIBox
)
349 constructor Create ();
351 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
354 TUIVBox
= class(TUIBox
)
356 constructor Create ();
358 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
361 // ////////////////////////////////////////////////////////////////////// //
362 TUISpan
= class(TUIControl
)
364 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
366 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
368 procedure drawControl (gx
, gy
: Integer); override;
371 // ////////////////////////////////////////////////////////////////////// //
372 TUILine
= class(TUIControl
)
374 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
376 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
378 procedure drawControl (gx
, gy
: Integer); override;
381 TUIHLine
= class(TUILine
)
383 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
386 TUIVLine
= class(TUILine
)
388 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
391 // ////////////////////////////////////////////////////////////////////// //
392 TUIStaticText
= class(TUIControl
)
395 mHAlign
: Integer; // -1: left; 0: center; 1: right; default: left
396 mVAlign
: Integer; // -1: top; 0: center; 1: bottom; default: center
397 mHeader
: Boolean; // true: draw with frame text color
398 mLine
: Boolean; // true: draw horizontal line
401 procedure setText (const atext
: AnsiString);
404 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
406 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
408 procedure drawControl (gx
, gy
: Integer); override;
411 property text: AnsiString read mText write setText
;
412 property halign
: Integer read mHAlign write mHAlign
;
413 property valign
: Integer read mVAlign write mVAlign
;
414 property header
: Boolean read mHeader write mHeader
;
415 property line
: Boolean read mLine write mLine
;
418 // ////////////////////////////////////////////////////////////////////// //
419 TUITextLabel
= class(TUIControl
)
422 mHAlign
: Integer; // -1: left; 0: center; 1: right; default: left
423 mVAlign
: Integer; // -1: top; 0: center; 1: bottom; default: center
425 mHotOfs
: Integer; // from text start, in pixels
426 mHotColor
: array[0..ClrIdxMax
] of TGxRGBA
;
427 mLinkId
: AnsiString; // linked control
430 procedure cacheStyle (root
: TUIStyle
); override;
432 procedure setText (const s
: AnsiString); virtual;
435 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
437 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
439 procedure drawControl (gx
, gy
: Integer); override;
441 procedure mouseEvent (var ev
: THMouseEvent
); override;
442 procedure keyEventPost (var ev
: THKeyEvent
); override;
445 property text: AnsiString read mText write setText
;
446 property halign
: Integer read mHAlign write mHAlign
;
447 property valign
: Integer read mVAlign write mVAlign
;
450 // ////////////////////////////////////////////////////////////////////// //
451 TUIButton
= class(TUITextLabel
)
453 procedure setText (const s
: AnsiString); override;
456 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
458 procedure drawControl (gx
, gy
: Integer); override;
460 procedure mouseEvent (var ev
: THMouseEvent
); override;
461 procedure keyEvent (var ev
: THKeyEvent
); override;
462 procedure keyEventPost (var ev
: THKeyEvent
); override;
465 // ////////////////////////////////////////////////////////////////////// //
466 TUISwitchBox
= class(TUITextLabel
)
470 mCheckedStr
: AnsiString;
471 mUncheckedStr
: AnsiString;
472 mSwitchColor
: array[0..ClrIdxMax
] of TGxRGBA
;
475 procedure cacheStyle (root
: TUIStyle
); override;
477 procedure setText (const s
: AnsiString); override;
479 function getChecked (): Boolean; virtual;
480 procedure setChecked (v
: Boolean); virtual; abstract;
483 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
485 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
487 procedure drawControl (gx
, gy
: Integer); override;
489 procedure mouseEvent (var ev
: THMouseEvent
); override;
490 procedure keyEvent (var ev
: THKeyEvent
); override;
491 procedure keyEventPost (var ev
: THKeyEvent
); override;
493 procedure setVar (pvar
: PBoolean);
496 property checked
: Boolean read getChecked write setChecked
;
499 TUICheckBox
= class(TUISwitchBox
)
501 procedure setChecked (v
: Boolean); override;
504 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
506 procedure doAction (); override;
509 TUIRadioBox
= class(TUISwitchBox
)
511 mRadioGroup
: AnsiString;
514 procedure setChecked (v
: Boolean); override;
517 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
519 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
521 procedure doAction (); override;
524 property radioGroup
: AnsiString read mRadioGroup write mRadioGroup
; //FIXME
528 // ////////////////////////////////////////////////////////////////////////// //
529 procedure uiMouseEvent (var evt
: THMouseEvent
);
530 procedure uiKeyEvent (var evt
: THKeyEvent
);
534 // ////////////////////////////////////////////////////////////////////////// //
535 procedure uiAddWindow (ctl
: TUIControl
);
536 procedure uiRemoveWindow (ctl
: TUIControl
); // will free window if `mFreeOnClose` is `true`
537 function uiVisibleWindow (ctl
: TUIControl
): Boolean;
539 procedure uiUpdateStyles ();
542 // ////////////////////////////////////////////////////////////////////////// //
544 procedure uiLayoutCtl (ctl
: TUIControl
);
547 // ////////////////////////////////////////////////////////////////////////// //
549 gh_ui_scale
: Single = 1.0;
559 // ////////////////////////////////////////////////////////////////////////// //
561 ctlsToKill
: array of TUIControl
= nil;
564 procedure scheduleKill (ctl
: TUIControl
);
568 if (ctl
= nil) then exit
;
570 for f
:= 0 to High(ctlsToKill
) do
572 if (ctlsToKill
[f
] = ctl
) then exit
;
573 if (ctlsToKill
[f
] = nil) then begin ctlsToKill
[f
] := ctl
; exit
; end;
575 SetLength(ctlsToKill
, Length(ctlsToKill
)+1);
576 ctlsToKill
[High(ctlsToKill
)] := ctl
;
580 procedure processKills ();
585 for f
:= 0 to High(ctlsToKill
) do
587 ctl
:= ctlsToKill
[f
];
588 if (ctl
= nil) then break
;
589 ctlsToKill
[f
] := nil;
592 if (Length(ctlsToKill
) > 0) then ctlsToKill
[0] := nil; // just in case
596 // ////////////////////////////////////////////////////////////////////////// //
598 knownCtlClasses
: array of record
599 klass
: TUIControlClass
;
604 procedure registerCtlClass (aklass
: TUIControlClass
; const aname
: AnsiString);
606 assert(aklass
<> nil);
607 assert(Length(aname
) > 0);
608 SetLength(knownCtlClasses
, Length(knownCtlClasses
)+1);
609 knownCtlClasses
[High(knownCtlClasses
)].klass
:= aklass
;
610 knownCtlClasses
[High(knownCtlClasses
)].name
:= aname
;
614 function findCtlClass (const aname
: AnsiString): TUIControlClass
;
618 for f
:= 0 to High(knownCtlClasses
) do
620 if (strEquCI1251(aname
, knownCtlClasses
[f
].name
)) then
622 result
:= knownCtlClasses
[f
].klass
;
630 // ////////////////////////////////////////////////////////////////////////// //
632 TFlexLayouter
= specialize TFlexLayouterBase
<TUIControl
>;
634 procedure uiLayoutCtl (ctl
: TUIControl
);
638 if (ctl
= nil) then exit
;
639 lay
:= TFlexLayouter
.Create();
644 //writeln('============================'); lay.dumpFlat();
646 //writeln('=== initial ==='); lay.dump();
648 //lay.calcMaxSizeInternal(0);
651 writeln('=== after first pass ===');
655 writeln('=== after second pass ===');
660 //writeln('=== final ==='); lay.dump();
662 if (ctl
.mParent
= nil) and (ctl
is TUITopWindow
) and (TUITopWindow(ctl
).mDoCenter
) then
664 TUITopWindow(ctl
).centerInScreen();
667 // calculate full size
668 ctl
.calcFullClientSize();
671 if (ctl
.mParent
= nil) then
673 if (ctl
.mFocused
= nil) or (ctl
.mFocused
= ctl
) or (not ctl
.mFocused
.enabled
) then
675 ctl
.mFocused
:= ctl
.findFirstFocus();
685 // ////////////////////////////////////////////////////////////////////////// //
687 uiTopList
: array of TUIControl
= nil;
688 uiGrabCtl
: TUIControl
= nil;
691 procedure uiUpdateStyles ();
695 for ctl
in uiTopList
do ctl
.updateStyle();
699 procedure uiMouseEvent (var evt
: THMouseEvent
);
707 if (evt
.eaten
) or (evt
.cancelled
) then exit
;
709 ev
.x
:= trunc(ev
.x
/gh_ui_scale
);
710 ev
.y
:= trunc(ev
.y
/gh_ui_scale
);
711 ev
.dx
:= trunc(ev
.dx
/gh_ui_scale
); //FIXME
712 ev
.dy
:= trunc(ev
.dy
/gh_ui_scale
); //FIXME
714 if (uiGrabCtl
<> nil) then
716 uiGrabCtl
.mouseEvent(ev
);
717 if (ev
.release
) and ((ev
.bstate
and (not ev
.but
)) = 0) then uiGrabCtl
:= nil;
721 if (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)].enabled
) then uiTopList
[High(uiTopList
)].mouseEvent(ev
);
722 if (not ev
.eaten
) and (not ev
.cancelled
) and (ev
.press
) then
724 for f
:= High(uiTopList
) downto 0 do
726 if uiTopList
[f
].toLocal(ev
.x
, ev
.y
, lx
, ly
) then
728 if (uiTopList
[f
].enabled
) and (f
<> High(uiTopList
)) then
730 uiTopList
[High(uiTopList
)].blurred();
731 ctmp
:= uiTopList
[f
];
733 for c
:= f
+1 to High(uiTopList
) do uiTopList
[c
-1] := uiTopList
[c
];
734 uiTopList
[High(uiTopList
)] := ctmp
;
744 if (ev
.eaten
) then evt
.eat();
745 if (ev
.cancelled
) then evt
.cancel();
750 procedure uiKeyEvent (var evt
: THKeyEvent
);
755 if (evt
.eaten
) or (evt
.cancelled
) then exit
;
757 ev
.x
:= trunc(ev
.x
/gh_ui_scale
);
758 ev
.y
:= trunc(ev
.y
/gh_ui_scale
);
760 if (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)].enabled
) then uiTopList
[High(uiTopList
)].keyEvent(ev
);
761 //if (ev.release) then begin ev.eat(); exit; end;
763 if (ev
.eaten
) then evt
.eat();
764 if (ev
.cancelled
) then evt
.cancel();
775 gxBeginUIDraw(gh_ui_scale
);
777 for f
:= 0 to High(uiTopList
) do
781 if (f
<> High(uiTopList
)) then
783 cidx
:= ctl
.getColorIndex
;
784 if (ctl
.mDarken
[cidx
] > 0) then darkenRect(ctl
.x0
, ctl
.y0
, ctl
.width
, ctl
.height
, ctl
.mDarken
[cidx
]);
793 procedure uiAddWindow (ctl
: TUIControl
);
797 if (ctl
= nil) then exit
;
799 if not (ctl
is TUITopWindow
) then exit
; // alas
800 for f
:= 0 to High(uiTopList
) do
802 if (uiTopList
[f
] = ctl
) then
804 if (f
<> High(uiTopList
)) then
806 uiTopList
[High(uiTopList
)].blurred();
807 for c
:= f
+1 to High(uiTopList
) do uiTopList
[c
-1] := uiTopList
[c
];
808 uiTopList
[High(uiTopList
)] := ctl
;
814 if (Length(uiTopList
) > 0) then uiTopList
[High(uiTopList
)].blurred();
815 SetLength(uiTopList
, Length(uiTopList
)+1);
816 uiTopList
[High(uiTopList
)] := ctl
;
822 procedure uiRemoveWindow (ctl
: TUIControl
);
826 if (ctl
= nil) then exit
;
828 if not (ctl
is TUITopWindow
) then exit
; // alas
829 for f
:= 0 to High(uiTopList
) do
831 if (uiTopList
[f
] = ctl
) then
834 for c
:= f
+1 to High(uiTopList
) do uiTopList
[c
-1] := uiTopList
[c
];
835 SetLength(uiTopList
, Length(uiTopList
)-1);
836 if (ctl
is TUITopWindow
) then
839 if assigned(TUITopWindow(ctl
).closeCB
) then TUITopWindow(ctl
).closeCB(ctl
);
841 if (TUITopWindow(ctl
).mFreeOnClose
) then scheduleKill(ctl
);
850 function uiVisibleWindow (ctl
: TUIControl
): Boolean;
855 if (ctl
= nil) then exit
;
857 if not (ctl
is TUITopWindow
) then exit
; // alas
858 for f
:= 0 to High(uiTopList
) do
860 if (uiTopList
[f
] = ctl
) then begin result
:= true; exit
; end;
865 // ////////////////////////////////////////////////////////////////////////// //
866 constructor TUIControl
.Create ();
871 procedure TUIControl
.AfterConstruction ();
888 mDrawShadow
:= false;
890 // layouter interface
891 //mDefSize := TLaySize.Create(64, 8); // default size
892 mDefSize
:= TLaySize
.Create(0, 0); // default size
893 mMaxSize
:= TLaySize
.Create(-1, -1); // maximum size
902 mAlign
:= -1; // left/top
907 destructor TUIControl
.Destroy ();
911 if (mParent
<> nil) then
914 for f
:= 0 to High(mParent
.mChildren
) do
916 if (mParent
.mChildren
[f
] = self
) then
918 for c
:= f
+1 to High(mParent
.mChildren
) do mParent
.mChildren
[c
-1] := mParent
.mChildren
[c
];
919 SetLength(mParent
.mChildren
, Length(mParent
.mChildren
)-1);
923 for f
:= 0 to High(mChildren
) do
925 mChildren
[f
].mParent
:= nil;
932 function TUIControl
.getColorIndex (): Integer; inline;
934 if (not enabled
) then begin result
:= ClrIdxDisabled
; exit
; end;
935 // top windows: no focus hack
936 if (self
is TUITopWindow
) then
938 if (getActive
) then begin result
:= ClrIdxActive
; exit
; end;
942 // if control cannot be focused, take "active" color scheme for it (it is easier this way)
943 if (not canFocus
) or (getActive
) then begin result
:= ClrIdxActive
; exit
; end;
945 result
:= ClrIdxInactive
;
948 procedure TUIControl
.updateStyle ();
954 while (ctl
<> nil) do
956 if (Length(ctl
.mStyleId
) <> 0) then begin stl
:= uiFindStyle(ctl
.mStyleId
); break
; end;
959 if (stl
= nil) then stl
:= uiFindStyle(''); // default
961 for ctl
in mChildren
do ctl
.updateStyle();
964 procedure TUIControl
.cacheStyle (root
: TUIStyle
);
968 //writeln('caching style for <', className, '> (', mCtl4Style, ')...');
971 mBackColor
[ClrIdxActive
] := root
.get('back-color', 'active', cst
).asRGBADef(TGxRGBA
.Create(0, 0, 128));
972 mTextColor
[ClrIdxActive
] := root
.get('text-color', 'active', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
973 mFrameColor
[ClrIdxActive
] := root
.get('frame-color', 'active', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
974 mFrameTextColor
[ClrIdxActive
] := root
.get('frame-text-color', 'active', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
975 mFrameIconColor
[ClrIdxActive
] := root
.get('frame-icon-color', 'active', cst
).asRGBADef(TGxRGBA
.Create(0, 255, 0));
976 mDarken
[ClrIdxActive
] := root
.get('darken', 'active', cst
).asInt(-1);
978 mBackColor
[ClrIdxDisabled
] := root
.get('back-color', 'disabled', cst
).asRGBADef(TGxRGBA
.Create(0, 0, 128));
979 mTextColor
[ClrIdxDisabled
] := root
.get('text-color', 'disabled', cst
).asRGBADef(TGxRGBA
.Create(127, 127, 127));
980 mFrameColor
[ClrIdxDisabled
] := root
.get('frame-color', 'disabled', cst
).asRGBADef(TGxRGBA
.Create(127, 127, 127));
981 mFrameTextColor
[ClrIdxDisabled
] := root
.get('frame-text-color', 'disabled', cst
).asRGBADef(TGxRGBA
.Create(127, 127, 127));
982 mFrameIconColor
[ClrIdxDisabled
] := root
.get('frame-icon-color', 'disabled', cst
).asRGBADef(TGxRGBA
.Create(0, 127, 0));
983 mDarken
[ClrIdxDisabled
] := root
.get('darken', 'disabled', cst
).asInt(-1);
985 mBackColor
[ClrIdxInactive
] := root
.get('back-color', 'inactive', cst
).asRGBADef(TGxRGBA
.Create(0, 0, 128));
986 mTextColor
[ClrIdxInactive
] := root
.get('text-color', 'inactive', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
987 mFrameColor
[ClrIdxInactive
] := root
.get('frame-color', 'inactive', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
988 mFrameTextColor
[ClrIdxInactive
] := root
.get('frame-text-color', 'inactive', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
989 mFrameIconColor
[ClrIdxInactive
] := root
.get('frame-icon-color', 'inactive', cst
).asRGBADef(TGxRGBA
.Create(0, 255, 0));
990 mDarken
[ClrIdxInactive
] := root
.get('darken', 'inactive', cst
).asInt(-1);
994 // ////////////////////////////////////////////////////////////////////////// //
995 function TUIControl
.getDefSize (): TLaySize
; inline; begin result
:= mLayDefSize
; end;
996 function TUIControl
.getMaxSize (): TLaySize
; inline; begin result
:= mLayMaxSize
; end;
997 function TUIControl
.getFlex (): Integer; inline; begin result
:= mFlex
; end;
998 function TUIControl
.isHorizBox (): Boolean; inline; begin result
:= mHoriz
; end;
999 procedure TUIControl
.setHorizBox (v
: Boolean); inline; begin mHoriz
:= v
; end;
1000 function TUIControl
.canWrap (): Boolean; inline; begin result
:= mCanWrap
; end;
1001 procedure TUIControl
.setCanWrap (v
: Boolean); inline; begin mCanWrap
:= v
; end;
1002 function TUIControl
.isLineStart (): Boolean; inline; begin result
:= mLineStart
; end;
1003 procedure TUIControl
.setLineStart (v
: Boolean); inline; begin mLineStart
:= v
; end;
1004 function TUIControl
.getAlign (): Integer; inline; begin result
:= mAlign
; end;
1005 procedure TUIControl
.setAlign (v
: Integer); inline; begin mAlign
:= v
; end;
1006 function TUIControl
.getExpand (): Boolean; inline; begin result
:= mExpand
; end;
1007 procedure TUIControl
.setExpand (v
: Boolean); inline; begin mExpand
:= v
; end;
1008 function TUIControl
.getHGroup (): AnsiString; inline; begin result
:= mHGroup
; end;
1009 procedure TUIControl
.setHGroup (const v
: AnsiString); inline; begin mHGroup
:= v
; end;
1010 function TUIControl
.getVGroup (): AnsiString; inline; begin result
:= mVGroup
; end;
1011 procedure TUIControl
.setVGroup (const v
: AnsiString); inline; begin mVGroup
:= v
; end;
1013 function TUIControl
.getMargins (): TLayMargins
; inline;
1015 result
:= TLayMargins
.Create(mFrameHeight
, mFrameWidth
, mFrameHeight
, mFrameWidth
);
1018 procedure TUIControl
.setActualSizePos (constref apos
: TLayPos
; constref asize
: TLaySize
); inline;
1020 //writeln(self.className, '; pos=', apos.toString, '; size=', asize.toString);
1021 if (mParent
<> nil) then
1030 procedure TUIControl
.layPrepare ();
1032 mLayDefSize
:= mDefSize
;
1033 mLayMaxSize
:= mMaxSize
;
1034 if (mLayMaxSize
.w
>= 0) then mLayMaxSize
.w
+= mFrameWidth
*2;
1035 if (mLayMaxSize
.h
>= 0) then mLayMaxSize
.h
+= mFrameHeight
*2;
1039 // ////////////////////////////////////////////////////////////////////////// //
1040 function TUIControl
.parsePos (par
: TTextParser
): TLayPos
;
1042 ech
: AnsiChar = ')';
1044 if (par
.eatDelim('[')) then ech
:= ']' else par
.expectDelim('(');
1045 result
.x
:= par
.expectInt();
1046 par
.eatDelim(','); // optional comma
1047 result
.y
:= par
.expectInt();
1048 par
.eatDelim(','); // optional comma
1049 par
.expectDelim(ech
);
1052 function TUIControl
.parseSize (par
: TTextParser
): TLaySize
;
1054 ech
: AnsiChar = ')';
1056 if (par
.eatDelim('[')) then ech
:= ']' else par
.expectDelim('(');
1057 result
.w
:= par
.expectInt();
1058 par
.eatDelim(','); // optional comma
1059 result
.h
:= par
.expectInt();
1060 par
.eatDelim(','); // optional comma
1061 par
.expectDelim(ech
);
1064 function TUIControl
.parseBool (par
: TTextParser
): Boolean;
1067 par
.eatIdOrStrCI('true') or
1068 par
.eatIdOrStrCI('yes') or
1069 par
.eatIdOrStrCI('tan');
1072 if (not par
.eatIdOrStrCI('false')) and (not par
.eatIdOrStrCI('no')) and (not par
.eatIdOrStrCI('ona')) then
1074 par
.error('boolean value expected');
1079 function TUIControl
.parseAnyAlign (par
: TTextParser
): Integer;
1081 if (par
.eatIdOrStrCI('left')) or (par
.eatIdOrStrCI('top')) then result
:= -1
1082 else if (par
.eatIdOrStrCI('right')) or (par
.eatIdOrStrCI('bottom')) then result
:= 1
1083 else if (par
.eatIdOrStrCI('center')) then result
:= 0
1084 else par
.error('invalid align value');
1087 function TUIControl
.parseHAlign (par
: TTextParser
): Integer;
1089 if (par
.eatIdOrStrCI('left')) then result
:= -1
1090 else if (par
.eatIdOrStrCI('right')) then result
:= 1
1091 else if (par
.eatIdOrStrCI('center')) then result
:= 0
1092 else par
.error('invalid horizontal align value');
1095 function TUIControl
.parseVAlign (par
: TTextParser
): Integer;
1097 if (par
.eatIdOrStrCI('top')) then result
:= -1
1098 else if (par
.eatIdOrStrCI('bottom')) then result
:= 1
1099 else if (par
.eatIdOrStrCI('center')) then result
:= 0
1100 else par
.error('invalid vertical align value');
1103 procedure TUIControl
.parseTextAlign (par
: TTextParser
; var h
, v
: Integer);
1105 wasH
: Boolean = false;
1106 wasV
: Boolean = false;
1110 if (par
.eatIdOrStrCI('left')) then
1112 if wasH
then par
.error('too many align directives');
1117 if (par
.eatIdOrStrCI('right')) then
1119 if wasH
then par
.error('too many align directives');
1124 if (par
.eatIdOrStrCI('hcenter')) then
1126 if wasH
then par
.error('too many align directives');
1131 if (par
.eatIdOrStrCI('top')) then
1133 if wasV
then par
.error('too many align directives');
1138 if (par
.eatIdOrStrCI('bottom')) then
1140 if wasV
then par
.error('too many align directives');
1145 if (par
.eatIdOrStrCI('vcenter')) then
1147 if wasV
then par
.error('too many align directives');
1152 if (par
.eatIdOrStrCI('center')) then
1154 if wasV
or wasH
then par
.error('too many align directives');
1163 if not wasV
and not wasH
then par
.error('invalid align value');
1166 function TUIControl
.parseOrientation (const prname
: AnsiString; par
: TTextParser
): Boolean;
1168 if (strEquCI1251(prname
, 'orientation')) or (strEquCI1251(prname
, 'orient')) then
1170 if (par
.eatIdOrStrCI('horizontal')) or (par
.eatIdOrStrCI('horiz')) then mHoriz
:= true
1171 else if (par
.eatIdOrStrCI('vertical')) or (par
.eatIdOrStrCI('vert')) then mHoriz
:= false
1172 else par
.error('`horizontal` or `vertical` expected');
1181 // par should be on '{'; final '}' is eaten
1182 procedure TUIControl
.parseProperties (par
: TTextParser
);
1186 if (not par
.eatDelim('{')) then exit
;
1187 while (not par
.eatDelim('}')) do
1189 if (not par
.isIdOrStr
) then par
.error('property name expected');
1192 par
.eatDelim(':'); // optional
1193 if not parseProperty(pn
, par
) then par
.errorfmt('invalid property name ''%s''', [pn
]);
1194 par
.eatDelim(','); // optional
1198 // par should be on '{'
1199 procedure TUIControl
.parseChildren (par
: TTextParser
);
1201 cc
: TUIControlClass
;
1204 par
.expectDelim('{');
1205 while (not par
.eatDelim('}')) do
1207 if (not par
.isIdOrStr
) then par
.error('control name expected');
1208 cc
:= findCtlClass(par
.tokStr
);
1209 if (cc
= nil) then par
.errorfmt('unknown control name: ''%s''', [par
.tokStr
]);
1210 //writeln('children for <', par.tokStr, '>: <', cc.className, '>');
1212 par
.eatDelim(':'); // optional
1214 //writeln(' mHoriz=', ctl.mHoriz);
1216 ctl
.parseProperties(par
);
1221 //writeln(': ', ctl.mDefSize.toString);
1223 par
.eatDelim(','); // optional
1228 function TUIControl
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
1231 if (strEquCI1251(prname
, 'id')) then begin mId
:= par
.expectIdOrStr(true); exit
; end; // allow empty strings
1232 if (strEquCI1251(prname
, 'style')) then begin mStyleId
:= par
.expectIdOrStr(); exit
; end; // no empty strings
1233 if (strEquCI1251(prname
, 'flex')) then begin flex
:= par
.expectInt(); exit
; end;
1235 if (strEquCI1251(prname
, 'defsize')) or (strEquCI1251(prname
, 'size')) then begin mDefSize
:= parseSize(par
); exit
; end;
1236 if (strEquCI1251(prname
, 'maxsize')) then begin mMaxSize
:= parseSize(par
); exit
; end;
1237 if (strEquCI1251(prname
, 'defwidth')) or (strEquCI1251(prname
, 'width')) then begin mDefSize
.w
:= par
.expectInt(); exit
; end;
1238 if (strEquCI1251(prname
, 'defheight')) or (strEquCI1251(prname
, 'height')) then begin mDefSize
.h
:= par
.expectInt(); exit
; end;
1239 if (strEquCI1251(prname
, 'maxwidth')) then begin mMaxSize
.w
:= par
.expectInt(); exit
; end;
1240 if (strEquCI1251(prname
, 'maxheight')) then begin mMaxSize
.h
:= par
.expectInt(); exit
; end;
1242 if (strEquCI1251(prname
, 'wrap')) then begin mCanWrap
:= parseBool(par
); exit
; end;
1243 if (strEquCI1251(prname
, 'linestart')) then begin mLineStart
:= parseBool(par
); exit
; end;
1244 if (strEquCI1251(prname
, 'expand')) then begin mExpand
:= parseBool(par
); exit
; end;
1246 if (strEquCI1251(prname
, 'align')) then begin mAlign
:= parseAnyAlign(par
); exit
; end;
1247 if (strEquCI1251(prname
, 'hgroup')) then begin mHGroup
:= par
.expectIdOrStr(true); exit
; end; // allow empty strings
1248 if (strEquCI1251(prname
, 'vgroup')) then begin mVGroup
:= par
.expectIdOrStr(true); exit
; end; // allow empty strings
1250 if (strEquCI1251(prname
, 'canfocus')) then begin mCanFocus
:= true; exit
; end;
1251 if (strEquCI1251(prname
, 'nofocus')) then begin mCanFocus
:= false; exit
; end;
1252 if (strEquCI1251(prname
, 'disabled')) then begin mEnabled
:= false; exit
; end;
1253 if (strEquCI1251(prname
, 'enabled')) then begin mEnabled
:= true; exit
; end;
1254 if (strEquCI1251(prname
, 'escclose')) then begin mEscClose
:= not parseBool(par
); exit
; end;
1255 if (strEquCI1251(prname
, 'default')) then begin mDefault
:= true; exit
; end;
1256 if (strEquCI1251(prname
, 'cancel')) then begin mCancel
:= true; exit
; end;
1261 // ////////////////////////////////////////////////////////////////////////// //
1262 procedure TUIControl
.activated ();
1264 makeVisibleInParent();
1268 procedure TUIControl
.blurred ();
1270 if (uiGrabCtl
= self
) then uiGrabCtl
:= nil;
1274 procedure TUIControl
.calcFullClientSize ();
1278 mFullSize
:= TLaySize
.Create(0, 0);
1279 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1280 for ctl
in mChildren
do
1282 ctl
.calcFullClientSize();
1283 mFullSize
.w
:= nmax(mFullSize
.w
, ctl
.mX
-mFrameWidth
+ctl
.mFullSize
.w
);
1284 mFullSize
.h
:= nmax(mFullSize
.h
, ctl
.mY
-mFrameHeight
+ctl
.mFullSize
.h
);
1286 mFullSize
.w
:= nmax(mFullSize
.w
, mWidth
-mFrameWidth
*2);
1287 mFullSize
.h
:= nmax(mFullSize
.h
, mHeight
-mFrameHeight
*2);
1291 function TUIControl
.topLevel (): TUIControl
; inline;
1294 while (result
.mParent
<> nil) do result
:= result
.mParent
;
1298 function TUIControl
.getEnabled (): Boolean;
1303 if (not mEnabled
) then exit
;
1305 while (ctl
<> nil) do
1307 if (not ctl
.mEnabled
) then exit
;
1314 procedure TUIControl
.setEnabled (v
: Boolean); inline;
1316 if (mEnabled
= v
) then exit
;
1318 if (not v
) and focused
then setFocused(false);
1322 function TUIControl
.getFocused (): Boolean; inline;
1324 if (mParent
= nil) then
1326 result
:= (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)] = self
);
1330 result
:= (topLevel
.mFocused
= self
);
1331 if (result
) then result
:= (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)] = topLevel
);
1336 function TUIControl
.getActive (): Boolean; inline;
1340 if (mParent
= nil) then
1342 result
:= (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)] = self
);
1346 ctl
:= topLevel
.mFocused
;
1347 while (ctl
<> nil) and (ctl
<> self
) do ctl
:= ctl
.mParent
;
1348 result
:= (ctl
= self
);
1349 if (result
) then result
:= (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)] = topLevel
);
1354 procedure TUIControl
.setFocused (v
: Boolean); inline;
1361 if (tl
.mFocused
= self
) then
1363 blurred(); // this will reset grab, but still...
1364 if (uiGrabCtl
= self
) then uiGrabCtl
:= nil;
1365 tl
.mFocused
:= tl
.findNextFocus(self
, true);
1366 if (tl
.mFocused
= self
) then tl
.mFocused
:= nil;
1367 if (tl
.mFocused
<> nil) then tl
.mFocused
.activated();
1371 if (not canFocus
) then exit
;
1372 if (tl
.mFocused
<> self
) then
1374 if (tl
.mFocused
<> nil) then tl
.mFocused
.blurred();
1375 tl
.mFocused
:= self
;
1376 if (uiGrabCtl
<> self
) then uiGrabCtl
:= nil;
1382 function TUIControl
.getCanFocus (): Boolean; inline;
1384 result
:= (getEnabled
) and (mCanFocus
) and (mWidth
> 0) and (mHeight
> 0);
1388 function TUIControl
.isMyChild (ctl
: TUIControl
): Boolean;
1391 while (ctl
<> nil) do
1393 if (ctl
.mParent
= self
) then exit
;
1400 // returns `true` if global coords are inside this control
1401 function TUIControl
.toLocal (var x
, y
: Integer): Boolean;
1403 if (mParent
= nil) then
1407 result
:= true; // hack
1411 result
:= mParent
.toLocal(x
, y
);
1412 Inc(x
, mParent
.mScrollX
);
1413 Inc(y
, mParent
.mScrollY
);
1416 if result
then result
:= (x
>= 0) and (y
>= 0) and (x
< mParent
.mWidth
) and (y
< mParent
.mHeight
);
1418 if result
then result
:= (x
>= 0) and (y
>= 0) and (x
< mWidth
) and (y
< mHeight
);
1421 function TUIControl
.toLocal (gx
, gy
: Integer; out x
, y
: Integer): Boolean; inline;
1425 result
:= toLocal(x
, y
);
1429 procedure TUIControl
.toGlobal (var x
, y
: Integer);
1433 if (mParent
<> nil) then
1435 Dec(x
, mParent
.mScrollX
);
1436 Dec(y
, mParent
.mScrollY
);
1437 mParent
.toGlobal(x
, y
);
1441 procedure TUIControl
.toGlobal (lx
, ly
: Integer; out x
, y
: Integer); inline;
1448 procedure TUIControl
.getDrawRect (out gx
, gy
, wdt
, hgt
: Integer);
1452 if (mParent
= nil) then
1461 toGlobal(0, 0, cgx
, cgy
);
1462 mParent
.getDrawRect(gx
, gy
, wdt
, hgt
);
1463 if (wdt
> 0) and (hgt
> 0) then
1465 if not intersectRect(gx
, gy
, wdt
, hgt
, cgx
, cgy
, mWidth
, mHeight
) then
1475 // x and y are global coords
1476 function TUIControl
.controlAtXY (x
, y
: Integer; allowDisabled
: Boolean=false): TUIControl
;
1482 if (not allowDisabled
) and (not enabled
) then exit
;
1483 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1484 if not toLocal(x
, y
, lx
, ly
) then exit
;
1485 for f
:= High(mChildren
) downto 0 do
1487 result
:= mChildren
[f
].controlAtXY(x
, y
, allowDisabled
);
1488 if (result
<> nil) then exit
;
1494 function TUIControl
.parentScrollX (): Integer; inline; begin if (mParent
<> nil) then result
:= mParent
.mScrollX
else result
:= 0; end;
1495 function TUIControl
.parentScrollY (): Integer; inline; begin if (mParent
<> nil) then result
:= mParent
.mScrollY
else result
:= 0; end;
1498 procedure TUIControl
.makeVisibleInParent ();
1500 sy
, ey
, cy
: Integer;
1503 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1505 if (p
= nil) then exit
;
1506 if (p
.mFullSize
.w
< 1) or (p
.mFullSize
.h
< 1) then
1512 p
.makeVisibleInParent();
1513 cy
:= mY
-p
.mFrameHeight
;
1515 ey
:= sy
+(p
.mHeight
-p
.mFrameHeight
*2);
1518 p
.mScrollY
:= nmax(0, cy
);
1520 else if (cy
+mHeight
> ey
) then
1522 p
.mScrollY
:= nmax(0, cy
+mHeight
-(p
.mHeight
-p
.mFrameHeight
*2));
1527 // ////////////////////////////////////////////////////////////////////////// //
1528 function TUIControl
.prevSibling (): TUIControl
;
1532 if (mParent
<> nil) then
1534 for f
:= 1 to High(mParent
.mChildren
) do
1536 if (mParent
.mChildren
[f
] = self
) then begin result
:= mParent
.mChildren
[f
-1]; exit
; end;
1542 function TUIControl
.nextSibling (): TUIControl
;
1546 if (mParent
<> nil) then
1548 for f
:= 0 to High(mParent
.mChildren
)-1 do
1550 if (mParent
.mChildren
[f
] = self
) then begin result
:= mParent
.mChildren
[f
+1]; exit
; end;
1556 function TUIControl
.firstChild (): TUIControl
; inline;
1558 if (Length(mChildren
) <> 0) then result
:= mChildren
[0] else result
:= nil;
1561 function TUIControl
.lastChild (): TUIControl
; inline;
1563 if (Length(mChildren
) <> 0) then result
:= mChildren
[High(mChildren
)] else result
:= nil;
1567 function TUIControl
.findFirstFocus (): TUIControl
;
1574 for f
:= 0 to High(mChildren
) do
1576 result
:= mChildren
[f
].findFirstFocus();
1577 if (result
<> nil) then exit
;
1579 if (canFocus
) then result
:= self
;
1584 function TUIControl
.findLastFocus (): TUIControl
;
1591 for f
:= High(mChildren
) downto 0 do
1593 result
:= mChildren
[f
].findLastFocus();
1594 if (result
<> nil) then exit
;
1596 if (canFocus
) then result
:= self
;
1601 function TUIControl
.findNextFocus (cur
: TUIControl
; wrap
: Boolean): TUIControl
;
1603 curHit
: Boolean = false;
1605 function checkFocus (ctl
: TUIControl
): Boolean;
1609 result
:= (ctl
.canFocus
);
1613 curHit
:= (ctl
= cur
);
1614 result
:= false; // don't stop
1622 if not isMyChild(cur
) then
1624 result
:= findFirstFocus();
1628 result
:= forEachControl(checkFocus
);
1629 if (result
= nil) and (wrap
) then result
:= findFirstFocus();
1635 function TUIControl
.findPrevFocus (cur
: TUIControl
; wrap
: Boolean): TUIControl
;
1637 lastCtl
: TUIControl
= nil;
1639 function checkFocus (ctl
: TUIControl
): Boolean;
1648 if (ctl
.canFocus
) then lastCtl
:= ctl
;
1656 if not isMyChild(cur
) then
1658 result
:= findLastFocus();
1662 forEachControl(checkFocus
);
1663 if (lastCtl
= nil) and (wrap
) then lastCtl
:= findLastFocus();
1665 //if (lastCtl <> nil) then writeln('ctl<', lastCtl.className, '>: {', lastCtl.id, '}');
1671 function TUIControl
.findDefaulControl (): TUIControl
;
1677 if (mDefault
) then begin result
:= self
; exit
; end;
1678 for ctl
in mChildren
do
1680 result
:= ctl
.findDefaulControl();
1681 if (result
<> nil) then exit
;
1687 function TUIControl
.findCancelControl (): TUIControl
;
1693 if (mCancel
) then begin result
:= self
; exit
; end;
1694 for ctl
in mChildren
do
1696 result
:= ctl
.findCancelControl();
1697 if (result
<> nil) then exit
;
1704 function TUIControl
.findControlById (const aid
: AnsiString): TUIControl
;
1708 if (strEquCI1251(aid
, mId
)) then begin result
:= self
; exit
; end;
1709 for ctl
in mChildren
do
1711 result
:= ctl
.findControlById(aid
);
1712 if (result
<> nil) then exit
;
1718 procedure TUIControl
.appendChild (ctl
: TUIControl
);
1720 if (ctl
= nil) then exit
;
1721 if (ctl
.mParent
<> nil) then exit
;
1722 SetLength(mChildren
, Length(mChildren
)+1);
1723 mChildren
[High(mChildren
)] := ctl
;
1724 ctl
.mParent
:= self
;
1725 Inc(ctl
.mX
, mFrameWidth
);
1726 Inc(ctl
.mY
, mFrameHeight
);
1727 if (ctl
.mWidth
> 0) and (ctl
.mHeight
> 0) and
1728 (ctl
.mX
+ctl
.mWidth
> mFrameWidth
) and (ctl
.mY
+ctl
.mHeight
> mFrameHeight
) then
1730 if (mWidth
+mFrameWidth
< ctl
.mX
+ctl
.mWidth
) then mWidth
:= ctl
.mX
+ctl
.mWidth
+mFrameWidth
;
1731 if (mHeight
+mFrameHeight
< ctl
.mY
+ctl
.mHeight
) then mHeight
:= ctl
.mY
+ctl
.mHeight
+mFrameHeight
;
1736 function TUIControl
.setActionCBFor (const aid
: AnsiString; cb
: TActionCB
): TActionCB
;
1741 if (ctl
<> nil) then
1743 result
:= ctl
.actionCB
;
1753 function TUIControl
.forEachChildren (cb
: TCtlEnumCB
): TUIControl
;
1758 if (not assigned(cb
)) then exit
;
1759 for ctl
in mChildren
do
1761 if cb(ctl
) then begin result
:= ctl
; exit
; end;
1766 function TUIControl
.forEachControl (cb
: TCtlEnumCB
; includeSelf
: Boolean=true): TUIControl
;
1768 function forChildren (p
: TUIControl
; incSelf
: Boolean): TUIControl
;
1773 if (p
= nil) then exit
;
1774 if (incSelf
) and (cb(p
)) then begin result
:= p
; exit
; end;
1775 for ctl
in p
.mChildren
do
1777 result
:= forChildren(ctl
, true);
1778 if (result
<> nil) then break
;
1784 if (not assigned(cb
)) then exit
;
1785 result
:= forChildren(self
, includeSelf
);
1789 procedure TUIControl
.close (); // this closes *top-level* control
1794 uiRemoveWindow(ctl
);
1795 if (ctl
is TUITopWindow
) and (TUITopWindow(ctl
).mFreeOnClose
) then scheduleKill(ctl
); // just in case
1799 procedure TUIControl
.doAction ();
1801 if assigned(actionCB
) then actionCB(self
);
1805 // ////////////////////////////////////////////////////////////////////////// //
1806 procedure TUIControl
.setScissorGLInternal (x
, y
, w
, h
: Integer);
1808 if not scallowed
then exit
;
1809 x
:= trunc(x
*gh_ui_scale
);
1810 y
:= trunc(y
*gh_ui_scale
);
1811 w
:= trunc(w
*gh_ui_scale
);
1812 h
:= trunc(h
*gh_ui_scale
);
1813 scis
.combineRect(x
, y
, w
, h
);
1816 procedure TUIControl
.setScissor (lx
, ly
, lw
, lh
: Integer);
1818 gx
, gy
, wdt
, hgt
, cgx
, cgy
: Integer;
1820 if not scallowed
then exit
;
1822 if not intersectRect(lx
, ly
, lw
, lh
, 0, 0, mWidth
, mHeight
) then
1824 scis
.combineRect(0, 0, 0, 0);
1828 getDrawRect(gx
, gy
, wdt
, hgt
);
1829 toGlobal(lx
, ly
, cgx
, cgy
);
1830 if not intersectRect(gx
, gy
, wdt
, hgt
, cgx
, cgy
, lw
, lh
) then
1832 scis
.combineRect(0, 0, 0, 0);
1836 setScissorGLInternal(gx
, gy
, wdt
, hgt
);
1839 procedure TUIControl
.resetScissor (fullArea
: Boolean); inline;
1841 if not scallowed
then exit
;
1844 setScissor(0, 0, mWidth
, mHeight
);
1848 setScissor(mFrameWidth
, mFrameHeight
, mWidth
-mFrameWidth
*2, mHeight
-mFrameHeight
*2);
1853 // ////////////////////////////////////////////////////////////////////////// //
1854 procedure TUIControl
.draw ();
1859 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1860 toGlobal(0, 0, gx
, gy
);
1862 scis
.save(true); // scissoring enabled
1865 resetScissor(true); // full area
1866 drawControl(gx
, gy
);
1867 resetScissor(false); // client area
1868 for f
:= 0 to High(mChildren
) do mChildren
[f
].draw();
1869 resetScissor(true); // full area
1870 drawControlPost(gx
, gy
);
1877 procedure TUIControl
.drawControl (gx
, gy
: Integer);
1879 //if (mParent = nil) then darkenRect(gx, gy, mWidth, mHeight, 64);
1882 procedure TUIControl
.drawControlPost (gx
, gy
: Integer);
1885 if mDrawShadow
and (mWidth
> 0) and (mHeight
> 0) then
1887 setScissorGLInternal(gx
+8, gy
+8, mWidth
, mHeight
);
1888 darkenRect(gx
+mWidth
, gy
+8, 8, mHeight
, 128);
1889 darkenRect(gx
+8, gy
+mHeight
, mWidth
-8, 8, 128);
1894 // ////////////////////////////////////////////////////////////////////////// //
1895 procedure TUIControl
.mouseEvent (var ev
: THMouseEvent
);
1899 if (not enabled
) then exit
;
1900 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1901 ctl
:= controlAtXY(ev
.x
, ev
.y
);
1902 if (ctl
= nil) then exit
;
1903 if (ctl
.canFocus
) and (ev
.press
) then
1905 if (ctl
<> topLevel
.mFocused
) then ctl
.setFocused(true);
1908 if (ctl
<> self
) then ctl
.mouseEvent(ev
);
1913 procedure TUIControl
.keyEvent (var ev
: THKeyEvent
);
1915 function doPreKey (ctl
: TUIControl
): Boolean;
1917 if (not ctl
.enabled
) then begin result
:= false; exit
; end;
1918 ctl
.keyEventPre(ev
);
1919 result
:= (ev
.eaten
) or (ev
.cancelled
); // stop if event was consumed
1922 function doPostKey (ctl
: TUIControl
): Boolean;
1924 if (not ctl
.enabled
) then begin result
:= false; exit
; end;
1925 ctl
.keyEventPost(ev
);
1926 result
:= (ev
.eaten
) or (ev
.cancelled
); // stop if event was consumed
1932 if (not enabled
) then exit
;
1933 if (ev
.eaten
) or (ev
.cancelled
) then exit
;
1935 if (mParent
= nil) then
1937 forEachControl(doPreKey
);
1938 if (ev
.eaten
) or (ev
.cancelled
) then exit
;
1940 // focused control should process keyboard first
1941 if (topLevel
.mFocused
<> self
) and isMyChild(topLevel
.mFocused
) and (topLevel
.mFocused
.enabled
) then
1943 // bubble keyboard event
1944 ctl
:= topLevel
.mFocused
;
1945 while (ctl
<> nil) and (ctl
<> self
) do
1948 if (ev
.eaten
) or (ev
.cancelled
) then exit
;
1952 // for top-level controls
1953 if (mParent
= nil) then
1955 if (ev
= 'S-Tab') then
1957 ctl
:= findPrevFocus(mFocused
, true);
1958 if (ctl
<> nil) and (ctl
<> mFocused
) then ctl
.setFocused(true);
1962 if (ev
= 'Tab') then
1964 ctl
:= findNextFocus(mFocused
, true);
1965 if (ctl
<> nil) and (ctl
<> mFocused
) then ctl
.setFocused(true);
1969 if (ev
= 'Enter') or (ev
= 'C-Enter') then
1971 ctl
:= findDefaulControl();
1972 if (ctl
<> nil) then
1979 if (ev
= 'Escape') then
1981 ctl
:= findCancelControl();
1982 if (ctl
<> nil) then
1989 if mEscClose
and (ev
= 'Escape') then
1991 if (not assigned(closeRequestCB
)) or (closeRequestCB(self
)) then
1993 uiRemoveWindow(self
);
1999 if (ev
.eaten
) or (ev
.cancelled
) then exit
;
2000 forEachControl(doPostKey
);
2005 procedure TUIControl
.keyEventPre (var ev
: THKeyEvent
);
2010 procedure TUIControl
.keyEventPost (var ev
: THKeyEvent
);
2015 // ////////////////////////////////////////////////////////////////////////// //
2016 constructor TUITopWindow
.Create (const atitle
: AnsiString);
2023 procedure TUITopWindow
.AfterConstruction ();
2028 if (mWidth
< mFrameWidth
*2+3*8) then mWidth
:= mFrameWidth
*2+3*8;
2029 if (mHeight
< mFrameHeight
*2) then mHeight
:= mFrameHeight
*2;
2030 if (Length(mTitle
) > 0) then
2032 if (mWidth
< Length(mTitle
)*8+mFrameWidth
*2+3*8) then mWidth
:= Length(mTitle
)*8+mFrameWidth
*2+3*8;
2035 mDragScroll
:= TXMode
.None
;
2036 mDrawShadow
:= true;
2037 mWaitingClose
:= false;
2040 mCtl4Style
:= 'window';
2044 function TUITopWindow
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2046 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) then
2048 mTitle
:= par
.expectIdOrStr(true);
2052 if (strEquCI1251(prname
, 'children')) then
2058 if (strEquCI1251(prname
, 'position')) then
2060 if (par
.eatIdOrStrCI('default')) then mDoCenter
:= false
2061 else if (par
.eatIdOrStrCI('center')) then mDoCenter
:= true
2062 else par
.error('`center` or `default` expected');
2066 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
2067 result
:= inherited parseProperty(prname
, par
);
2071 procedure TUITopWindow
.centerInScreen ();
2073 if (mWidth
> 0) and (mHeight
> 0) then
2075 mX
:= trunc((gScrWidth
/gh_ui_scale
-mWidth
)/2);
2076 mY
:= trunc((gScrHeight
/gh_ui_scale
-mHeight
)/2);
2081 procedure TUITopWindow
.drawControl (gx
, gy
: Integer);
2083 fillRect(gx
, gy
, mWidth
, mHeight
, mBackColor
[getColorIndex
]);
2087 procedure TUITopWindow
.drawControlPost (gx
, gy
: Integer);
2090 tx
, hgt
, sbhgt
: Integer;
2092 cidx
:= getColorIndex
;
2093 if (mDragScroll
= TXMode
.Drag
) then
2095 drawRectUI(gx
+4, gy
+4, mWidth
-8, mHeight
-8, mFrameColor
[cidx
]);
2099 drawRectUI(gx
+3, gy
+3, mWidth
-6, mHeight
-6, mFrameColor
[cidx
]);
2100 drawRectUI(gx
+5, gy
+5, mWidth
-10, mHeight
-10, mFrameColor
[cidx
]);
2101 // vertical scroll bar
2102 hgt
:= mHeight
-mFrameHeight
*2;
2103 if (hgt
> 0) and (mFullSize
.h
> hgt
) then
2105 //writeln(mTitle, ': height=', mHeight-mFrameHeight*2, '; fullsize=', mFullSize.toString);
2106 sbhgt
:= mHeight
-mFrameHeight
*2+2;
2107 fillRect(gx
+mWidth
-mFrameWidth
+1, gy
+7, mFrameWidth
-3, sbhgt
, mFrameColor
[cidx
]);
2109 if (hgt
> mFullSize
.h
) then hgt
:= mFullSize
.h
;
2110 hgt
:= sbhgt
*hgt
div mFullSize
.h
;
2113 setScissor(mWidth
-mFrameWidth
+1, 7, mFrameWidth
-3, sbhgt
);
2114 darkenRect(gx
+mWidth
-mFrameWidth
+1, gy
+7+hgt
, mFrameWidth
-3, sbhgt
, 128);
2118 setScissor(mFrameWidth
, 0, 3*8, 8);
2119 fillRect(gx
+mFrameWidth
, gy
, 3*8, 8, mBackColor
[cidx
]);
2120 drawText8(gx
+mFrameWidth
, gy
, '[ ]', mFrameColor
[cidx
]);
2121 if mInClose
then drawText8(gx
+mFrameWidth
+7, gy
, '#', mFrameIconColor
[cidx
])
2122 else drawText8(gx
+mFrameWidth
+7, gy
, '*', mFrameIconColor
[cidx
]);
2125 if (Length(mTitle
) > 0) then
2127 setScissor(mFrameWidth
+3*8, 0, mWidth
-mFrameWidth
*2-3*8, 8);
2128 tx
:= (gx
+3*8)+((mWidth
-3*8)-Length(mTitle
)*8) div 2;
2129 fillRect(tx
-3, gy
, Length(mTitle
)*8+3+2, 8, mBackColor
[cidx
]);
2130 drawText8(tx
, gy
, mTitle
, mFrameTextColor
[cidx
]);
2133 inherited drawControlPost(gx
, gy
);
2137 procedure TUITopWindow
.activated ();
2139 if (mFocused
= nil) or (mFocused
= self
) then
2141 mFocused
:= findFirstFocus();
2143 if (mFocused
<> nil) and (mFocused
<> self
) then mFocused
.activated();
2148 procedure TUITopWindow
.blurred ();
2150 mDragScroll
:= TXMode
.None
;
2151 mWaitingClose
:= false;
2153 if (mFocused
<> nil) and (mFocused
<> self
) then mFocused
.blurred();
2158 procedure TUITopWindow
.keyEvent (var ev
: THKeyEvent
);
2160 inherited keyEvent(ev
);
2161 if (ev
.eaten
) or (ev
.cancelled
) or (not enabled
) {or (not getFocused)} then exit
;
2162 if (ev
= 'M-F3') then
2164 if (not assigned(closeRequestCB
)) or (closeRequestCB(self
)) then
2166 uiRemoveWindow(self
);
2174 procedure TUITopWindow
.mouseEvent (var ev
: THMouseEvent
);
2177 hgt
, sbhgt
: Integer;
2179 if (not enabled
) then exit
;
2180 if (mWidth
< 1) or (mHeight
< 1) then exit
;
2182 if (mDragScroll
= TXMode
.Drag
) then
2184 mX
+= ev
.x
-mDragStartX
;
2185 mY
+= ev
.y
-mDragStartY
;
2186 mDragStartX
:= ev
.x
;
2187 mDragStartY
:= ev
.y
;
2188 if (ev
.release
) and (ev
.but
= ev
.Left
) then mDragScroll
:= TXMode
.None
;
2193 if (mDragScroll
= TXMode
.Scroll
) then
2195 // check for vertical scrollbar
2203 sbhgt
:= mHeight
-mFrameHeight
*2+2;
2204 hgt
:= mHeight
-mFrameHeight
*2;
2205 if (hgt
> 0) and (mFullSize
.h
> hgt
) then
2207 hgt
:= (mFullSize
.h
*(ly
-7) div (sbhgt
-1))-(mHeight
-mFrameHeight
*2);
2208 mScrollY
:= nmax(0, hgt
);
2209 hgt
:= mHeight
-mFrameHeight
*2;
2210 if (mScrollY
+hgt
> mFullSize
.h
) then mScrollY
:= nmax(0, mFullSize
.h
-hgt
);
2213 if (ev
.release
) and (ev
.but
= ev
.Left
) then mDragScroll
:= TXMode
.None
;
2218 if toLocal(ev
.x
, ev
.y
, lx
, ly
) then
2225 if (lx
>= mFrameWidth
) and (lx
< mFrameWidth
+3*8) then
2227 //uiRemoveWindow(self);
2228 mWaitingClose
:= true;
2233 mDragScroll
:= TXMode
.Drag
;
2234 mDragStartX
:= ev
.x
;
2235 mDragStartY
:= ev
.y
;
2240 // check for vertical scrollbar
2241 if (lx
>= mWidth
-mFrameWidth
+1) and (ly
>= 7) and (ly
< mHeight
-mFrameHeight
+1) then
2243 sbhgt
:= mHeight
-mFrameHeight
*2+2;
2244 hgt
:= mHeight
-mFrameHeight
*2;
2245 if (hgt
> 0) and (mFullSize
.h
> hgt
) then
2247 hgt
:= (mFullSize
.h
*(ly
-7) div (sbhgt
-1))-(mHeight
-mFrameHeight
*2);
2248 mScrollY
:= nmax(0, hgt
);
2250 mDragScroll
:= TXMode
.Scroll
;
2256 if (lx
< mFrameWidth
) or (lx
>= mWidth
-mFrameWidth
) or (ly
>= mHeight
-mFrameHeight
) then
2259 mDragScroll
:= TXMode
.Drag
;
2260 mDragStartX
:= ev
.x
;
2261 mDragStartY
:= ev
.y
;
2267 if (ev
.release
) then
2269 if mWaitingClose
then
2271 if (lx
>= mFrameWidth
) and (lx
< mFrameWidth
+3*8) then
2273 if (not assigned(closeRequestCB
)) or (closeRequestCB(self
)) then
2275 uiRemoveWindow(self
);
2278 mWaitingClose
:= false;
2287 if mWaitingClose
then
2289 mInClose
:= (lx
>= mFrameWidth
) and (lx
< mFrameWidth
+3*8);
2295 inherited mouseEvent(ev
);
2300 if (not ev
.motion
) and (mWaitingClose
) then begin ev
.eat(); mWaitingClose
:= false; exit
; end;
2305 // ////////////////////////////////////////////////////////////////////////// //
2306 constructor TUIBox
.Create (ahoriz
: Boolean);
2313 procedure TUIBox
.AfterConstruction ();
2317 mHAlign
:= -1; // left
2318 mCtl4Style
:= 'box';
2322 procedure TUIBox
.setCaption (const acap
: AnsiString);
2325 mDefSize
:= TLaySize
.Create(Length(mCaption
)*8+3, 8);
2329 procedure TUIBox
.setHasFrame (v
: Boolean);
2332 if (mHasFrame
) then begin mFrameWidth
:= 8; mFrameHeight
:= 8; end else begin mFrameWidth
:= 0; mFrameHeight
:= 0; end;
2336 function TUIBox
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2338 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
2339 if (strEquCI1251(prname
, 'frame')) then
2341 setHasFrame(parseBool(par
));
2345 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) then
2347 setCaption(par
.expectIdOrStr(true));
2351 if (strEquCI1251(prname
, 'textalign')) or (strEquCI1251(prname
, 'text-align')) then
2353 mHAlign
:= parseHAlign(par
);
2357 if (strEquCI1251(prname
, 'children')) then
2363 result
:= inherited parseProperty(prname
, par
);
2367 procedure TUIBox
.drawControl (gx
, gy
: Integer);
2372 cidx
:= getColorIndex
;
2373 fillRect(gx
, gy
, mWidth
, mHeight
, mBackColor
[cidx
]);
2377 drawRectUI(gx
+3, gy
+3, mWidth
-6, mHeight
-6, mFrameColor
[cidx
]);
2380 if (Length(mCaption
) > 0) then
2382 if (mHAlign
< 0) then xpos
:= 3
2383 else if (mHAlign
> 0) then xpos
:= mWidth
-mFrameWidth
*2-Length(mCaption
)*8
2384 else xpos
:= (mWidth
-mFrameWidth
*2-Length(mCaption
)*8) div 2;
2385 xpos
+= gx
+mFrameWidth
;
2387 setScissor(mFrameWidth
+1, 0, mWidth
-mFrameWidth
-2, 8);
2388 if mHasFrame
then fillRect(xpos
-3, gy
, Length(mCaption
)*8+4, 8, mBackColor
[cidx
]);
2389 drawText8(xpos
, gy
, mCaption
, mFrameTextColor
[cidx
]);
2394 procedure TUIBox
.mouseEvent (var ev
: THMouseEvent
);
2398 inherited mouseEvent(ev
);
2399 if (not ev
.eaten
) and (not ev
.cancelled
) and (enabled
) and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
2406 procedure TUIBox
.keyEvent (var ev
: THKeyEvent
);
2409 cur
, ctl
: TUIControl
;
2411 inherited keyEvent(ev
);
2412 if (ev
.eaten
) or (ev
.cancelled
) or (not ev
.press
) or (not enabled
) or (not getActive
) then exit
;
2413 if (Length(mChildren
) = 0) then exit
;
2414 if (mHoriz
) and (ev
= 'Left') then dir
:= -1
2415 else if (mHoriz
) and (ev
= 'Right') then dir
:= 1
2416 else if (not mHoriz
) and (ev
= 'Up') then dir
:= -1
2417 else if (not mHoriz
) and (ev
= 'Down') then dir
:= 1;
2418 if (dir
= 0) then exit
;
2420 cur
:= topLevel
.mFocused
;
2421 while (cur
<> nil) and (cur
.mParent
<> self
) do cur
:= cur
.mParent
;
2422 //if (cur = nil) then writeln('CUR: nil') else writeln('CUR: ', cur.className, '#', cur.id);
2423 if (dir
< 0) then ctl
:= findPrevFocus(cur
, true) else ctl
:= findNextFocus(cur
, true);
2424 //if (ctl = nil) then writeln('CTL: nil') else writeln('CTL: ', ctl.className, '#', ctl.id);
2425 if (ctl
<> nil) and (ctl
<> self
) then
2427 ctl
.focused
:= true;
2432 // ////////////////////////////////////////////////////////////////////////// //
2433 constructor TUIHBox
.Create ();
2438 procedure TUIHBox
.AfterConstruction ();
2445 // ////////////////////////////////////////////////////////////////////////// //
2446 constructor TUIVBox
.Create ();
2451 procedure TUIVBox
.AfterConstruction ();
2455 writeln('VBOX: ', canFocus
, ':', enabled
);
2459 // ////////////////////////////////////////////////////////////////////////// //
2460 procedure TUISpan
.AfterConstruction ();
2465 mCtl4Style
:= 'span';
2469 function TUISpan
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2471 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
2472 result
:= inherited parseProperty(prname
, par
);
2476 procedure TUISpan
.drawControl (gx
, gy
: Integer);
2481 // ////////////////////////////////////////////////////////////////////// //
2482 procedure TUILine
.AfterConstruction ();
2488 mCtl4Style
:= 'line';
2492 function TUILine
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2494 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
2495 result
:= inherited parseProperty(prname
, par
);
2499 procedure TUILine
.drawControl (gx
, gy
: Integer);
2503 cidx
:= getColorIndex
;
2506 drawHLine(gx
, gy
+(mHeight
div 2), mWidth
, mTextColor
[cidx
]);
2510 drawVLine(gx
+(mWidth
div 2), gy
, mHeight
, mTextColor
[cidx
]);
2515 // ////////////////////////////////////////////////////////////////////////// //
2516 procedure TUIHLine
.AfterConstruction ();
2524 // ////////////////////////////////////////////////////////////////////////// //
2525 procedure TUIVLine
.AfterConstruction ();
2533 // ////////////////////////////////////////////////////////////////////////// //
2534 procedure TUIStaticText
.AfterConstruction ();
2540 mHoriz
:= true; // nobody cares
2544 mCtl4Style
:= 'static';
2548 procedure TUIStaticText
.setText (const atext
: AnsiString);
2551 mDefSize
:= TLaySize
.Create(Length(mText
)*8, 8);
2555 function TUIStaticText
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2557 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) or (strEquCI1251(prname
, 'text')) then
2559 setText(par
.expectIdOrStr(true));
2563 if (strEquCI1251(prname
, 'textalign')) or (strEquCI1251(prname
, 'text-align')) then
2565 parseTextAlign(par
, mHAlign
, mVAlign
);
2569 if (strEquCI1251(prname
, 'header')) then
2575 if (strEquCI1251(prname
, 'line')) then
2581 result
:= inherited parseProperty(prname
, par
);
2585 procedure TUIStaticText
.drawControl (gx
, gy
: Integer);
2587 xpos
, ypos
: Integer;
2591 cidx
:= getColorIndex
;
2592 fillRect(gx
, gy
, mWidth
, mHeight
, mBackColor
[cidx
]);
2594 if (mHAlign
< 0) then xpos
:= 0
2595 else if (mHAlign
> 0) then xpos
:= mWidth
-Length(mText
)*8
2596 else xpos
:= (mWidth
-Length(mText
)*8) div 2;
2598 if (Length(mText
) > 0) then
2600 if (mHeader
) then clr
:= mFrameTextColor
[cidx
] else clr
:= mTextColor
[cidx
];
2602 if (mVAlign
< 0) then ypos
:= 0
2603 else if (mVAlign
> 0) then ypos
:= mHeight
-8
2604 else ypos
:= (mHeight
-8) div 2;
2606 drawText8(gx
+xpos
, gy
+ypos
, mText
, clr
);
2611 if (mHeader
) then clr
:= mFrameColor
[cidx
] else clr
:= mTextColor
[cidx
];
2613 if (mVAlign
< 0) then ypos
:= 0
2614 else if (mVAlign
> 0) then ypos
:= mHeight
-1
2615 else ypos
:= (mHeight
div 2);
2618 if (Length(mText
) = 0) then
2620 drawHLine(gx
, ypos
, mWidth
, clr
);
2624 drawHLine(gx
, ypos
, xpos
-1, clr
);
2625 drawHLine(gx
+xpos
+Length(mText
)*8, ypos
, mWidth
, clr
);
2631 // ////////////////////////////////////////////////////////////////////////// //
2632 procedure TUITextLabel
.AfterConstruction ();
2638 mDefSize
:= TLaySize
.Create(Length(mText
)*8, 8);
2639 mCtl4Style
:= 'label';
2644 procedure TUITextLabel
.cacheStyle (root
: TUIStyle
);
2646 inherited cacheStyle(root
);
2648 mHotColor
[ClrIdxActive
] := root
.get('hot-color', 'active', mCtl4Style
).asRGBADef(TGxRGBA
.Create(0, 128, 0));
2650 mHotColor
[ClrIdxDisabled
] := root
.get('hot-color', 'disabled', mCtl4Style
).asRGBADef(TGxRGBA
.Create(0, 64, 0));
2652 mHotColor
[ClrIdxInactive
] := root
.get('hot-color', 'inactive', mCtl4Style
).asRGBADef(TGxRGBA
.Create(0, 64, 0));
2656 procedure TUITextLabel
.setText (const s
: AnsiString);
2664 while (f
<= Length(s
)) do
2666 if (s
[f
] = '\\') then
2669 if (f
<= Length(s
)) then mText
+= s
[f
];
2672 else if (s
[f
] = '~') then
2675 if (f
<= Length(s
)) then
2677 if (mHotChar
= #0) then
2680 mHotOfs
:= Length(mText
)*8;
2692 mDefSize
:= TLaySize
.Create(Length(mText
)*8, 8);
2696 function TUITextLabel
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2698 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) or (strEquCI1251(prname
, 'text')) then
2700 setText(par
.expectIdOrStr(true));
2704 if (strEquCI1251(prname
, 'link')) then
2706 mLinkId
:= par
.expectIdOrStr(true);
2710 if (strEquCI1251(prname
, 'textalign')) or (strEquCI1251(prname
, 'text-align')) then
2712 parseTextAlign(par
, mHAlign
, mVAlign
);
2716 result
:= inherited parseProperty(prname
, par
);
2720 procedure TUITextLabel
.drawControl (gx
, gy
: Integer);
2722 xpos
, ypos
: Integer;
2725 cidx
:= getColorIndex
;
2726 fillRect(gx
, gy
, mWidth
, mHeight
, mBackColor
[cidx
]);
2727 if (Length(mText
) > 0) then
2729 if (mHAlign
< 0) then xpos
:= 0
2730 else if (mHAlign
> 0) then xpos
:= mWidth
-Length(mText
)*8
2731 else xpos
:= (mWidth
-Length(mText
)*8) div 2;
2733 if (mVAlign
< 0) then ypos
:= 0
2734 else if (mVAlign
> 0) then ypos
:= mHeight
-8
2735 else ypos
:= (mHeight
-8) div 2;
2737 drawText8(gx
+xpos
, gy
+ypos
, mText
, mTextColor
[cidx
]);
2739 if (Length(mLinkId
) > 0) and (mHotChar
<> #0) and (mHotChar
<> ' ') then
2741 drawText8(gx
+xpos
+8+mHotOfs
, gy
+ypos
, mHotChar
, mHotColor
[cidx
]);
2747 procedure TUITextLabel
.mouseEvent (var ev
: THMouseEvent
);
2751 inherited mouseEvent(ev
);
2752 if (not ev
.eaten
) and (not ev
.cancelled
) and (enabled
) and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
2759 procedure TUITextLabel
.keyEventPost (var ev
: THKeyEvent
);
2763 if (not enabled
) then exit
;
2764 if (mHotChar
= #0) or (Length(mLinkId
) = 0) then exit
;
2765 if (ev
.eaten
) or (ev
.cancelled
) or (not ev
.press
) then exit
;
2766 if (not ev
.isHot(mHotChar
)) then exit
;
2767 ctl
:= topLevel
[mLinkId
];
2768 if (ctl
<> nil) then
2771 if (ctl
.canFocus
) then ctl
.focused
:= true;
2776 // ////////////////////////////////////////////////////////////////////////// //
2777 procedure TUIButton
.AfterConstruction ();
2783 mDefSize
:= TLaySize
.Create(Length(mText
)*8+8, 10);
2784 mCtl4Style
:= 'button';
2788 procedure TUIButton
.setText (const s
: AnsiString);
2790 inherited setText(s
);
2791 mDefSize
:= TLaySize
.Create(Length(mText
)*8+8*2, 10);
2795 procedure TUIButton
.drawControl (gx
, gy
: Integer);
2797 xpos
, ypos
: Integer;
2800 cidx
:= getColorIndex
;
2802 fillRect(gx
+1, gy
, mWidth
-2, mHeight
, mBackColor
[cidx
]);
2803 fillRect(gx
, gy
+1, 1, mHeight
-2, mBackColor
[cidx
]);
2804 fillRect(gx
+mWidth
-1, gy
+1, 1, mHeight
-2, mBackColor
[cidx
]);
2806 if (Length(mText
) > 0) then
2808 if (mHAlign
< 0) then xpos
:= 0
2809 else if (mHAlign
> 0) then xpos
:= mWidth
-Length(mText
)*8
2810 else xpos
:= (mWidth
-Length(mText
)*8) div 2;
2812 if (mVAlign
< 0) then ypos
:= 0
2813 else if (mVAlign
> 0) then ypos
:= mHeight
-8
2814 else ypos
:= (mHeight
-8) div 2;
2816 setScissor(8, 0, mWidth
-16, mHeight
);
2817 drawText8(gx
+xpos
+8, gy
+ypos
, mText
, mTextColor
[cidx
]);
2819 if (mHotChar
<> #0) and (mHotChar
<> ' ') then drawText8(gx
+xpos
+8+mHotOfs
, gy
+ypos
, mHotChar
, mHotColor
[cidx
]);
2824 procedure TUIButton
.mouseEvent (var ev
: THMouseEvent
);
2828 inherited mouseEvent(ev
);
2829 if (uiGrabCtl
= self
) then
2832 if (ev
= '-lmb') and focused
and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
2838 if (ev
.eaten
) or (ev
.cancelled
) or (not enabled
) or not focused
then exit
;
2843 procedure TUIButton
.keyEvent (var ev
: THKeyEvent
);
2845 inherited keyEvent(ev
);
2846 if (not ev
.eaten
) and (not ev
.cancelled
) and (enabled
) then
2848 if (ev
= 'Enter') or (ev
= 'Space') then
2858 procedure TUIButton
.keyEventPost (var ev
: THKeyEvent
);
2860 if (not enabled
) then exit
;
2861 if (mHotChar
= #0) then exit
;
2862 if (ev
.eaten
) or (ev
.cancelled
) or (not ev
.press
) then exit
;
2863 if (not ev
.isHot(mHotChar
)) then exit
;
2864 if (not canFocus
) then exit
;
2871 // ////////////////////////////////////////////////////////////////////////// //
2872 procedure TUISwitchBox
.AfterConstruction ();
2878 mDefSize
:= TLaySize
.Create(Length(mText
)*8+8*3, 8);
2879 mCtl4Style
:= 'switchbox';
2881 mBoolVar
:= @mChecked
;
2885 procedure TUISwitchBox
.cacheStyle (root
: TUIStyle
);
2887 inherited cacheStyle(root
);
2889 mSwitchColor
[ClrIdxActive
] := root
.get('switch-color', 'active', mCtl4Style
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
2891 mSwitchColor
[ClrIdxDisabled
] := root
.get('switch-color', 'disabled', mCtl4Style
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
2893 mSwitchColor
[ClrIdxInactive
] := root
.get('switch-color', 'inactive', mCtl4Style
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
2897 procedure TUISwitchBox
.setText (const s
: AnsiString);
2899 inherited setText(s
);
2900 mDefSize
:= TLaySize
.Create(Length(mText
)*8+8*3, 8);
2904 function TUISwitchBox
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2906 if (strEquCI1251(prname
, 'checked')) then
2912 result
:= inherited parseProperty(prname
, par
);
2916 function TUISwitchBox
.getChecked (): Boolean;
2918 if (mBoolVar
<> nil) then result
:= mBoolVar
^ else result
:= false;
2922 procedure TUISwitchBox
.setVar (pvar
: PBoolean);
2924 if (pvar
= nil) then pvar
:= @mChecked
;
2925 if (pvar
<> mBoolVar
) then
2928 setChecked(mBoolVar
^);
2933 procedure TUISwitchBox
.drawControl (gx
, gy
: Integer);
2935 xpos
, ypos
: Integer;
2938 cidx
:= getColorIndex
;
2940 if (mHAlign
< 0) then xpos
:= 0
2941 else if (mHAlign
> 0) then xpos
:= mWidth
-(Length(mText
)+4)*8
2942 else xpos
:= (mWidth
-(Length(mText
)+4)*8) div 2;
2944 if (mVAlign
< 0) then ypos
:= 0
2945 else if (mVAlign
> 0) then ypos
:= mHeight
-8
2946 else ypos
:= (mHeight
-8) div 2;
2949 fillRect(gx
, gy
, mWidth
, mHeight
, mBackColor
[cidx
]);
2953 if (Length(mCheckedStr
) <> 3) or (mCheckedStr
[2] <> '*') then
2955 drawText8(gx
+xpos
, gy
+ypos
, mCheckedStr
, mSwitchColor
[cidx
]);
2959 drawText8(gx
+xpos
, gy
+ypos
, mCheckedStr
[1], mSwitchColor
[cidx
]);
2960 drawText8(gx
+xpos
+2*8, gy
+ypos
, mCheckedStr
[3], mSwitchColor
[cidx
]);
2961 drawText8(gx
+xpos
+7, gy
+ypos
, '*', mSwitchColor
[cidx
]);
2966 drawText8(gx
+xpos
, gy
+ypos
, mUncheckedStr
, mSwitchColor
[cidx
]);
2969 drawText8(gx
+xpos
+8*3, gy
+ypos
, mText
, mTextColor
[cidx
]);
2971 if (mHotChar
<> #0) and (mHotChar
<> ' ') then drawText8(gx
+xpos
+8*3+mHotOfs
, gy
+ypos
, mHotChar
, mHotColor
[cidx
]);
2975 procedure TUISwitchBox
.mouseEvent (var ev
: THMouseEvent
);
2979 inherited mouseEvent(ev
);
2980 if (uiGrabCtl
= self
) then
2983 if (ev
= '-lmb') and focused
and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
2989 if (ev
.eaten
) or (ev
.cancelled
) or (not enabled
) or not focused
then exit
;
2994 procedure TUISwitchBox
.keyEvent (var ev
: THKeyEvent
);
2996 inherited keyEvent(ev
);
2997 if (not ev
.eaten
) and (not ev
.cancelled
) and (enabled
) then
2999 if (ev
= 'Space') then
3009 procedure TUISwitchBox
.keyEventPost (var ev
: THKeyEvent
);
3011 if (not enabled
) then exit
;
3012 if (mHotChar
= #0) then exit
;
3013 if (ev
.eaten
) or (ev
.cancelled
) or (not ev
.press
) then exit
;
3014 if (not ev
.isHot(mHotChar
)) then exit
;
3015 if (not canFocus
) then exit
;
3022 // ////////////////////////////////////////////////////////////////////////// //
3023 procedure TUICheckBox
.AfterConstruction ();
3027 mBoolVar
:= @mChecked
;
3028 mCheckedStr
:= '[x]';
3029 mUncheckedStr
:= '[ ]';
3033 procedure TUICheckBox
.setChecked (v
: Boolean);
3039 procedure TUICheckBox
.doAction ();
3041 if (assigned(actionCB
)) then
3047 setChecked(not getChecked
);
3052 // ////////////////////////////////////////////////////////////////////////// //
3053 procedure TUIRadioBox
.AfterConstruction ();
3057 mBoolVar
:= @mChecked
;
3058 mCheckedStr
:= '(*)';
3059 mUncheckedStr
:= '( )';
3064 function TUIRadioBox
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
3066 if (strEquCI1251(prname
, 'group')) then
3068 mRadioGroup
:= par
.expectIdOrStr(true);
3069 if (getChecked
) then setChecked(true);
3073 if (strEquCI1251(prname
, 'checked')) then
3079 result
:= inherited parseProperty(prname
, par
);
3083 procedure TUIRadioBox
.setChecked (v
: Boolean);
3085 function resetGroup (ctl
: TUIControl
): Boolean;
3088 if (ctl
<> self
) and (ctl
is TUIRadioBox
) and (TUIRadioBox(ctl
).mRadioGroup
= mRadioGroup
) then
3090 TUIRadioBox(ctl
).mBoolVar
^ := false;
3096 if v
then topLevel
.forEachControl(resetGroup
);
3100 procedure TUIRadioBox
.doAction ();
3102 if (assigned(actionCB
)) then
3113 // ////////////////////////////////////////////////////////////////////////// //
3115 registerCtlClass(TUIHBox
, 'hbox');
3116 registerCtlClass(TUIVBox
, 'vbox');
3117 registerCtlClass(TUISpan
, 'span');
3118 registerCtlClass(TUIHLine
, 'hline');
3119 registerCtlClass(TUIVLine
, 'vline');
3120 registerCtlClass(TUITextLabel
, 'label');
3121 registerCtlClass(TUIStaticText
, 'static');
3122 registerCtlClass(TUIButton
, 'button');
3123 registerCtlClass(TUICheckBox
, 'checkbox');
3124 registerCtlClass(TUIRadioBox
, 'radiobox');