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}
27 fui_common
, fui_events
, fui_style
,
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; // >255: none
76 procedure updateStyle (); virtual;
77 procedure cacheStyle (root
: TUIStyle
); virtual;
78 function getColorIndex (): Integer; inline;
81 function getEnabled (): Boolean;
82 procedure setEnabled (v
: Boolean); inline;
84 function getFocused (): Boolean; inline;
85 procedure setFocused (v
: Boolean); inline;
87 function getActive (): Boolean; inline;
89 function getCanFocus (): Boolean; inline;
91 function isMyChild (ctl
: TUIControl
): Boolean;
93 function findFirstFocus (): TUIControl
;
94 function findLastFocus (): TUIControl
;
96 function findNextFocus (cur
: TUIControl
; wrap
: Boolean): TUIControl
;
97 function findPrevFocus (cur
: TUIControl
; wrap
: Boolean): TUIControl
;
99 function findCancelControl (): TUIControl
;
100 function findDefaulControl (): TUIControl
;
102 function findControlById (const aid
: AnsiString): TUIControl
;
104 procedure activated (); virtual;
105 procedure blurred (); virtual;
107 procedure calcFullClientSize ();
110 var savedClip
: TGxRect
; // valid only in `draw*()` calls
111 //WARNING! do not call scissor functions outside `.draw*()` API!
112 // set scissor to this rect (in local coords)
113 procedure setScissor (lx
, ly
, lw
, lh
: Integer); // valid only in `draw*()` calls
117 closeRequestCB
: TCloseRequestCB
;
120 mDefSize
: TLaySize
; // default size
121 mMaxSize
: TLaySize
; // maximum size
130 mLayDefSize
: TLaySize
;
131 mLayMaxSize
: TLaySize
;
137 // layouter interface
138 function getDefSize (): TLaySize
; inline; // default size; <0: use max size
139 //procedure setDefSize (const sz: TLaySize); inline; // default size; <0: use max size
140 function getMargins (): TLayMargins
; inline;
141 function getPadding (): TLaySize
; inline; // children padding (each non-first child will get this on left/top)
142 function getMaxSize (): TLaySize
; inline; // max size; <0: set to some huge value
143 //procedure setMaxSize (const sz: TLaySize); inline; // max size; <0: set to some huge value
144 function getFlex (): Integer; inline; // <=0: not flexible
145 function isHorizBox (): Boolean; inline; // horizontal layout for children?
146 function canWrap (): Boolean; inline; // for horizontal boxes: can wrap children? for child: `false` means 'nonbreakable at *next* ctl'
147 function noPad (): Boolean; inline; // ignore padding in box direction for this control
148 function isLineStart (): Boolean; inline; // `true` if this ctl should start a new line; ignored for vertical boxes
149 function getAlign (): Integer; inline; // aligning in non-main direction: <0: left/up; 0: center; >0: right/down
150 function getExpand (): Boolean; inline; // expanding in non-main direction: `true` will ignore align and eat all available space
151 function getHGroup (): AnsiString; inline; // empty: not grouped
152 function getVGroup (): AnsiString; inline; // empty: not grouped
154 procedure setActualSizePos (constref apos
: TLayPos
; constref asize
: TLaySize
); inline;
156 procedure layPrepare (); virtual; // called before registering control in layouter
159 property flex
: Integer read mFlex write mFlex
;
160 property flDefaultSize
: TLaySize read mDefSize write mDefSize
;
161 property flMaxSize
: TLaySize read mMaxSize write mMaxSize
;
162 property flPadding
: TLaySize read mPadding write mPadding
;
163 property flHoriz
: Boolean read mHoriz write mHoriz
;
164 property flCanWrap
: Boolean read mCanWrap write mCanWrap
;
165 property flLineStart
: Boolean read mLineStart write mLineStart
;
166 property flAlign
: Integer read mAlign write mAlign
;
167 property flExpand
: Boolean read mExpand write mExpand
;
168 property flHGroup
: AnsiString read mHGroup write mHGroup
;
169 property flVGroup
: AnsiString read mVGroup write mVGroup
;
170 property flNoPad
: Boolean read mNoPad write mNoPad
;
171 property fullSize
: TLaySize read mFullSize
;
174 function parsePos (par
: TTextParser
): TLayPos
;
175 function parseSize (par
: TTextParser
): TLaySize
;
176 function parsePadding (par
: TTextParser
): TLaySize
;
177 function parseHPadding (par
: TTextParser
; def
: Integer): TLaySize
;
178 function parseVPadding (par
: TTextParser
; def
: Integer): TLaySize
;
179 function parseBool (par
: TTextParser
): Boolean;
180 function parseAnyAlign (par
: TTextParser
): Integer;
181 function parseHAlign (par
: TTextParser
): Integer;
182 function parseVAlign (par
: TTextParser
): Integer;
183 function parseOrientation (const prname
: AnsiString; par
: TTextParser
): Boolean;
184 procedure parseTextAlign (par
: TTextParser
; var h
, v
: Integer);
185 procedure parseChildren (par
: TTextParser
); // par should be on '{'; final '}' is eaten
188 // par is on property data
189 // there may be more data in text stream, don't eat it!
190 // return `true` if property name is valid and value was parsed
191 // return `false` if property name is invalid; don't advance parser in this case
192 // throw on property data errors
193 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; virtual;
195 // par should be on '{'; final '}' is eaten
196 procedure parseProperties (par
: TTextParser
);
199 constructor Create ();
200 destructor Destroy (); override;
202 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
204 // `sx` and `sy` are screen coordinates
205 procedure drawControl (gx
, gy
: Integer); virtual;
207 // called after all children drawn
208 procedure drawControlPost (gx
, gy
: Integer); virtual;
210 procedure draw (); virtual;
212 function topLevel (): TUIControl
; inline;
214 // returns `true` if global coords are inside this control
215 function toLocal (var x
, y
: Integer): Boolean;
216 function toLocal (gx
, gy
: Integer; out x
, y
: Integer): Boolean; inline;
217 procedure toGlobal (var x
, y
: Integer);
218 procedure toGlobal (lx
, ly
: Integer; out x
, y
: Integer); inline;
220 procedure getDrawRect (out gx
, gy
, wdt
, hgt
: Integer);
222 // x and y are global coords
223 function controlAtXY (x
, y
: Integer; allowDisabled
: Boolean=false): TUIControl
;
225 function parentScrollX (): Integer; inline;
226 function parentScrollY (): Integer; inline;
228 procedure makeVisibleInParent ();
230 procedure doAction (); virtual; // so user controls can override it
232 procedure mouseEvent (var ev
: THMouseEvent
); virtual; // returns `true` if event was eaten
233 procedure keyEvent (var ev
: THKeyEvent
); virtual; // returns `true` if event was eaten
234 procedure keyEventPre (var ev
: THKeyEvent
); virtual; // will be called before dispatching the event
235 procedure keyEventPost (var ev
: THKeyEvent
); virtual; // will be called after if nobody processed the event
237 function prevSibling (): TUIControl
;
238 function nextSibling (): TUIControl
;
239 function firstChild (): TUIControl
; inline;
240 function lastChild (): TUIControl
; inline;
242 procedure appendChild (ctl
: TUIControl
); virtual;
244 function setActionCBFor (const aid
: AnsiString; cb
: TActionCB
): TActionCB
; // returns previous cb
246 function forEachChildren (cb
: TCtlEnumCB
): TUIControl
; // doesn't recurse
247 function forEachControl (cb
: TCtlEnumCB
; includeSelf
: Boolean=true): TUIControl
;
249 procedure close (); // this closes *top-level* control
252 property id
: AnsiString read mId write mId
;
253 property styleId
: AnsiString read mStyleId
;
254 property scrollX
: Integer read mScrollX write mScrollX
;
255 property scrollY
: Integer read mScrollY write mScrollY
;
256 property x0
: Integer read mX write mX
;
257 property y0
: Integer read mY write mY
;
258 property width
: Integer read mWidth write mWidth
;
259 property height
: Integer read mHeight write mHeight
;
260 property enabled
: Boolean read getEnabled write setEnabled
;
261 property parent
: TUIControl read mParent
;
262 property focused
: Boolean read getFocused write setFocused
;
263 property active
: Boolean read getActive
;
264 property escClose
: Boolean read mEscClose write mEscClose
;
265 property cancel
: Boolean read mCancel write mCancel
;
266 property defctl
: Boolean read mDefault write mDefault
;
267 property canFocus
: Boolean read getCanFocus write mCanFocus
;
268 property ctlById
[const aid
: AnsiString]: TUIControl read findControlById
; default
;
272 TUITopWindow
= class(TUIControl
)
274 type TXMode
= (None
, Drag
, Scroll
);
279 mDragStartX
, mDragStartY
: Integer;
280 mWaitingClose
: Boolean;
282 mFreeOnClose
: Boolean; // default: false
283 mDoCenter
: Boolean; // after layouting
284 mFitToScreen
: Boolean;
287 procedure activated (); override;
288 procedure blurred (); override;
291 closeCB
: TActionCB
; // called after window was removed from ui window list
294 constructor Create (const atitle
: AnsiString);
296 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
298 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
300 procedure flFitToScreen (); // call this before layouting
302 procedure centerInScreen ();
304 // `sx` and `sy` are screen coordinates
305 procedure drawControl (gx
, gy
: Integer); override;
306 procedure drawControlPost (gx
, gy
: Integer); override;
308 procedure keyEvent (var ev
: THKeyEvent
); override; // returns `true` if event was eaten
309 procedure mouseEvent (var ev
: THMouseEvent
); override; // returns `true` if event was eaten
312 property freeOnClose
: Boolean read mFreeOnClose write mFreeOnClose
;
313 property fitToScreen
: Boolean read mFitToScreen write mFitToScreen
;
316 // ////////////////////////////////////////////////////////////////////// //
317 TUIBox
= class(TUIControl
)
320 mCaption
: AnsiString;
321 mHAlign
: Integer; // -1: left; 0: center; 1: right; default: left
324 procedure setCaption (const acap
: AnsiString);
325 procedure setHasFrame (v
: Boolean);
328 constructor Create (ahoriz
: Boolean);
330 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
332 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
334 procedure drawControl (gx
, gy
: Integer); override;
336 procedure mouseEvent (var ev
: THMouseEvent
); override;
337 procedure keyEvent (var ev
: THKeyEvent
); override;
340 property caption
: AnsiString read mCaption write setCaption
;
341 property hasFrame
: Boolean read mHasFrame write setHasFrame
;
342 property captionAlign
: Integer read mHAlign write mHAlign
;
345 TUIHBox
= class(TUIBox
)
347 constructor Create ();
349 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
352 TUIVBox
= class(TUIBox
)
354 constructor Create ();
356 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
359 // ////////////////////////////////////////////////////////////////////// //
360 TUISpan
= class(TUIControl
)
362 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
364 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
366 procedure drawControl (gx
, gy
: Integer); override;
369 // ////////////////////////////////////////////////////////////////////// //
370 TUILine
= class(TUIControl
)
372 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
374 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
376 procedure drawControl (gx
, gy
: Integer); override;
379 TUIHLine
= class(TUILine
)
381 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
384 TUIVLine
= class(TUILine
)
386 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
389 // ////////////////////////////////////////////////////////////////////// //
390 TUIStaticText
= class(TUIControl
)
393 mHAlign
: Integer; // -1: left; 0: center; 1: right; default: left
394 mVAlign
: Integer; // -1: top; 0: center; 1: bottom; default: center
395 mHeader
: Boolean; // true: draw with frame text color
396 mLine
: Boolean; // true: draw horizontal line
399 procedure setText (const atext
: AnsiString);
402 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
404 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
406 procedure drawControl (gx
, gy
: Integer); override;
409 property text: AnsiString read mText write setText
;
410 property halign
: Integer read mHAlign write mHAlign
;
411 property valign
: Integer read mVAlign write mVAlign
;
412 property header
: Boolean read mHeader write mHeader
;
413 property line
: Boolean read mLine write mLine
;
416 // ////////////////////////////////////////////////////////////////////// //
417 TUITextLabel
= class(TUIControl
)
420 mHAlign
: Integer; // -1: left; 0: center; 1: right; default: left
421 mVAlign
: Integer; // -1: top; 0: center; 1: bottom; default: center
423 mHotOfs
: Integer; // from text start, in pixels
424 mHotColor
: array[0..ClrIdxMax
] of TGxRGBA
;
425 mLinkId
: AnsiString; // linked control
428 procedure cacheStyle (root
: TUIStyle
); override;
430 procedure setText (const s
: AnsiString); virtual;
433 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
435 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
437 procedure doAction (); 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;
464 // ////////////////////////////////////////////////////////////////////// //
465 TUISwitchBox
= class(TUITextLabel
)
469 mIcon
: TGxContext
.TMarkIcon
;
470 mSwitchColor
: array[0..ClrIdxMax
] of TGxRGBA
;
473 procedure cacheStyle (root
: TUIStyle
); override;
475 procedure setText (const s
: AnsiString); override;
477 function getChecked (): Boolean; virtual;
478 procedure setChecked (v
: Boolean); virtual; abstract;
481 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
483 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
485 procedure drawControl (gx
, gy
: Integer); override;
487 procedure mouseEvent (var ev
: THMouseEvent
); override;
488 procedure keyEvent (var ev
: THKeyEvent
); override;
490 procedure setVar (pvar
: PBoolean);
493 property checked
: Boolean read getChecked write setChecked
;
496 TUICheckBox
= class(TUISwitchBox
)
498 procedure setChecked (v
: Boolean); override;
501 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
503 procedure doAction (); override;
506 TUIRadioBox
= class(TUISwitchBox
)
508 mRadioGroup
: AnsiString;
511 procedure setChecked (v
: Boolean); override;
514 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
516 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
518 procedure doAction (); override;
521 property radioGroup
: AnsiString read mRadioGroup write mRadioGroup
; //FIXME
525 // ////////////////////////////////////////////////////////////////////////// //
526 procedure uiMouseEvent (var evt
: THMouseEvent
);
527 procedure uiKeyEvent (var evt
: THKeyEvent
);
531 // ////////////////////////////////////////////////////////////////////////// //
532 procedure uiAddWindow (ctl
: TUIControl
);
533 procedure uiRemoveWindow (ctl
: TUIControl
); // will free window if `mFreeOnClose` is `true`
534 function uiVisibleWindow (ctl
: TUIControl
): Boolean;
536 procedure uiUpdateStyles ();
539 // ////////////////////////////////////////////////////////////////////////// //
541 procedure uiLayoutCtl (ctl
: TUIControl
);
544 // ////////////////////////////////////////////////////////////////////////// //
546 fuiRenderScale
: Single = 1.0;
547 uiContext
: TGxContext
= nil;
557 // ////////////////////////////////////////////////////////////////////////// //
559 ctlsToKill
: array of TUIControl
= nil;
562 procedure scheduleKill (ctl
: TUIControl
);
566 if (ctl
= nil) then exit
;
568 for f
:= 0 to High(ctlsToKill
) do
570 if (ctlsToKill
[f
] = ctl
) then exit
;
571 if (ctlsToKill
[f
] = nil) then begin ctlsToKill
[f
] := ctl
; exit
; end;
573 SetLength(ctlsToKill
, Length(ctlsToKill
)+1);
574 ctlsToKill
[High(ctlsToKill
)] := ctl
;
578 procedure processKills ();
583 for f
:= 0 to High(ctlsToKill
) do
585 ctl
:= ctlsToKill
[f
];
586 if (ctl
= nil) then break
;
587 ctlsToKill
[f
] := nil;
590 if (Length(ctlsToKill
) > 0) then ctlsToKill
[0] := nil; // just in case
594 // ////////////////////////////////////////////////////////////////////////// //
596 knownCtlClasses
: array of record
597 klass
: TUIControlClass
;
602 procedure registerCtlClass (aklass
: TUIControlClass
; const aname
: AnsiString);
604 assert(aklass
<> nil);
605 assert(Length(aname
) > 0);
606 SetLength(knownCtlClasses
, Length(knownCtlClasses
)+1);
607 knownCtlClasses
[High(knownCtlClasses
)].klass
:= aklass
;
608 knownCtlClasses
[High(knownCtlClasses
)].name
:= aname
;
612 function findCtlClass (const aname
: AnsiString): TUIControlClass
;
616 for f
:= 0 to High(knownCtlClasses
) do
618 if (strEquCI1251(aname
, knownCtlClasses
[f
].name
)) then
620 result
:= knownCtlClasses
[f
].klass
;
628 // ////////////////////////////////////////////////////////////////////////// //
630 TFlexLayouter
= specialize TFlexLayouterBase
<TUIControl
>;
632 procedure uiLayoutCtl (ctl
: TUIControl
);
636 if (ctl
= nil) then exit
;
637 lay
:= TFlexLayouter
.Create();
639 if (ctl
is TUITopWindow
) and (TUITopWindow(ctl
).fitToScreen
) then TUITopWindow(ctl
).flFitToScreen();
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
/fuiRenderScale
);
710 ev
.y
:= trunc(ev
.y
/fuiRenderScale
);
711 ev
.dx
:= trunc(ev
.dx
/fuiRenderScale
); //FIXME
712 ev
.dy
:= trunc(ev
.dy
/fuiRenderScale
); //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
/fuiRenderScale
);
758 ev
.y
:= trunc(ev
.y
/fuiRenderScale
);
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 //if (uiContext = nil) then uiContext := TGxContext.Create();
776 gxSetContext(uiContext
, fuiRenderScale
);
777 uiContext
.resetClip();
779 for f
:= 0 to High(uiTopList
) do
783 if (f
<> High(uiTopList
)) then
785 cidx
:= ctl
.getColorIndex
;
786 uiContext
.darkenRect(ctl
.x0
, ctl
.y0
, ctl
.width
, ctl
.height
, ctl
.mDarken
[cidx
]);
795 procedure uiAddWindow (ctl
: TUIControl
);
799 if (ctl
= nil) then exit
;
801 if not (ctl
is TUITopWindow
) then exit
; // alas
802 for f
:= 0 to High(uiTopList
) do
804 if (uiTopList
[f
] = ctl
) then
806 if (f
<> High(uiTopList
)) then
808 uiTopList
[High(uiTopList
)].blurred();
809 for c
:= f
+1 to High(uiTopList
) do uiTopList
[c
-1] := uiTopList
[c
];
810 uiTopList
[High(uiTopList
)] := ctl
;
816 if (Length(uiTopList
) > 0) then uiTopList
[High(uiTopList
)].blurred();
817 SetLength(uiTopList
, Length(uiTopList
)+1);
818 uiTopList
[High(uiTopList
)] := ctl
;
824 procedure uiRemoveWindow (ctl
: TUIControl
);
828 if (ctl
= nil) then exit
;
830 if not (ctl
is TUITopWindow
) then exit
; // alas
831 for f
:= 0 to High(uiTopList
) do
833 if (uiTopList
[f
] = ctl
) then
836 for c
:= f
+1 to High(uiTopList
) do uiTopList
[c
-1] := uiTopList
[c
];
837 SetLength(uiTopList
, Length(uiTopList
)-1);
838 if (ctl
is TUITopWindow
) then
841 if assigned(TUITopWindow(ctl
).closeCB
) then TUITopWindow(ctl
).closeCB(ctl
);
843 if (TUITopWindow(ctl
).mFreeOnClose
) then scheduleKill(ctl
);
852 function uiVisibleWindow (ctl
: TUIControl
): Boolean;
857 if (ctl
= nil) then exit
;
859 if not (ctl
is TUITopWindow
) then exit
; // alas
860 for f
:= 0 to High(uiTopList
) do
862 if (uiTopList
[f
] = ctl
) then begin result
:= true; exit
; end;
867 // ////////////////////////////////////////////////////////////////////////// //
868 constructor TUIControl
.Create ();
873 procedure TUIControl
.AfterConstruction ();
881 mHeight
:= uiContext
.charHeight(' ');
889 mDrawShadow
:= false;
891 // layouter interface
892 //mDefSize := TLaySize.Create(64, uiContext.charHeight(' ')); // default size
893 mDefSize
:= TLaySize
.Create(0, 0); // default size
894 mMaxSize
:= TLaySize
.Create(-1, -1); // maximum size
895 mPadding
:= TLaySize
.Create(0, 0);
905 mAlign
:= -1; // left/top
910 destructor TUIControl
.Destroy ();
914 if (mParent
<> nil) then
917 for f
:= 0 to High(mParent
.mChildren
) do
919 if (mParent
.mChildren
[f
] = self
) then
921 for c
:= f
+1 to High(mParent
.mChildren
) do mParent
.mChildren
[c
-1] := mParent
.mChildren
[c
];
922 SetLength(mParent
.mChildren
, Length(mParent
.mChildren
)-1);
926 for f
:= 0 to High(mChildren
) do
928 mChildren
[f
].mParent
:= nil;
935 function TUIControl
.getColorIndex (): Integer; inline;
937 if (not enabled
) then begin result
:= ClrIdxDisabled
; exit
; end;
938 // top windows: no focus hack
939 if (self
is TUITopWindow
) then
941 if (getActive
) then begin result
:= ClrIdxActive
; exit
; end;
945 // if control cannot be focused, take "active" color scheme for it (it is easier this way)
946 if (not canFocus
) or (getActive
) then begin result
:= ClrIdxActive
; exit
; end;
948 result
:= ClrIdxInactive
;
951 procedure TUIControl
.updateStyle ();
957 while (ctl
<> nil) do
959 if (Length(ctl
.mStyleId
) <> 0) then begin stl
:= uiFindStyle(ctl
.mStyleId
); break
; end;
962 if (stl
= nil) then stl
:= uiFindStyle(''); // default
964 for ctl
in mChildren
do ctl
.updateStyle();
967 procedure TUIControl
.cacheStyle (root
: TUIStyle
);
971 //writeln('caching style for <', className, '> (', mCtl4Style, ')...');
974 mBackColor
[ClrIdxActive
] := root
.get('back-color', 'active', cst
).asRGBADef(TGxRGBA
.Create(0, 0, 128));
975 mTextColor
[ClrIdxActive
] := root
.get('text-color', 'active', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
976 mFrameColor
[ClrIdxActive
] := root
.get('frame-color', 'active', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
977 mFrameTextColor
[ClrIdxActive
] := root
.get('frame-text-color', 'active', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
978 mFrameIconColor
[ClrIdxActive
] := root
.get('frame-icon-color', 'active', cst
).asRGBADef(TGxRGBA
.Create(0, 255, 0));
979 mDarken
[ClrIdxActive
] := root
.get('darken', 'active', cst
).asInt(666);
981 mBackColor
[ClrIdxDisabled
] := root
.get('back-color', 'disabled', cst
).asRGBADef(TGxRGBA
.Create(0, 0, 128));
982 mTextColor
[ClrIdxDisabled
] := root
.get('text-color', 'disabled', cst
).asRGBADef(TGxRGBA
.Create(127, 127, 127));
983 mFrameColor
[ClrIdxDisabled
] := root
.get('frame-color', 'disabled', cst
).asRGBADef(TGxRGBA
.Create(127, 127, 127));
984 mFrameTextColor
[ClrIdxDisabled
] := root
.get('frame-text-color', 'disabled', cst
).asRGBADef(TGxRGBA
.Create(127, 127, 127));
985 mFrameIconColor
[ClrIdxDisabled
] := root
.get('frame-icon-color', 'disabled', cst
).asRGBADef(TGxRGBA
.Create(0, 127, 0));
986 mDarken
[ClrIdxDisabled
] := root
.get('darken', 'disabled', cst
).asInt(666);
988 mBackColor
[ClrIdxInactive
] := root
.get('back-color', 'inactive', cst
).asRGBADef(TGxRGBA
.Create(0, 0, 128));
989 mTextColor
[ClrIdxInactive
] := root
.get('text-color', 'inactive', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
990 mFrameColor
[ClrIdxInactive
] := root
.get('frame-color', 'inactive', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
991 mFrameTextColor
[ClrIdxInactive
] := root
.get('frame-text-color', 'inactive', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
992 mFrameIconColor
[ClrIdxInactive
] := root
.get('frame-icon-color', 'inactive', cst
).asRGBADef(TGxRGBA
.Create(0, 255, 0));
993 mDarken
[ClrIdxInactive
] := root
.get('darken', 'inactive', cst
).asInt(666);
997 // ////////////////////////////////////////////////////////////////////////// //
998 function TUIControl
.getDefSize (): TLaySize
; inline; begin result
:= mLayDefSize
; end;
999 function TUIControl
.getMaxSize (): TLaySize
; inline; begin result
:= mLayMaxSize
; end;
1000 function TUIControl
.getPadding (): TLaySize
; inline; begin result
:= mPadding
; end;
1001 function TUIControl
.getFlex (): Integer; inline; begin result
:= mFlex
; end;
1002 function TUIControl
.isHorizBox (): Boolean; inline; begin result
:= mHoriz
; end;
1003 function TUIControl
.canWrap (): Boolean; inline; begin result
:= mCanWrap
; end;
1004 function TUIControl
.noPad (): Boolean; inline; begin result
:= mNoPad
; end;
1005 function TUIControl
.isLineStart (): Boolean; inline; begin result
:= mLineStart
; end;
1006 function TUIControl
.getAlign (): Integer; inline; begin result
:= mAlign
; end;
1007 function TUIControl
.getExpand (): Boolean; inline; begin result
:= mExpand
; end;
1008 function TUIControl
.getHGroup (): AnsiString; inline; begin result
:= mHGroup
; end;
1009 function TUIControl
.getVGroup (): AnsiString; inline; begin result
:= mVGroup
; end;
1010 function TUIControl
.getMargins (): TLayMargins
; inline; begin result
:= TLayMargins
.Create(mFrameHeight
, mFrameWidth
, mFrameHeight
, mFrameWidth
); end;
1012 procedure TUIControl
.setActualSizePos (constref apos
: TLayPos
; constref asize
: TLaySize
); inline;
1014 //writeln(self.className, '; pos=', apos.toString, '; size=', asize.toString);
1015 if (mParent
<> nil) then
1024 procedure TUIControl
.layPrepare ();
1026 mLayDefSize
:= mDefSize
;
1027 mLayMaxSize
:= mMaxSize
;
1028 if (mLayMaxSize
.w
>= 0) then mLayMaxSize
.w
+= mFrameWidth
*2;
1029 if (mLayMaxSize
.h
>= 0) then mLayMaxSize
.h
+= mFrameHeight
*2;
1033 // ////////////////////////////////////////////////////////////////////////// //
1034 function TUIControl
.parsePos (par
: TTextParser
): TLayPos
;
1036 ech
: AnsiChar = ')';
1038 if (par
.eatDelim('[')) then ech
:= ']' else par
.expectDelim('(');
1039 result
.x
:= par
.expectInt();
1040 par
.eatDelim(','); // optional comma
1041 result
.y
:= par
.expectInt();
1042 par
.eatDelim(','); // optional comma
1043 par
.expectDelim(ech
);
1046 function TUIControl
.parseSize (par
: TTextParser
): TLaySize
;
1048 ech
: AnsiChar = ')';
1050 if (par
.eatDelim('[')) then ech
:= ']' else par
.expectDelim('(');
1051 result
.w
:= par
.expectInt();
1052 par
.eatDelim(','); // optional comma
1053 result
.h
:= par
.expectInt();
1054 par
.eatDelim(','); // optional comma
1055 par
.expectDelim(ech
);
1058 function TUIControl
.parsePadding (par
: TTextParser
): TLaySize
;
1060 result
:= parseSize(par
);
1063 function TUIControl
.parseHPadding (par
: TTextParser
; def
: Integer): TLaySize
;
1068 result
.w
:= par
.expectInt();
1072 result
:= parsePadding(par
);
1076 function TUIControl
.parseVPadding (par
: TTextParser
; def
: Integer): TLaySize
;
1081 result
.h
:= par
.expectInt();
1085 result
:= parsePadding(par
);
1089 function TUIControl
.parseBool (par
: TTextParser
): Boolean;
1092 par
.eatIdOrStrCI('true') or
1093 par
.eatIdOrStrCI('yes') or
1094 par
.eatIdOrStrCI('tan');
1097 if (not par
.eatIdOrStrCI('false')) and (not par
.eatIdOrStrCI('no')) and (not par
.eatIdOrStrCI('ona')) then
1099 par
.error('boolean value expected');
1104 function TUIControl
.parseAnyAlign (par
: TTextParser
): Integer;
1106 if (par
.eatIdOrStrCI('left')) or (par
.eatIdOrStrCI('top')) then result
:= -1
1107 else if (par
.eatIdOrStrCI('right')) or (par
.eatIdOrStrCI('bottom')) then result
:= 1
1108 else if (par
.eatIdOrStrCI('center')) then result
:= 0
1109 else par
.error('invalid align value');
1112 function TUIControl
.parseHAlign (par
: TTextParser
): Integer;
1114 if (par
.eatIdOrStrCI('left')) then result
:= -1
1115 else if (par
.eatIdOrStrCI('right')) then result
:= 1
1116 else if (par
.eatIdOrStrCI('center')) then result
:= 0
1117 else par
.error('invalid horizontal align value');
1120 function TUIControl
.parseVAlign (par
: TTextParser
): Integer;
1122 if (par
.eatIdOrStrCI('top')) then result
:= -1
1123 else if (par
.eatIdOrStrCI('bottom')) then result
:= 1
1124 else if (par
.eatIdOrStrCI('center')) then result
:= 0
1125 else par
.error('invalid vertical align value');
1128 procedure TUIControl
.parseTextAlign (par
: TTextParser
; var h
, v
: Integer);
1130 wasH
: Boolean = false;
1131 wasV
: Boolean = false;
1135 if (par
.eatIdOrStrCI('left')) then
1137 if wasH
then par
.error('too many align directives');
1142 if (par
.eatIdOrStrCI('right')) then
1144 if wasH
then par
.error('too many align directives');
1149 if (par
.eatIdOrStrCI('hcenter')) then
1151 if wasH
then par
.error('too many align directives');
1156 if (par
.eatIdOrStrCI('top')) then
1158 if wasV
then par
.error('too many align directives');
1163 if (par
.eatIdOrStrCI('bottom')) then
1165 if wasV
then par
.error('too many align directives');
1170 if (par
.eatIdOrStrCI('vcenter')) then
1172 if wasV
then par
.error('too many align directives');
1177 if (par
.eatIdOrStrCI('center')) then
1179 if wasV
or wasH
then par
.error('too many align directives');
1188 if not wasV
and not wasH
then par
.error('invalid align value');
1191 function TUIControl
.parseOrientation (const prname
: AnsiString; par
: TTextParser
): Boolean;
1193 if (strEquCI1251(prname
, 'orientation')) or (strEquCI1251(prname
, 'orient')) then
1195 if (par
.eatIdOrStrCI('horizontal')) or (par
.eatIdOrStrCI('horiz')) then mHoriz
:= true
1196 else if (par
.eatIdOrStrCI('vertical')) or (par
.eatIdOrStrCI('vert')) then mHoriz
:= false
1197 else par
.error('`horizontal` or `vertical` expected');
1206 // par should be on '{'; final '}' is eaten
1207 procedure TUIControl
.parseProperties (par
: TTextParser
);
1211 if (not par
.eatDelim('{')) then exit
;
1212 while (not par
.eatDelim('}')) do
1214 if (not par
.isIdOrStr
) then par
.error('property name expected');
1217 par
.eatDelim(':'); // optional
1218 if not parseProperty(pn
, par
) then par
.errorfmt('invalid property name ''%s''', [pn
]);
1219 par
.eatDelim(','); // optional
1223 // par should be on '{'
1224 procedure TUIControl
.parseChildren (par
: TTextParser
);
1226 cc
: TUIControlClass
;
1229 par
.expectDelim('{');
1230 while (not par
.eatDelim('}')) do
1232 if (not par
.isIdOrStr
) then par
.error('control name expected');
1233 cc
:= findCtlClass(par
.tokStr
);
1234 if (cc
= nil) then par
.errorfmt('unknown control name: ''%s''', [par
.tokStr
]);
1235 //writeln('children for <', par.tokStr, '>: <', cc.className, '>');
1237 par
.eatDelim(':'); // optional
1239 //writeln(' mHoriz=', ctl.mHoriz);
1241 ctl
.parseProperties(par
);
1246 //writeln(': ', ctl.mDefSize.toString);
1248 par
.eatDelim(','); // optional
1253 function TUIControl
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
1256 if (strEquCI1251(prname
, 'id')) then begin mId
:= par
.expectIdOrStr(true); exit
; end; // allow empty strings
1257 if (strEquCI1251(prname
, 'style')) then begin mStyleId
:= par
.expectIdOrStr(); exit
; end; // no empty strings
1258 if (strEquCI1251(prname
, 'flex')) then begin flex
:= par
.expectInt(); exit
; end;
1260 if (strEquCI1251(prname
, 'defsize')) or (strEquCI1251(prname
, 'size')) then begin mDefSize
:= parseSize(par
); exit
; end;
1261 if (strEquCI1251(prname
, 'maxsize')) then begin mMaxSize
:= parseSize(par
); exit
; end;
1262 if (strEquCI1251(prname
, 'defwidth')) or (strEquCI1251(prname
, 'width')) then begin mDefSize
.w
:= par
.expectInt(); exit
; end;
1263 if (strEquCI1251(prname
, 'defheight')) or (strEquCI1251(prname
, 'height')) then begin mDefSize
.h
:= par
.expectInt(); exit
; end;
1264 if (strEquCI1251(prname
, 'maxwidth')) then begin mMaxSize
.w
:= par
.expectInt(); exit
; end;
1265 if (strEquCI1251(prname
, 'maxheight')) then begin mMaxSize
.h
:= par
.expectInt(); exit
; end;
1267 if (strEquCI1251(prname
, 'padding')) then begin mPadding
:= parsePadding(par
); exit
; end;
1268 if (strEquCI1251(prname
, 'nopad')) then begin mNoPad
:= true; exit
; end;
1270 if (strEquCI1251(prname
, 'wrap')) then begin mCanWrap
:= parseBool(par
); exit
; end;
1271 if (strEquCI1251(prname
, 'linestart')) then begin mLineStart
:= parseBool(par
); exit
; end;
1272 if (strEquCI1251(prname
, 'expand')) then begin mExpand
:= parseBool(par
); exit
; end;
1274 if (strEquCI1251(prname
, 'align')) then begin mAlign
:= parseAnyAlign(par
); exit
; end;
1275 if (strEquCI1251(prname
, 'hgroup')) then begin mHGroup
:= par
.expectIdOrStr(true); exit
; end; // allow empty strings
1276 if (strEquCI1251(prname
, 'vgroup')) then begin mVGroup
:= par
.expectIdOrStr(true); exit
; end; // allow empty strings
1278 if (strEquCI1251(prname
, 'canfocus')) then begin mCanFocus
:= true; exit
; end;
1279 if (strEquCI1251(prname
, 'nofocus')) then begin mCanFocus
:= false; exit
; end;
1280 if (strEquCI1251(prname
, 'disabled')) then begin mEnabled
:= false; exit
; end;
1281 if (strEquCI1251(prname
, 'enabled')) then begin mEnabled
:= true; exit
; end;
1282 if (strEquCI1251(prname
, 'escclose')) then begin mEscClose
:= not parseBool(par
); exit
; end;
1283 if (strEquCI1251(prname
, 'default')) then begin mDefault
:= true; exit
; end;
1284 if (strEquCI1251(prname
, 'cancel')) then begin mCancel
:= true; exit
; end;
1289 // ////////////////////////////////////////////////////////////////////////// //
1290 procedure TUIControl
.activated ();
1292 makeVisibleInParent();
1296 procedure TUIControl
.blurred ();
1298 if (uiGrabCtl
= self
) then uiGrabCtl
:= nil;
1302 procedure TUIControl
.calcFullClientSize ();
1306 mFullSize
:= TLaySize
.Create(0, 0);
1307 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1308 for ctl
in mChildren
do
1310 ctl
.calcFullClientSize();
1311 mFullSize
.w
:= nmax(mFullSize
.w
, ctl
.mX
-mFrameWidth
+ctl
.mFullSize
.w
);
1312 mFullSize
.h
:= nmax(mFullSize
.h
, ctl
.mY
-mFrameHeight
+ctl
.mFullSize
.h
);
1314 mFullSize
.w
:= nmax(mFullSize
.w
, mWidth
-mFrameWidth
*2);
1315 mFullSize
.h
:= nmax(mFullSize
.h
, mHeight
-mFrameHeight
*2);
1319 function TUIControl
.topLevel (): TUIControl
; inline;
1322 while (result
.mParent
<> nil) do result
:= result
.mParent
;
1326 function TUIControl
.getEnabled (): Boolean;
1331 if (not mEnabled
) then exit
;
1333 while (ctl
<> nil) do
1335 if (not ctl
.mEnabled
) then exit
;
1342 procedure TUIControl
.setEnabled (v
: Boolean); inline;
1344 if (mEnabled
= v
) then exit
;
1346 if (not v
) and focused
then setFocused(false);
1350 function TUIControl
.getFocused (): Boolean; inline;
1352 if (mParent
= nil) then
1354 result
:= (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)] = self
);
1358 result
:= (topLevel
.mFocused
= self
);
1359 if (result
) then result
:= (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)] = topLevel
);
1364 function TUIControl
.getActive (): Boolean; inline;
1368 if (mParent
= nil) then
1370 result
:= (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)] = self
);
1374 ctl
:= topLevel
.mFocused
;
1375 while (ctl
<> nil) and (ctl
<> self
) do ctl
:= ctl
.mParent
;
1376 result
:= (ctl
= self
);
1377 if (result
) then result
:= (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)] = topLevel
);
1382 procedure TUIControl
.setFocused (v
: Boolean); inline;
1389 if (tl
.mFocused
= self
) then
1391 blurred(); // this will reset grab, but still...
1392 if (uiGrabCtl
= self
) then uiGrabCtl
:= nil;
1393 tl
.mFocused
:= tl
.findNextFocus(self
, true);
1394 if (tl
.mFocused
= self
) then tl
.mFocused
:= nil;
1395 if (tl
.mFocused
<> nil) then tl
.mFocused
.activated();
1399 if (not canFocus
) then exit
;
1400 if (tl
.mFocused
<> self
) then
1402 if (tl
.mFocused
<> nil) then tl
.mFocused
.blurred();
1403 tl
.mFocused
:= self
;
1404 if (uiGrabCtl
<> self
) then uiGrabCtl
:= nil;
1410 function TUIControl
.getCanFocus (): Boolean; inline;
1412 result
:= (getEnabled
) and (mCanFocus
) and (mWidth
> 0) and (mHeight
> 0);
1416 function TUIControl
.isMyChild (ctl
: TUIControl
): Boolean;
1419 while (ctl
<> nil) do
1421 if (ctl
.mParent
= self
) then exit
;
1428 // returns `true` if global coords are inside this control
1429 function TUIControl
.toLocal (var x
, y
: Integer): Boolean;
1431 if (mParent
= nil) then
1435 result
:= true; // hack
1439 result
:= mParent
.toLocal(x
, y
);
1440 Inc(x
, mParent
.mScrollX
);
1441 Inc(y
, mParent
.mScrollY
);
1444 if result
then result
:= (x
>= 0) and (y
>= 0) and (x
< mParent
.mWidth
) and (y
< mParent
.mHeight
);
1446 if result
then result
:= (x
>= 0) and (y
>= 0) and (x
< mWidth
) and (y
< mHeight
);
1449 function TUIControl
.toLocal (gx
, gy
: Integer; out x
, y
: Integer): Boolean; inline;
1453 result
:= toLocal(x
, y
);
1457 procedure TUIControl
.toGlobal (var x
, y
: Integer);
1461 if (mParent
<> nil) then
1463 Dec(x
, mParent
.mScrollX
);
1464 Dec(y
, mParent
.mScrollY
);
1465 mParent
.toGlobal(x
, y
);
1469 procedure TUIControl
.toGlobal (lx
, ly
: Integer; out x
, y
: Integer); inline;
1476 procedure TUIControl
.getDrawRect (out gx
, gy
, wdt
, hgt
: Integer);
1480 if (mParent
= nil) then
1489 toGlobal(0, 0, cgx
, cgy
);
1490 mParent
.getDrawRect(gx
, gy
, wdt
, hgt
);
1491 if (wdt
> 0) and (hgt
> 0) then
1493 if not intersectRect(gx
, gy
, wdt
, hgt
, cgx
, cgy
, mWidth
, mHeight
) then
1503 // x and y are global coords
1504 function TUIControl
.controlAtXY (x
, y
: Integer; allowDisabled
: Boolean=false): TUIControl
;
1510 if (not allowDisabled
) and (not enabled
) then exit
;
1511 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1512 if not toLocal(x
, y
, lx
, ly
) then exit
;
1513 for f
:= High(mChildren
) downto 0 do
1515 result
:= mChildren
[f
].controlAtXY(x
, y
, allowDisabled
);
1516 if (result
<> nil) then exit
;
1522 function TUIControl
.parentScrollX (): Integer; inline; begin if (mParent
<> nil) then result
:= mParent
.mScrollX
else result
:= 0; end;
1523 function TUIControl
.parentScrollY (): Integer; inline; begin if (mParent
<> nil) then result
:= mParent
.mScrollY
else result
:= 0; end;
1526 procedure TUIControl
.makeVisibleInParent ();
1528 sy
, ey
, cy
: Integer;
1531 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1533 if (p
= nil) then exit
;
1534 if (p
.mFullSize
.w
< 1) or (p
.mFullSize
.h
< 1) then
1540 p
.makeVisibleInParent();
1541 cy
:= mY
-p
.mFrameHeight
;
1543 ey
:= sy
+(p
.mHeight
-p
.mFrameHeight
*2);
1546 p
.mScrollY
:= nmax(0, cy
);
1548 else if (cy
+mHeight
> ey
) then
1550 p
.mScrollY
:= nmax(0, cy
+mHeight
-(p
.mHeight
-p
.mFrameHeight
*2));
1555 // ////////////////////////////////////////////////////////////////////////// //
1556 function TUIControl
.prevSibling (): TUIControl
;
1560 if (mParent
<> nil) then
1562 for f
:= 1 to High(mParent
.mChildren
) do
1564 if (mParent
.mChildren
[f
] = self
) then begin result
:= mParent
.mChildren
[f
-1]; exit
; end;
1570 function TUIControl
.nextSibling (): TUIControl
;
1574 if (mParent
<> nil) then
1576 for f
:= 0 to High(mParent
.mChildren
)-1 do
1578 if (mParent
.mChildren
[f
] = self
) then begin result
:= mParent
.mChildren
[f
+1]; exit
; end;
1584 function TUIControl
.firstChild (): TUIControl
; inline;
1586 if (Length(mChildren
) <> 0) then result
:= mChildren
[0] else result
:= nil;
1589 function TUIControl
.lastChild (): TUIControl
; inline;
1591 if (Length(mChildren
) <> 0) then result
:= mChildren
[High(mChildren
)] else result
:= nil;
1595 function TUIControl
.findFirstFocus (): TUIControl
;
1602 for f
:= 0 to High(mChildren
) do
1604 result
:= mChildren
[f
].findFirstFocus();
1605 if (result
<> nil) then exit
;
1607 if (canFocus
) then result
:= self
;
1612 function TUIControl
.findLastFocus (): TUIControl
;
1619 for f
:= High(mChildren
) downto 0 do
1621 result
:= mChildren
[f
].findLastFocus();
1622 if (result
<> nil) then exit
;
1624 if (canFocus
) then result
:= self
;
1629 function TUIControl
.findNextFocus (cur
: TUIControl
; wrap
: Boolean): TUIControl
;
1631 curHit
: Boolean = false;
1633 function checkFocus (ctl
: TUIControl
): Boolean;
1637 result
:= (ctl
.canFocus
);
1641 curHit
:= (ctl
= cur
);
1642 result
:= false; // don't stop
1650 if not isMyChild(cur
) then
1652 result
:= findFirstFocus();
1656 result
:= forEachControl(checkFocus
);
1657 if (result
= nil) and (wrap
) then result
:= findFirstFocus();
1663 function TUIControl
.findPrevFocus (cur
: TUIControl
; wrap
: Boolean): TUIControl
;
1665 lastCtl
: TUIControl
= nil;
1667 function checkFocus (ctl
: TUIControl
): Boolean;
1676 if (ctl
.canFocus
) then lastCtl
:= ctl
;
1684 if not isMyChild(cur
) then
1686 result
:= findLastFocus();
1690 forEachControl(checkFocus
);
1691 if (lastCtl
= nil) and (wrap
) then lastCtl
:= findLastFocus();
1693 //if (lastCtl <> nil) then writeln('ctl<', lastCtl.className, '>: {', lastCtl.id, '}');
1699 function TUIControl
.findDefaulControl (): TUIControl
;
1705 if (mDefault
) then begin result
:= self
; exit
; end;
1706 for ctl
in mChildren
do
1708 result
:= ctl
.findDefaulControl();
1709 if (result
<> nil) then exit
;
1715 function TUIControl
.findCancelControl (): TUIControl
;
1721 if (mCancel
) then begin result
:= self
; exit
; end;
1722 for ctl
in mChildren
do
1724 result
:= ctl
.findCancelControl();
1725 if (result
<> nil) then exit
;
1732 function TUIControl
.findControlById (const aid
: AnsiString): TUIControl
;
1736 if (strEquCI1251(aid
, mId
)) then begin result
:= self
; exit
; end;
1737 for ctl
in mChildren
do
1739 result
:= ctl
.findControlById(aid
);
1740 if (result
<> nil) then exit
;
1746 procedure TUIControl
.appendChild (ctl
: TUIControl
);
1748 if (ctl
= nil) then exit
;
1749 if (ctl
.mParent
<> nil) then exit
;
1750 SetLength(mChildren
, Length(mChildren
)+1);
1751 mChildren
[High(mChildren
)] := ctl
;
1752 ctl
.mParent
:= self
;
1753 Inc(ctl
.mX
, mFrameWidth
);
1754 Inc(ctl
.mY
, mFrameHeight
);
1755 if (ctl
.mWidth
> 0) and (ctl
.mHeight
> 0) and
1756 (ctl
.mX
+ctl
.mWidth
> mFrameWidth
) and (ctl
.mY
+ctl
.mHeight
> mFrameHeight
) then
1758 if (mWidth
+mFrameWidth
< ctl
.mX
+ctl
.mWidth
) then mWidth
:= ctl
.mX
+ctl
.mWidth
+mFrameWidth
;
1759 if (mHeight
+mFrameHeight
< ctl
.mY
+ctl
.mHeight
) then mHeight
:= ctl
.mY
+ctl
.mHeight
+mFrameHeight
;
1764 function TUIControl
.setActionCBFor (const aid
: AnsiString; cb
: TActionCB
): TActionCB
;
1769 if (ctl
<> nil) then
1771 result
:= ctl
.actionCB
;
1781 function TUIControl
.forEachChildren (cb
: TCtlEnumCB
): TUIControl
;
1786 if (not assigned(cb
)) then exit
;
1787 for ctl
in mChildren
do
1789 if cb(ctl
) then begin result
:= ctl
; exit
; end;
1794 function TUIControl
.forEachControl (cb
: TCtlEnumCB
; includeSelf
: Boolean=true): TUIControl
;
1796 function forChildren (p
: TUIControl
; incSelf
: Boolean): TUIControl
;
1801 if (p
= nil) then exit
;
1802 if (incSelf
) and (cb(p
)) then begin result
:= p
; exit
; end;
1803 for ctl
in p
.mChildren
do
1805 result
:= forChildren(ctl
, true);
1806 if (result
<> nil) then break
;
1812 if (not assigned(cb
)) then exit
;
1813 result
:= forChildren(self
, includeSelf
);
1817 procedure TUIControl
.close (); // this closes *top-level* control
1822 uiRemoveWindow(ctl
);
1823 if (ctl
is TUITopWindow
) and (TUITopWindow(ctl
).mFreeOnClose
) then scheduleKill(ctl
); // just in case
1827 procedure TUIControl
.doAction ();
1829 if assigned(actionCB
) then actionCB(self
);
1833 // ////////////////////////////////////////////////////////////////////////// //
1834 procedure TUIControl
.setScissor (lx
, ly
, lw
, lh
: Integer);
1836 gx
, gy
, wdt
, hgt
, cgx
, cgy
: Integer;
1838 if (not intersectRect(lx
, ly
, lw
, lh
, 0, 0, mWidth
, mHeight
)) then
1840 uiContext
.clip
:= TGxRect
.Create(0, 0, 0, 0);
1844 getDrawRect(gx
, gy
, wdt
, hgt
);
1846 toGlobal(lx
, ly
, cgx
, cgy
);
1847 if (not intersectRect(gx
, gy
, wdt
, hgt
, cgx
, cgy
, lw
, lh
)) then
1849 uiContext
.clip
:= TGxRect
.Create(0, 0, 0, 0);
1853 uiContext
.clip
:= savedClip
;
1854 uiContext
.combineClip(TGxRect
.Create(gx
, gy
, wdt
, hgt
));
1855 //uiContext.clip := TGxRect.Create(gx, gy, wdt, hgt);
1860 // ////////////////////////////////////////////////////////////////////////// //
1861 procedure TUIControl
.draw ();
1866 procedure resetScissor (fullArea
: Boolean); inline;
1868 uiContext
.clip
:= savedClip
;
1871 setScissor(0, 0, mWidth
, mHeight
);
1875 setScissor(mFrameWidth
, mFrameHeight
, mWidth
-mFrameWidth
*2, mHeight
-mFrameHeight
*2);
1880 if (mWidth
< 1) or (mHeight
< 1) or (uiContext
= nil) or (not uiContext
.active
) then exit
;
1881 toGlobal(0, 0, gx
, gy
);
1883 savedClip
:= uiContext
.clip
;
1885 resetScissor(true); // full area
1886 drawControl(gx
, gy
);
1887 resetScissor(false); // client area
1888 for f
:= 0 to High(mChildren
) do mChildren
[f
].draw();
1889 resetScissor(true); // full area
1890 drawControlPost(gx
, gy
);
1892 uiContext
.clip
:= savedClip
;
1896 procedure TUIControl
.drawControl (gx
, gy
: Integer);
1898 //if (mParent = nil) then darkenRect(gx, gy, mWidth, mHeight, 64);
1901 procedure TUIControl
.drawControlPost (gx
, gy
: Integer);
1904 if (mParent
= nil) and (mDrawShadow
) and (mWidth
> 0) and (mHeight
> 0) then
1906 //setScissorGLInternal(gx+8, gy+8, mWidth, mHeight);
1907 uiContext
.resetClip();
1908 uiContext
.darkenRect(gx
+mWidth
, gy
+8, 8, mHeight
, 128);
1909 uiContext
.darkenRect(gx
+8, gy
+mHeight
, mWidth
-8, 8, 128);
1914 // ////////////////////////////////////////////////////////////////////////// //
1915 procedure TUIControl
.mouseEvent (var ev
: THMouseEvent
);
1919 if (not enabled
) then exit
;
1920 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1921 ctl
:= controlAtXY(ev
.x
, ev
.y
);
1922 if (ctl
= nil) then exit
;
1923 if (ctl
.canFocus
) and (ev
.press
) then
1925 if (ctl
<> topLevel
.mFocused
) then ctl
.setFocused(true);
1928 if (ctl
<> self
) then ctl
.mouseEvent(ev
);
1933 procedure TUIControl
.keyEvent (var ev
: THKeyEvent
);
1935 function doPreKey (ctl
: TUIControl
): Boolean;
1937 if (not ctl
.enabled
) then begin result
:= false; exit
; end;
1938 ctl
.keyEventPre(ev
);
1939 result
:= (ev
.eaten
) or (ev
.cancelled
); // stop if event was consumed
1942 function doPostKey (ctl
: TUIControl
): Boolean;
1944 if (not ctl
.enabled
) then begin result
:= false; exit
; end;
1945 ctl
.keyEventPost(ev
);
1946 result
:= (ev
.eaten
) or (ev
.cancelled
); // stop if event was consumed
1952 if (not enabled
) then exit
;
1953 if (ev
.eaten
) or (ev
.cancelled
) then exit
;
1955 if (mParent
= nil) then
1957 forEachControl(doPreKey
);
1958 if (ev
.eaten
) or (ev
.cancelled
) then exit
;
1960 // focused control should process keyboard first
1961 if (topLevel
.mFocused
<> self
) and isMyChild(topLevel
.mFocused
) and (topLevel
.mFocused
.enabled
) then
1963 // bubble keyboard event
1964 ctl
:= topLevel
.mFocused
;
1965 while (ctl
<> nil) and (ctl
<> self
) do
1968 if (ev
.eaten
) or (ev
.cancelled
) then exit
;
1972 // for top-level controls
1973 if (mParent
= nil) then
1975 if (ev
= 'S-Tab') then
1977 ctl
:= findPrevFocus(mFocused
, true);
1978 if (ctl
<> nil) and (ctl
<> mFocused
) then ctl
.setFocused(true);
1982 if (ev
= 'Tab') then
1984 ctl
:= findNextFocus(mFocused
, true);
1985 if (ctl
<> nil) and (ctl
<> mFocused
) then ctl
.setFocused(true);
1989 if (ev
= 'Enter') or (ev
= 'C-Enter') then
1991 ctl
:= findDefaulControl();
1992 if (ctl
<> nil) then
1999 if (ev
= 'Escape') then
2001 ctl
:= findCancelControl();
2002 if (ctl
<> nil) then
2009 if mEscClose
and (ev
= 'Escape') then
2011 if (not assigned(closeRequestCB
)) or (closeRequestCB(self
)) then
2013 uiRemoveWindow(self
);
2019 if (ev
.eaten
) or (ev
.cancelled
) then exit
;
2020 forEachControl(doPostKey
);
2025 procedure TUIControl
.keyEventPre (var ev
: THKeyEvent
);
2030 procedure TUIControl
.keyEventPost (var ev
: THKeyEvent
);
2035 // ////////////////////////////////////////////////////////////////////////// //
2036 constructor TUITopWindow
.Create (const atitle
: AnsiString);
2043 procedure TUITopWindow
.AfterConstruction ();
2046 mFitToScreen
:= true;
2049 if (mWidth
< mFrameWidth
*2+uiContext
.iconWinWidth(TGxContext
.TWinIcon
.Close
)) then mWidth
:= mFrameWidth
*2+uiContext
.iconWinWidth(TGxContext
.TWinIcon
.Close
);
2050 if (mHeight
< mFrameHeight
*2) then mHeight
:= mFrameHeight
*2;
2051 if (Length(mTitle
) > 0) then
2053 if (mWidth
< uiContext
.textWidth(mTitle
)+mFrameWidth
*2+uiContext
.iconWinWidth(TGxContext
.TWinIcon
.Close
)) then
2055 mWidth
:= uiContext
.textWidth(mTitle
)+mFrameWidth
*2+uiContext
.iconWinWidth(TGxContext
.TWinIcon
.Close
);
2059 mDragScroll
:= TXMode
.None
;
2060 mDrawShadow
:= true;
2061 mWaitingClose
:= false;
2064 mCtl4Style
:= 'window';
2068 function TUITopWindow
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2070 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) then
2072 mTitle
:= par
.expectIdOrStr(true);
2076 if (strEquCI1251(prname
, 'children')) then
2082 if (strEquCI1251(prname
, 'position')) then
2084 if (par
.eatIdOrStrCI('default')) then mDoCenter
:= false
2085 else if (par
.eatIdOrStrCI('center')) then mDoCenter
:= true
2086 else par
.error('`center` or `default` expected');
2090 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
2091 result
:= inherited parseProperty(prname
, par
);
2095 procedure TUITopWindow
.flFitToScreen ();
2099 nsz
:= TLaySize
.Create(trunc(fuiScrWdt
/fuiRenderScale
)-mFrameWidth
*2-6, trunc(fuiScrHgt
/fuiRenderScale
)-mFrameHeight
*2-6);
2100 if (mMaxSize
.w
< 1) then mMaxSize
.w
:= nsz
.w
;
2101 if (mMaxSize
.h
< 1) then mMaxSize
.h
:= nsz
.h
;
2105 procedure TUITopWindow
.centerInScreen ();
2107 if (mWidth
> 0) and (mHeight
> 0) then
2109 mX
:= trunc((fuiScrWdt
/fuiRenderScale
-mWidth
)/2);
2110 mY
:= trunc((fuiScrHgt
/fuiRenderScale
-mHeight
)/2);
2115 procedure TUITopWindow
.drawControl (gx
, gy
: Integer);
2117 uiContext
.color
:= mBackColor
[getColorIndex
];
2118 uiContext
.fillRect(gx
, gy
, mWidth
, mHeight
);
2122 procedure TUITopWindow
.drawControlPost (gx
, gy
: Integer);
2125 tx
, hgt
, sbhgt
, iwdt
: Integer;
2127 cidx
:= getColorIndex
;
2128 if (mDragScroll
= TXMode
.Drag
) then
2130 uiContext
.color
:= mFrameColor
[cidx
];
2131 uiContext
.rect(gx
+4, gy
+4, mWidth
-8, mHeight
-8);
2135 uiContext
.color
:= mFrameColor
[cidx
];
2136 uiContext
.rect(gx
+3, gy
+3, mWidth
-6, mHeight
-6);
2137 uiContext
.rect(gx
+5, gy
+5, mWidth
-10, mHeight
-10);
2138 // vertical scroll bar
2139 hgt
:= mHeight
-mFrameHeight
*2;
2140 if (hgt
> 0) and (mFullSize
.h
> hgt
) then
2142 //writeln(mTitle, ': height=', mHeight-mFrameHeight*2, '; fullsize=', mFullSize.toString);
2143 sbhgt
:= mHeight
-mFrameHeight
*2+2;
2144 uiContext
.fillRect(gx
+mWidth
-mFrameWidth
+1, gy
+7, mFrameWidth
-3, sbhgt
);
2146 if (hgt
> mFullSize
.h
) then hgt
:= mFullSize
.h
;
2147 hgt
:= sbhgt
*hgt
div mFullSize
.h
;
2150 setScissor(mWidth
-mFrameWidth
+1, 7, mFrameWidth
-3, sbhgt
);
2151 uiContext
.darkenRect(gx
+mWidth
-mFrameWidth
+1, gy
+7+hgt
, mFrameWidth
-3, sbhgt
, 128);
2155 iwdt
:= uiContext
.iconWinWidth(TGxContext
.TWinIcon
.Close
);
2156 setScissor(mFrameWidth
, 0, iwdt
, 8);
2157 uiContext
.color
:= mBackColor
[cidx
];
2158 uiContext
.fillRect(gx
+mFrameWidth
, gy
, iwdt
, 8);
2159 uiContext
.color
:= mFrameIconColor
[cidx
];
2160 uiContext
.drawIconWin(TGxContext
.TWinIcon
.Close
, gx
+mFrameWidth
, gy
, mInClose
);
2163 if (Length(mTitle
) > 0) then
2165 iwdt
:= uiContext
.iconWinWidth(TGxContext
.TWinIcon
.Close
);
2166 setScissor(mFrameWidth
+iwdt
, 0, mWidth
-mFrameWidth
*2-iwdt
, 8);
2167 tx
:= (gx
+iwdt
)+((mWidth
-iwdt
)-uiContext
.textWidth(mTitle
)) div 2;
2168 uiContext
.color
:= mBackColor
[cidx
];
2169 uiContext
.fillRect(tx
-3, gy
, uiContext
.textWidth(mTitle
)+3+2, 8);
2170 uiContext
.color
:= mFrameTextColor
[cidx
];
2171 uiContext
.drawText(tx
, gy
, mTitle
);
2174 inherited drawControlPost(gx
, gy
);
2178 procedure TUITopWindow
.activated ();
2180 if (mFocused
= nil) or (mFocused
= self
) then
2182 mFocused
:= findFirstFocus();
2184 if (mFocused
<> nil) and (mFocused
<> self
) then mFocused
.activated();
2189 procedure TUITopWindow
.blurred ();
2191 mDragScroll
:= TXMode
.None
;
2192 mWaitingClose
:= false;
2194 if (mFocused
<> nil) and (mFocused
<> self
) then mFocused
.blurred();
2199 procedure TUITopWindow
.keyEvent (var ev
: THKeyEvent
);
2201 inherited keyEvent(ev
);
2202 if (ev
.eaten
) or (ev
.cancelled
) or (not enabled
) {or (not getFocused)} then exit
;
2203 if (ev
= 'M-F3') then
2205 if (not assigned(closeRequestCB
)) or (closeRequestCB(self
)) then
2207 uiRemoveWindow(self
);
2215 procedure TUITopWindow
.mouseEvent (var ev
: THMouseEvent
);
2218 hgt
, sbhgt
: Integer;
2220 if (not enabled
) then exit
;
2221 if (mWidth
< 1) or (mHeight
< 1) then exit
;
2223 if (mDragScroll
= TXMode
.Drag
) then
2225 mX
+= ev
.x
-mDragStartX
;
2226 mY
+= ev
.y
-mDragStartY
;
2227 mDragStartX
:= ev
.x
;
2228 mDragStartY
:= ev
.y
;
2229 if (ev
.release
) and (ev
.but
= ev
.Left
) then mDragScroll
:= TXMode
.None
;
2234 if (mDragScroll
= TXMode
.Scroll
) then
2236 // check for vertical scrollbar
2244 sbhgt
:= mHeight
-mFrameHeight
*2+2;
2245 hgt
:= mHeight
-mFrameHeight
*2;
2246 if (hgt
> 0) and (mFullSize
.h
> hgt
) then
2248 hgt
:= (mFullSize
.h
*(ly
-7) div (sbhgt
-1))-(mHeight
-mFrameHeight
*2);
2249 mScrollY
:= nmax(0, hgt
);
2250 hgt
:= mHeight
-mFrameHeight
*2;
2251 if (mScrollY
+hgt
> mFullSize
.h
) then mScrollY
:= nmax(0, mFullSize
.h
-hgt
);
2254 if (ev
.release
) and (ev
.but
= ev
.Left
) then mDragScroll
:= TXMode
.None
;
2259 if toLocal(ev
.x
, ev
.y
, lx
, ly
) then
2266 if (lx
>= mFrameWidth
) and (lx
< mFrameWidth
+uiContext
.iconWinWidth(TGxContext
.TWinIcon
.Close
)) then
2268 //uiRemoveWindow(self);
2269 mWaitingClose
:= true;
2274 mDragScroll
:= TXMode
.Drag
;
2275 mDragStartX
:= ev
.x
;
2276 mDragStartY
:= ev
.y
;
2281 // check for vertical scrollbar
2282 if (lx
>= mWidth
-mFrameWidth
+1) and (ly
>= 7) and (ly
< mHeight
-mFrameHeight
+1) then
2284 sbhgt
:= mHeight
-mFrameHeight
*2+2;
2285 hgt
:= mHeight
-mFrameHeight
*2;
2286 if (hgt
> 0) and (mFullSize
.h
> hgt
) then
2288 hgt
:= (mFullSize
.h
*(ly
-7) div (sbhgt
-1))-(mHeight
-mFrameHeight
*2);
2289 mScrollY
:= nmax(0, hgt
);
2291 mDragScroll
:= TXMode
.Scroll
;
2297 if (lx
< mFrameWidth
) or (lx
>= mWidth
-mFrameWidth
) or (ly
>= mHeight
-mFrameHeight
) then
2300 mDragScroll
:= TXMode
.Drag
;
2301 mDragStartX
:= ev
.x
;
2302 mDragStartY
:= ev
.y
;
2308 if (ev
.release
) then
2310 if mWaitingClose
then
2312 if (lx
>= mFrameWidth
) and (lx
< mFrameWidth
+uiContext
.iconWinWidth(TGxContext
.TWinIcon
.Close
)) then
2314 if (not assigned(closeRequestCB
)) or (closeRequestCB(self
)) then
2316 uiRemoveWindow(self
);
2319 mWaitingClose
:= false;
2328 if mWaitingClose
then
2330 mInClose
:= (lx
>= mFrameWidth
) and (lx
< mFrameWidth
+uiContext
.iconWinWidth(TGxContext
.TWinIcon
.Close
));
2336 inherited mouseEvent(ev
);
2341 if (not ev
.motion
) and (mWaitingClose
) then begin ev
.eat(); mWaitingClose
:= false; exit
; end;
2346 // ////////////////////////////////////////////////////////////////////////// //
2347 constructor TUIBox
.Create (ahoriz
: Boolean);
2354 procedure TUIBox
.AfterConstruction ();
2358 mHAlign
:= -1; // left
2359 mCtl4Style
:= 'box';
2363 procedure TUIBox
.setCaption (const acap
: AnsiString);
2366 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mCaption
)+3, uiContext
.textHeight(mCaption
));
2370 procedure TUIBox
.setHasFrame (v
: Boolean);
2373 if (mHasFrame
) then begin mFrameWidth
:= 8; mFrameHeight
:= 8; end else begin mFrameWidth
:= 0; mFrameHeight
:= 0; end;
2374 if (mHasFrame
) then mNoPad
:= true;
2378 function TUIBox
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2380 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
2381 if (strEquCI1251(prname
, 'padding')) then
2383 if (mHoriz
) then mPadding
:= parseHPadding(par
, 0) else mPadding
:= parseVPadding(par
, 0);
2387 if (strEquCI1251(prname
, 'frame')) then
2389 setHasFrame(parseBool(par
));
2393 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) then
2395 setCaption(par
.expectIdOrStr(true));
2399 if (strEquCI1251(prname
, 'textalign')) or (strEquCI1251(prname
, 'text-align')) then
2401 mHAlign
:= parseHAlign(par
);
2405 if (strEquCI1251(prname
, 'children')) then
2411 result
:= inherited parseProperty(prname
, par
);
2415 procedure TUIBox
.drawControl (gx
, gy
: Integer);
2420 cidx
:= getColorIndex
;
2421 uiContext
.color
:= mBackColor
[cidx
];
2422 uiContext
.fillRect(gx
, gy
, mWidth
, mHeight
);
2426 uiContext
.color
:= mFrameColor
[cidx
];
2427 uiContext
.rect(gx
+3, gy
+3, mWidth
-6, mHeight
-6);
2430 if (Length(mCaption
) > 0) then
2432 if (mHAlign
< 0) then xpos
:= 3
2433 else if (mHAlign
> 0) then xpos
:= mWidth
-mFrameWidth
*2-uiContext
.textWidth(mCaption
)
2434 else xpos
:= (mWidth
-mFrameWidth
*2-uiContext
.textWidth(mCaption
)) div 2;
2435 xpos
+= gx
+mFrameWidth
;
2437 setScissor(mFrameWidth
+1, 0, mWidth
-mFrameWidth
-2, 8);
2440 uiContext
.color
:= mBackColor
[cidx
];
2441 uiContext
.fillRect(xpos
-3, gy
, uiContext
.textWidth(mCaption
)+4, 8);
2443 uiContext
.color
:= mFrameTextColor
[cidx
];
2444 uiContext
.drawText(xpos
, gy
, mCaption
);
2449 procedure TUIBox
.mouseEvent (var ev
: THMouseEvent
);
2453 inherited mouseEvent(ev
);
2454 if (not ev
.eaten
) and (not ev
.cancelled
) and (enabled
) and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
2461 procedure TUIBox
.keyEvent (var ev
: THKeyEvent
);
2464 cur
, ctl
: TUIControl
;
2466 inherited keyEvent(ev
);
2467 if (ev
.eaten
) or (ev
.cancelled
) or (not ev
.press
) or (not enabled
) or (not getActive
) then exit
;
2468 if (Length(mChildren
) = 0) then exit
;
2469 if (mHoriz
) and (ev
= 'Left') then dir
:= -1
2470 else if (mHoriz
) and (ev
= 'Right') then dir
:= 1
2471 else if (not mHoriz
) and (ev
= 'Up') then dir
:= -1
2472 else if (not mHoriz
) and (ev
= 'Down') then dir
:= 1;
2473 if (dir
= 0) then exit
;
2475 cur
:= topLevel
.mFocused
;
2476 while (cur
<> nil) and (cur
.mParent
<> self
) do cur
:= cur
.mParent
;
2477 //if (cur = nil) then writeln('CUR: nil') else writeln('CUR: ', cur.className, '#', cur.id);
2478 if (dir
< 0) then ctl
:= findPrevFocus(cur
, true) else ctl
:= findNextFocus(cur
, true);
2479 //if (ctl = nil) then writeln('CTL: nil') else writeln('CTL: ', ctl.className, '#', ctl.id);
2480 if (ctl
<> nil) and (ctl
<> self
) then
2482 ctl
.focused
:= true;
2487 // ////////////////////////////////////////////////////////////////////////// //
2488 constructor TUIHBox
.Create ();
2493 procedure TUIHBox
.AfterConstruction ();
2500 // ////////////////////////////////////////////////////////////////////////// //
2501 constructor TUIVBox
.Create ();
2506 procedure TUIVBox
.AfterConstruction ();
2513 // ////////////////////////////////////////////////////////////////////////// //
2514 procedure TUISpan
.AfterConstruction ();
2520 mCtl4Style
:= 'span';
2524 function TUISpan
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2526 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
2527 result
:= inherited parseProperty(prname
, par
);
2531 procedure TUISpan
.drawControl (gx
, gy
: Integer);
2536 // ////////////////////////////////////////////////////////////////////// //
2537 procedure TUILine
.AfterConstruction ();
2543 mCtl4Style
:= 'line';
2547 function TUILine
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2549 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
2550 result
:= inherited parseProperty(prname
, par
);
2554 procedure TUILine
.drawControl (gx
, gy
: Integer);
2558 cidx
:= getColorIndex
;
2559 uiContext
.color
:= mTextColor
[cidx
];
2560 if mHoriz
then uiContext
.hline(gx
, gy
+(mHeight
div 2), mWidth
)
2561 else uiContext
.vline(gx
+(mWidth
div 2), gy
, mHeight
);
2565 // ////////////////////////////////////////////////////////////////////////// //
2566 procedure TUIHLine
.AfterConstruction ();
2574 // ////////////////////////////////////////////////////////////////////////// //
2575 procedure TUIVLine
.AfterConstruction ();
2583 // ////////////////////////////////////////////////////////////////////////// //
2584 procedure TUIStaticText
.AfterConstruction ();
2590 mHoriz
:= true; // nobody cares
2593 mDefSize
.h
:= uiContext
.charHeight(' ');
2594 mCtl4Style
:= 'static';
2598 procedure TUIStaticText
.setText (const atext
: AnsiString);
2601 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
), uiContext
.textHeight(mText
));
2605 function TUIStaticText
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2607 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) or (strEquCI1251(prname
, 'text')) then
2609 setText(par
.expectIdOrStr(true));
2613 if (strEquCI1251(prname
, 'textalign')) or (strEquCI1251(prname
, 'text-align')) then
2615 parseTextAlign(par
, mHAlign
, mVAlign
);
2619 if (strEquCI1251(prname
, 'header')) then
2625 if (strEquCI1251(prname
, 'line')) then
2631 result
:= inherited parseProperty(prname
, par
);
2635 procedure TUIStaticText
.drawControl (gx
, gy
: Integer);
2637 xpos
, ypos
: Integer;
2640 cidx
:= getColorIndex
;
2641 uiContext
.color
:= mBackColor
[cidx
];
2642 uiContext
.fillRect(gx
, gy
, mWidth
, mHeight
);
2644 if (mHAlign
< 0) then xpos
:= 0
2645 else if (mHAlign
> 0) then xpos
:= mWidth
-uiContext
.textWidth(mText
)
2646 else xpos
:= (mWidth
-uiContext
.textWidth(mText
)) div 2;
2648 if (Length(mText
) > 0) then
2650 if (mHeader
) then uiContext
.color
:= mFrameTextColor
[cidx
] else uiContext
.color
:= mTextColor
[cidx
];
2652 if (mVAlign
< 0) then ypos
:= 0
2653 else if (mVAlign
> 0) then ypos
:= mHeight
-uiContext
.textHeight(mText
)
2654 else ypos
:= (mHeight
-uiContext
.textHeight(mText
)) div 2;
2656 uiContext
.drawText(gx
+xpos
, gy
+ypos
, mText
);
2661 if (mHeader
) then uiContext
.color
:= mFrameColor
[cidx
] else uiContext
.color
:= mTextColor
[cidx
];
2663 if (mVAlign
< 0) then ypos
:= 0
2664 else if (mVAlign
> 0) then ypos
:= mHeight
-1
2665 else ypos
:= (mHeight
div 2);
2668 if (Length(mText
) = 0) then
2670 uiContext
.hline(gx
, ypos
, mWidth
);
2674 uiContext
.hline(gx
, ypos
, xpos
-1);
2675 uiContext
.hline(gx
+xpos
+uiContext
.textWidth(mText
), ypos
, mWidth
);
2681 // ////////////////////////////////////////////////////////////////////////// //
2682 procedure TUITextLabel
.AfterConstruction ();
2688 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
), uiContext
.textHeight(mText
));
2689 mCtl4Style
:= 'label';
2694 procedure TUITextLabel
.cacheStyle (root
: TUIStyle
);
2696 inherited cacheStyle(root
);
2698 mHotColor
[ClrIdxActive
] := root
.get('hot-color', 'active', mCtl4Style
).asRGBADef(TGxRGBA
.Create(0, 128, 0));
2700 mHotColor
[ClrIdxDisabled
] := root
.get('hot-color', 'disabled', mCtl4Style
).asRGBADef(TGxRGBA
.Create(0, 64, 0));
2702 mHotColor
[ClrIdxInactive
] := root
.get('hot-color', 'inactive', mCtl4Style
).asRGBADef(TGxRGBA
.Create(0, 64, 0));
2706 procedure TUITextLabel
.setText (const s
: AnsiString);
2714 while (f
<= Length(s
)) do
2716 if (s
[f
] = '\\') then
2719 if (f
<= Length(s
)) then mText
+= s
[f
];
2722 else if (s
[f
] = '~') then
2725 if (f
<= Length(s
)) then
2727 if (mHotChar
= #0) then
2730 mHotOfs
:= Length(mText
);
2742 // fix hotchar offset
2743 if (mHotChar
<> #0) and (mHotOfs
> 0) then
2745 mHotOfs
:= uiContext
.textWidth(Copy(mText
, 1, mHotOfs
+1))-uiContext
.charWidth(mText
[mHotOfs
+1]);
2748 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
), uiContext
.textHeight(mText
));
2752 function TUITextLabel
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2754 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) or (strEquCI1251(prname
, 'text')) then
2756 setText(par
.expectIdOrStr(true));
2760 if (strEquCI1251(prname
, 'link')) then
2762 mLinkId
:= par
.expectIdOrStr(true);
2766 if (strEquCI1251(prname
, 'textalign')) or (strEquCI1251(prname
, 'text-align')) then
2768 parseTextAlign(par
, mHAlign
, mVAlign
);
2772 result
:= inherited parseProperty(prname
, par
);
2776 procedure TUITextLabel
.drawControl (gx
, gy
: Integer);
2778 xpos
, ypos
: Integer;
2781 cidx
:= getColorIndex
;
2782 uiContext
.color
:= mBackColor
[cidx
];
2783 uiContext
.fillRect(gx
, gy
, mWidth
, mHeight
);
2784 if (Length(mText
) > 0) then
2786 if (mHAlign
< 0) then xpos
:= 0
2787 else if (mHAlign
> 0) then xpos
:= mWidth
-uiContext
.textWidth(mText
)
2788 else xpos
:= (mWidth
-uiContext
.textWidth(mText
)) div 2;
2790 if (mVAlign
< 0) then ypos
:= 0
2791 else if (mVAlign
> 0) then ypos
:= mHeight
-uiContext
.textHeight(mText
)
2792 else ypos
:= (mHeight
-uiContext
.textHeight(mText
)) div 2;
2794 uiContext
.color
:= mTextColor
[cidx
];
2795 uiContext
.drawText(gx
+xpos
, gy
+ypos
, mText
);
2797 if (Length(mLinkId
) > 0) and (mHotChar
<> #0) and (mHotChar
<> ' ') then
2799 uiContext
.color
:= mHotColor
[cidx
];
2800 uiContext
.drawChar(gx
+xpos
+mHotOfs
, gy
+ypos
, mHotChar
);
2806 procedure TUITextLabel
.mouseEvent (var ev
: THMouseEvent
);
2810 inherited mouseEvent(ev
);
2811 if (not ev
.eaten
) and (not ev
.cancelled
) and (enabled
) and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
2818 procedure TUITextLabel
.doAction ();
2822 if (assigned(actionCB
)) then
2828 ctl
:= topLevel
[mLinkId
];
2829 if (ctl
<> nil) then
2831 if (ctl
.canFocus
) then ctl
.focused
:= true;
2837 procedure TUITextLabel
.keyEventPost (var ev
: THKeyEvent
);
2839 if (not enabled
) then exit
;
2840 if (mHotChar
= #0) then exit
;
2841 if (ev
.eaten
) or (ev
.cancelled
) or (not ev
.press
) then exit
;
2842 if (ev
.kstate
<> ev
.ModAlt
) then exit
;
2843 if (not ev
.isHot(mHotChar
)) then exit
;
2845 if (canFocus
) then focused
:= true;
2850 // ////////////////////////////////////////////////////////////////////////// //
2851 procedure TUIButton
.AfterConstruction ();
2857 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
)+8*2, uiContext
.textHeight(mText
)+2);
2858 mCtl4Style
:= 'button';
2862 procedure TUIButton
.setText (const s
: AnsiString);
2864 inherited setText(s
);
2865 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
)+8*2, uiContext
.textHeight(mText
)+2);
2869 procedure TUIButton
.drawControl (gx
, gy
: Integer);
2871 xpos
, ypos
: Integer;
2874 cidx
:= getColorIndex
;
2876 uiContext
.color
:= mBackColor
[cidx
];
2877 uiContext
.fillRect(gx
+1, gy
, mWidth
-2, mHeight
);
2878 uiContext
.fillRect(gx
, gy
+1, 1, mHeight
-2);
2879 uiContext
.fillRect(gx
+mWidth
-1, gy
+1, 1, mHeight
-2);
2881 if (Length(mText
) > 0) then
2883 if (mHAlign
< 0) then xpos
:= 0
2884 else if (mHAlign
> 0) then xpos
:= mWidth
-uiContext
.textWidth(mText
)
2885 else xpos
:= (mWidth
-uiContext
.textWidth(mText
)) div 2;
2887 if (mVAlign
< 0) then ypos
:= 0
2888 else if (mVAlign
> 0) then ypos
:= mHeight
-uiContext
.textHeight(mText
)
2889 else ypos
:= (mHeight
-uiContext
.textHeight(mText
)) div 2;
2891 setScissor(8, 0, mWidth
-16, mHeight
);
2892 uiContext
.color
:= mTextColor
[cidx
];
2893 uiContext
.drawText(gx
+xpos
+8, gy
+ypos
, mText
);
2895 if (mHotChar
<> #0) and (mHotChar
<> ' ') then
2897 uiContext
.color
:= mHotColor
[cidx
];
2898 uiContext
.drawChar(gx
+xpos
+8+mHotOfs
, gy
+ypos
, mHotChar
);
2904 procedure TUIButton
.mouseEvent (var ev
: THMouseEvent
);
2908 inherited mouseEvent(ev
);
2909 if (uiGrabCtl
= self
) then
2912 if (ev
= '-lmb') and focused
and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
2918 if (ev
.eaten
) or (ev
.cancelled
) or (not enabled
) or not focused
then exit
;
2923 procedure TUIButton
.keyEvent (var ev
: THKeyEvent
);
2925 inherited keyEvent(ev
);
2926 if (not ev
.eaten
) and (not ev
.cancelled
) and (enabled
) then
2928 if (ev
= 'Enter') or (ev
= 'Space') then
2938 // ////////////////////////////////////////////////////////////////////////// //
2939 procedure TUISwitchBox
.AfterConstruction ();
2945 mIcon
:= TGxContext
.TMarkIcon
.Checkbox
;
2946 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
)+3+uiContext
.iconMarkWidth(mIcon
), uiContext
.iconMarkHeight(mIcon
));
2947 mCtl4Style
:= 'switchbox';
2949 mBoolVar
:= @mChecked
;
2953 procedure TUISwitchBox
.cacheStyle (root
: TUIStyle
);
2955 inherited cacheStyle(root
);
2957 mSwitchColor
[ClrIdxActive
] := root
.get('switch-color', 'active', mCtl4Style
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
2959 mSwitchColor
[ClrIdxDisabled
] := root
.get('switch-color', 'disabled', mCtl4Style
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
2961 mSwitchColor
[ClrIdxInactive
] := root
.get('switch-color', 'inactive', mCtl4Style
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
2965 procedure TUISwitchBox
.setText (const s
: AnsiString);
2967 inherited setText(s
);
2968 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
)+3+uiContext
.iconMarkWidth(mIcon
), uiContext
.iconMarkHeight(mIcon
));
2972 function TUISwitchBox
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2974 if (strEquCI1251(prname
, 'checked')) then
2980 result
:= inherited parseProperty(prname
, par
);
2984 function TUISwitchBox
.getChecked (): Boolean;
2986 if (mBoolVar
<> nil) then result
:= mBoolVar
^ else result
:= false;
2990 procedure TUISwitchBox
.setVar (pvar
: PBoolean);
2992 if (pvar
= nil) then pvar
:= @mChecked
;
2993 if (pvar
<> mBoolVar
) then
2996 setChecked(mBoolVar
^);
3001 procedure TUISwitchBox
.drawControl (gx
, gy
: Integer);
3003 xpos
, ypos
: Integer;
3006 cidx
:= getColorIndex
;
3008 if (mHAlign
< 0) then xpos
:= 0
3009 else if (mHAlign
> 0) then xpos
:= mWidth
-(uiContext
.textWidth(mText
)+3+uiContext
.iconMarkWidth(mIcon
))
3010 else xpos
:= (mWidth
-(uiContext
.textWidth(mText
)+3+uiContext
.iconMarkWidth(mIcon
))) div 2;
3012 if (mVAlign
< 0) then ypos
:= 0
3013 else if (mVAlign
> 0) then ypos
:= mHeight
-uiContext
.iconMarkHeight(mIcon
)
3014 else ypos
:= (mHeight
-uiContext
.iconMarkHeight(mIcon
)) div 2;
3016 uiContext
.color
:= mBackColor
[cidx
];
3017 uiContext
.fillRect(gx
, gy
, mWidth
, mHeight
);
3019 uiContext
.color
:= mSwitchColor
[cidx
];
3020 uiContext
.drawIconMark(mIcon
, gx
, gy
, checked
);
3022 if (mVAlign
< 0) then ypos
:= 0
3023 else if (mVAlign
> 0) then ypos
:= mHeight
-uiContext
.textHeight(mText
)
3024 else ypos
:= (mHeight
-uiContext
.textHeight(mText
)) div 2;
3026 uiContext
.color
:= mTextColor
[cidx
];
3027 uiContext
.drawText(gx
+xpos
+3+uiContext
.iconMarkWidth(mIcon
), gy
+ypos
, mText
);
3029 if (mHotChar
<> #0) and (mHotChar
<> ' ') then
3031 uiContext
.color
:= mHotColor
[cidx
];
3032 uiContext
.drawChar(gx
+xpos
+3+uiContext
.iconMarkWidth(mIcon
)+mHotOfs
, gy
+ypos
, mHotChar
);
3037 procedure TUISwitchBox
.mouseEvent (var ev
: THMouseEvent
);
3041 inherited mouseEvent(ev
);
3042 if (uiGrabCtl
= self
) then
3045 if (ev
= '-lmb') and focused
and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
3051 if (ev
.eaten
) or (ev
.cancelled
) or (not enabled
) or not focused
then exit
;
3056 procedure TUISwitchBox
.keyEvent (var ev
: THKeyEvent
);
3058 inherited keyEvent(ev
);
3059 if (not ev
.eaten
) and (not ev
.cancelled
) and (enabled
) then
3061 if (ev
= 'Space') then
3071 // ////////////////////////////////////////////////////////////////////////// //
3072 procedure TUICheckBox
.AfterConstruction ();
3076 mBoolVar
:= @mChecked
;
3077 mIcon
:= TGxContext
.TMarkIcon
.Checkbox
;
3082 procedure TUICheckBox
.setChecked (v
: Boolean);
3088 procedure TUICheckBox
.doAction ();
3090 if (assigned(actionCB
)) then
3096 setChecked(not getChecked
);
3101 // ////////////////////////////////////////////////////////////////////////// //
3102 procedure TUIRadioBox
.AfterConstruction ();
3106 mBoolVar
:= @mChecked
;
3108 mIcon
:= TGxContext
.TMarkIcon
.Radiobox
;
3113 function TUIRadioBox
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
3115 if (strEquCI1251(prname
, 'group')) then
3117 mRadioGroup
:= par
.expectIdOrStr(true);
3118 if (getChecked
) then setChecked(true);
3122 if (strEquCI1251(prname
, 'checked')) then
3128 result
:= inherited parseProperty(prname
, par
);
3132 procedure TUIRadioBox
.setChecked (v
: Boolean);
3134 function resetGroup (ctl
: TUIControl
): Boolean;
3137 if (ctl
<> self
) and (ctl
is TUIRadioBox
) and (TUIRadioBox(ctl
).mRadioGroup
= mRadioGroup
) then
3139 TUIRadioBox(ctl
).mBoolVar
^ := false;
3145 if v
then topLevel
.forEachControl(resetGroup
);
3149 procedure TUIRadioBox
.doAction ();
3151 if (assigned(actionCB
)) then
3162 // ////////////////////////////////////////////////////////////////////////// //
3164 registerCtlClass(TUIHBox
, 'hbox');
3165 registerCtlClass(TUIVBox
, 'vbox');
3166 registerCtlClass(TUISpan
, 'span');
3167 registerCtlClass(TUIHLine
, 'hline');
3168 registerCtlClass(TUIVLine
, 'vline');
3169 registerCtlClass(TUITextLabel
, 'label');
3170 registerCtlClass(TUIStaticText
, 'static');
3171 registerCtlClass(TUIButton
, 'button');
3172 registerCtlClass(TUICheckBox
, 'checkbox');
3173 registerCtlClass(TUIRadioBox
, 'radiobox');
3175 uiContext
:= TGxContext
.Create();