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 mStyleLoaded
: Boolean;
68 mCtl4Style
: AnsiString;
69 mBackColor
: array[0..ClrIdxMax
] of TGxRGBA
;
70 mTextColor
: array[0..ClrIdxMax
] of TGxRGBA
;
71 mFrameColor
: array[0..ClrIdxMax
] of TGxRGBA
;
72 mFrameTextColor
: array[0..ClrIdxMax
] of TGxRGBA
;
73 mFrameIconColor
: array[0..ClrIdxMax
] of TGxRGBA
;
74 mDarken
: array[0..ClrIdxMax
] of Integer; // >255: none
77 procedure updateStyle (); virtual;
78 procedure cacheStyle (root
: TUIStyle
); virtual;
79 function getColorIndex (): Integer; inline;
82 function getEnabled (): Boolean;
83 procedure setEnabled (v
: Boolean); inline;
85 function getFocused (): Boolean; inline;
86 procedure setFocused (v
: Boolean); inline;
88 function getActive (): Boolean; inline;
90 function getCanFocus (): Boolean; inline;
92 function isMyChild (ctl
: TUIControl
): Boolean;
94 function findFirstFocus (): TUIControl
;
95 function findLastFocus (): TUIControl
;
97 function findNextFocus (cur
: TUIControl
; wrap
: Boolean): TUIControl
;
98 function findPrevFocus (cur
: TUIControl
; wrap
: Boolean): TUIControl
;
100 function findCancelControl (): TUIControl
;
101 function findDefaulControl (): TUIControl
;
103 function findControlById (const aid
: AnsiString): TUIControl
;
105 procedure activated (); virtual;
106 procedure blurred (); virtual;
108 procedure calcFullClientSize ();
110 procedure drawFrame (gx
, gy
, resx
, thalign
: Integer; const text: AnsiString; dbl
: Boolean);
113 var savedClip
: TGxRect
; // valid only in `draw*()` calls
114 //WARNING! do not call scissor functions outside `.draw*()` API!
115 // set scissor to this rect (in local coords)
116 procedure setScissor (lx
, ly
, lw
, lh
: Integer); // valid only in `draw*()` calls
120 closeRequestCB
: TCloseRequestCB
;
123 mDefSize
: TLaySize
; // default size
124 mMaxSize
: TLaySize
; // maximum size
131 mLayDefSize
: TLaySize
;
132 mLayMaxSize
: TLaySize
;
138 // layouter interface
139 function getDefSize (): TLaySize
; inline; // default size; <0: use max size
140 //procedure setDefSize (const sz: TLaySize); inline; // default size; <0: use max size
141 function getMargins (): TLayMargins
; inline;
142 function getPadding (): TLaySize
; inline; // children padding (each non-first child will get this on left/top)
143 function getMaxSize (): TLaySize
; inline; // max size; <0: set to some huge value
144 //procedure setMaxSize (const sz: TLaySize); inline; // max size; <0: set to some huge value
145 function getFlex (): Integer; inline; // <=0: not flexible
146 function isHorizBox (): Boolean; inline; // horizontal layout for children?
147 function noPad (): Boolean; inline; // ignore padding in box direction for this control
148 function getAlign (): Integer; inline; // aligning in non-main direction: <0: left/up; 0: center; >0: right/down
149 function getExpand (): Boolean; inline; // expanding in non-main direction: `true` will ignore align and eat all available space
150 function getHGroup (): AnsiString; inline; // empty: not grouped
151 function getVGroup (): AnsiString; inline; // empty: not grouped
153 procedure setActualSizePos (constref apos
: TLayPos
; constref asize
: TLaySize
); inline;
155 procedure layPrepare (); virtual; // called before registering control in layouter
158 property flex
: Integer read mFlex write mFlex
;
159 property flDefaultSize
: TLaySize read mDefSize write mDefSize
;
160 property flMaxSize
: TLaySize read mMaxSize write mMaxSize
;
161 property flPadding
: TLaySize read mPadding write mPadding
;
162 property flHoriz
: Boolean read mHoriz write mHoriz
;
163 property flAlign
: Integer read mAlign write mAlign
;
164 property flExpand
: Boolean read mExpand write mExpand
;
165 property flHGroup
: AnsiString read mHGroup write mHGroup
;
166 property flVGroup
: AnsiString read mVGroup write mVGroup
;
167 property flNoPad
: Boolean read mNoPad write mNoPad
;
168 property fullSize
: TLaySize read mFullSize
;
171 function parsePos (par
: TTextParser
): TLayPos
;
172 function parseSize (par
: TTextParser
): TLaySize
;
173 function parsePadding (par
: TTextParser
): TLaySize
;
174 function parseHPadding (par
: TTextParser
; def
: Integer): TLaySize
;
175 function parseVPadding (par
: TTextParser
; def
: Integer): TLaySize
;
176 function parseBool (par
: TTextParser
): Boolean;
177 function parseAnyAlign (par
: TTextParser
): Integer;
178 function parseHAlign (par
: TTextParser
): Integer;
179 function parseVAlign (par
: TTextParser
): Integer;
180 function parseOrientation (const prname
: AnsiString; par
: TTextParser
): Boolean;
181 procedure parseTextAlign (par
: TTextParser
; var h
, v
: Integer);
182 procedure parseChildren (par
: TTextParser
); // par should be on '{'; final '}' is eaten
185 // par is on property data
186 // there may be more data in text stream, don't eat it!
187 // return `true` if property name is valid and value was parsed
188 // return `false` if property name is invalid; don't advance parser in this case
189 // throw on property data errors
190 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; virtual;
192 // par should be on '{'; final '}' is eaten
193 procedure parseProperties (par
: TTextParser
);
196 constructor Create ();
197 destructor Destroy (); override;
199 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
201 // `sx` and `sy` are screen coordinates
202 procedure drawControl (gx
, gy
: Integer); virtual;
204 // called after all children drawn
205 procedure drawControlPost (gx
, gy
: Integer); virtual;
207 procedure draw (); virtual;
209 function topLevel (): TUIControl
; inline;
211 // returns `true` if global coords are inside this control
212 function toLocal (var x
, y
: Integer): Boolean;
213 function toLocal (gx
, gy
: Integer; out x
, y
: Integer): Boolean; inline;
214 procedure toGlobal (var x
, y
: Integer);
215 procedure toGlobal (lx
, ly
: Integer; out x
, y
: Integer); inline;
217 procedure getDrawRect (out gx
, gy
, wdt
, hgt
: Integer);
219 // x and y are global coords
220 function controlAtXY (x
, y
: Integer; allowDisabled
: Boolean=false): TUIControl
;
222 function parentScrollX (): Integer; inline;
223 function parentScrollY (): Integer; inline;
225 procedure makeVisibleInParent ();
227 procedure doAction (); virtual; // so user controls can override it
229 procedure mouseEvent (var ev
: THMouseEvent
); virtual; // returns `true` if event was eaten
230 procedure keyEvent (var ev
: THKeyEvent
); virtual; // returns `true` if event was eaten
231 procedure keyEventPre (var ev
: THKeyEvent
); virtual; // will be called before dispatching the event
232 procedure keyEventPost (var ev
: THKeyEvent
); virtual; // will be called after if nobody processed the event
234 function prevSibling (): TUIControl
;
235 function nextSibling (): TUIControl
;
236 function firstChild (): TUIControl
; inline;
237 function lastChild (): TUIControl
; inline;
239 procedure appendChild (ctl
: TUIControl
); virtual;
241 function setActionCBFor (const aid
: AnsiString; cb
: TActionCB
): TActionCB
; // returns previous cb
243 function forEachChildren (cb
: TCtlEnumCB
): TUIControl
; // doesn't recurse
244 function forEachControl (cb
: TCtlEnumCB
; includeSelf
: Boolean=true): TUIControl
;
246 procedure close (); // this closes *top-level* control
249 property id
: AnsiString read mId write mId
;
250 property styleId
: AnsiString read mStyleId
;
251 property scrollX
: Integer read mScrollX write mScrollX
;
252 property scrollY
: Integer read mScrollY write mScrollY
;
253 property x0
: Integer read mX write mX
;
254 property y0
: Integer read mY write mY
;
255 property width
: Integer read mWidth write mWidth
;
256 property height
: Integer read mHeight write mHeight
;
257 property enabled
: Boolean read getEnabled write setEnabled
;
258 property parent
: TUIControl read mParent
;
259 property focused
: Boolean read getFocused write setFocused
;
260 property active
: Boolean read getActive
;
261 property escClose
: Boolean read mEscClose write mEscClose
;
262 property cancel
: Boolean read mCancel write mCancel
;
263 property defctl
: Boolean read mDefault write mDefault
;
264 property canFocus
: Boolean read getCanFocus write mCanFocus
;
265 property ctlById
[const aid
: AnsiString]: TUIControl read findControlById
; default
;
269 TUITopWindow
= class(TUIControl
)
271 type TXMode
= (None
, Drag
, Scroll
);
276 mDragStartX
, mDragStartY
: Integer;
277 mWaitingClose
: Boolean;
279 mFreeOnClose
: Boolean; // default: false
280 mDoCenter
: Boolean; // after layouting
281 mFitToScreen
: Boolean;
284 procedure activated (); override;
285 procedure blurred (); override;
288 closeCB
: TActionCB
; // called after window was removed from ui window list
291 constructor Create (const atitle
: AnsiString);
293 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
295 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
297 procedure flFitToScreen (); // call this before layouting
299 procedure centerInScreen ();
301 // `sx` and `sy` are screen coordinates
302 procedure drawControl (gx
, gy
: Integer); override;
303 procedure drawControlPost (gx
, gy
: Integer); override;
305 procedure keyEvent (var ev
: THKeyEvent
); override; // returns `true` if event was eaten
306 procedure mouseEvent (var ev
: THMouseEvent
); override; // returns `true` if event was eaten
309 property freeOnClose
: Boolean read mFreeOnClose write mFreeOnClose
;
310 property fitToScreen
: Boolean read mFitToScreen write mFitToScreen
;
313 // ////////////////////////////////////////////////////////////////////// //
314 TUIBox
= class(TUIControl
)
317 mCaption
: AnsiString;
318 mHAlign
: Integer; // -1: left; 0: center; 1: right; default: left
321 procedure setCaption (const acap
: AnsiString);
322 procedure setHasFrame (v
: Boolean);
325 constructor Create (ahoriz
: Boolean);
327 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
329 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
331 procedure drawControl (gx
, gy
: Integer); override;
333 procedure mouseEvent (var ev
: THMouseEvent
); override;
334 procedure keyEvent (var ev
: THKeyEvent
); override;
337 property caption
: AnsiString read mCaption write setCaption
;
338 property hasFrame
: Boolean read mHasFrame write setHasFrame
;
339 property captionAlign
: Integer read mHAlign write mHAlign
;
342 TUIHBox
= class(TUIBox
)
344 constructor Create ();
346 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
349 TUIVBox
= class(TUIBox
)
351 constructor Create ();
353 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
356 // ////////////////////////////////////////////////////////////////////// //
357 TUISpan
= class(TUIControl
)
359 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
361 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
363 procedure drawControl (gx
, gy
: Integer); override;
366 // ////////////////////////////////////////////////////////////////////// //
367 TUILine
= class(TUIControl
)
369 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
371 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
373 procedure layPrepare (); override; // called before registering control in layouter
375 procedure drawControl (gx
, gy
: Integer); override;
378 // ////////////////////////////////////////////////////////////////////// //
379 TUIStaticText
= class(TUIControl
)
382 mHAlign
: Integer; // -1: left; 0: center; 1: right; default: left
383 mVAlign
: Integer; // -1: top; 0: center; 1: bottom; default: center
384 mHeader
: Boolean; // true: draw with frame text color
385 mLine
: Boolean; // true: draw horizontal line
388 procedure setText (const atext
: AnsiString);
391 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
393 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
395 procedure drawControl (gx
, gy
: Integer); override;
398 property text: AnsiString read mText write setText
;
399 property halign
: Integer read mHAlign write mHAlign
;
400 property valign
: Integer read mVAlign write mVAlign
;
401 property header
: Boolean read mHeader write mHeader
;
402 property line
: Boolean read mLine write mLine
;
405 // ////////////////////////////////////////////////////////////////////// //
406 TUITextLabel
= class(TUIControl
)
409 mHAlign
: Integer; // -1: left; 0: center; 1: right; default: left
410 mVAlign
: Integer; // -1: top; 0: center; 1: bottom; default: center
412 mHotOfs
: Integer; // from text start, in pixels
413 mHotColor
: array[0..ClrIdxMax
] of TGxRGBA
;
414 mLinkId
: AnsiString; // linked control
417 procedure cacheStyle (root
: TUIStyle
); override;
419 procedure setText (const s
: AnsiString); virtual;
422 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
424 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
426 procedure doAction (); override;
428 procedure drawControl (gx
, gy
: Integer); override;
430 procedure mouseEvent (var ev
: THMouseEvent
); override;
431 procedure keyEventPost (var ev
: THKeyEvent
); override;
434 property text: AnsiString read mText write setText
;
435 property halign
: Integer read mHAlign write mHAlign
;
436 property valign
: Integer read mVAlign write mVAlign
;
439 // ////////////////////////////////////////////////////////////////////// //
440 TUIButton
= class(TUITextLabel
)
442 mSkipLayPrepare
: Boolean;
443 mShadowSize
: Integer;
444 mAddMarkers
: Boolean;
445 mHideMarkers
: Boolean;
449 procedure setText (const s
: AnsiString); override;
451 procedure cacheStyle (root
: TUIStyle
); override;
454 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
456 procedure layPrepare (); override; // called before registering control in layouter
458 procedure drawControl (gx
, gy
: Integer); override;
460 procedure mouseEvent (var ev
: THMouseEvent
); override;
461 procedure keyEvent (var ev
: THKeyEvent
); override;
464 // ////////////////////////////////////////////////////////////////////// //
465 TUIButtonRound
= class(TUIButton
)
467 procedure setText (const s
: AnsiString); override;
470 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
472 procedure layPrepare (); override; // called before registering control in layouter
474 procedure drawControl (gx
, gy
: Integer); override;
477 // ////////////////////////////////////////////////////////////////////// //
478 TUISwitchBox
= class(TUITextLabel
)
482 mIcon
: TGxContext
.TMarkIcon
;
483 mSwitchColor
: array[0..ClrIdxMax
] of TGxRGBA
;
486 procedure cacheStyle (root
: TUIStyle
); override;
488 procedure setText (const s
: AnsiString); override;
490 function getChecked (): Boolean; virtual;
491 procedure setChecked (v
: Boolean); virtual; abstract;
494 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
496 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
498 procedure drawControl (gx
, gy
: Integer); override;
500 procedure mouseEvent (var ev
: THMouseEvent
); override;
501 procedure keyEvent (var ev
: THKeyEvent
); override;
503 procedure setVar (pvar
: PBoolean);
506 property checked
: Boolean read getChecked write setChecked
;
509 TUICheckBox
= class(TUISwitchBox
)
511 procedure setChecked (v
: Boolean); override;
514 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
516 procedure doAction (); override;
519 TUIRadioBox
= class(TUISwitchBox
)
521 mRadioGroup
: AnsiString;
524 procedure setChecked (v
: Boolean); override;
527 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
529 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
531 procedure doAction (); override;
534 property radioGroup
: AnsiString read mRadioGroup write mRadioGroup
; //FIXME
538 // ////////////////////////////////////////////////////////////////////////// //
539 procedure uiMouseEvent (var evt
: THMouseEvent
);
540 procedure uiKeyEvent (var evt
: THKeyEvent
);
544 // ////////////////////////////////////////////////////////////////////////// //
545 procedure uiAddWindow (ctl
: TUIControl
);
546 procedure uiRemoveWindow (ctl
: TUIControl
); // will free window if `mFreeOnClose` is `true`
547 function uiVisibleWindow (ctl
: TUIControl
): Boolean;
549 procedure uiUpdateStyles ();
552 // ////////////////////////////////////////////////////////////////////////// //
554 procedure uiLayoutCtl (ctl
: TUIControl
);
557 // ////////////////////////////////////////////////////////////////////////// //
558 procedure uiInitialize ();
559 procedure uiDeinitialize ();
562 // ////////////////////////////////////////////////////////////////////////// //
564 fuiRenderScale
: Single = 1.0;
565 uiContext
: TGxContext
= nil;
575 // ////////////////////////////////////////////////////////////////////////// //
576 procedure uiDeinitialize ();
578 FreeAndNil(uiContext
);
582 procedure uiInitialize ();
584 if (uiContext
<> nil) then raise Exception
.Create('FlexUI already initialized');
585 uiContext
:= TGxContext
.Create();
589 // ////////////////////////////////////////////////////////////////////////// //
591 ctlsToKill
: array of TUIControl
= nil;
594 procedure scheduleKill (ctl
: TUIControl
);
598 if (ctl
= nil) then exit
;
600 for f
:= 0 to High(ctlsToKill
) do
602 if (ctlsToKill
[f
] = ctl
) then exit
;
603 if (ctlsToKill
[f
] = nil) then begin ctlsToKill
[f
] := ctl
; exit
; end;
605 SetLength(ctlsToKill
, Length(ctlsToKill
)+1);
606 ctlsToKill
[High(ctlsToKill
)] := ctl
;
610 procedure processKills ();
615 for f
:= 0 to High(ctlsToKill
) do
617 ctl
:= ctlsToKill
[f
];
618 if (ctl
= nil) then break
;
619 ctlsToKill
[f
] := nil;
622 if (Length(ctlsToKill
) > 0) then ctlsToKill
[0] := nil; // just in case
626 // ////////////////////////////////////////////////////////////////////////// //
628 knownCtlClasses
: array of record
629 klass
: TUIControlClass
;
634 procedure registerCtlClass (aklass
: TUIControlClass
; const aname
: AnsiString);
636 assert(aklass
<> nil);
637 assert(Length(aname
) > 0);
638 SetLength(knownCtlClasses
, Length(knownCtlClasses
)+1);
639 knownCtlClasses
[High(knownCtlClasses
)].klass
:= aklass
;
640 knownCtlClasses
[High(knownCtlClasses
)].name
:= aname
;
644 function findCtlClass (const aname
: AnsiString): TUIControlClass
;
648 for f
:= 0 to High(knownCtlClasses
) do
650 if (strEquCI1251(aname
, knownCtlClasses
[f
].name
)) then
652 result
:= knownCtlClasses
[f
].klass
;
660 // ////////////////////////////////////////////////////////////////////////// //
662 TFlexLayouter
= specialize TFlexLayouterBase
<TUIControl
>;
664 procedure uiLayoutCtl (ctl
: TUIControl
);
668 if (ctl
= nil) then exit
;
669 lay
:= TFlexLayouter
.Create();
671 if (not ctl
.mStyleLoaded
) then ctl
.updateStyle();
672 if (ctl
is TUITopWindow
) and (TUITopWindow(ctl
).fitToScreen
) then TUITopWindow(ctl
).flFitToScreen();
677 //writeln('============================'); lay.dumpFlat();
679 //writeln('=== initial ==='); lay.dump();
681 //lay.calcMaxSizeInternal(0);
684 writeln('=== after first pass ===');
688 writeln('=== after second pass ===');
693 //writeln('=== final ==='); lay.dump();
695 if (ctl
.mParent
= nil) and (ctl
is TUITopWindow
) and (TUITopWindow(ctl
).mDoCenter
) then
697 TUITopWindow(ctl
).centerInScreen();
700 // calculate full size
701 ctl
.calcFullClientSize();
704 if (ctl
.mParent
= nil) then
706 if (ctl
.mFocused
= nil) or (ctl
.mFocused
= ctl
) or (not ctl
.mFocused
.enabled
) then
708 ctl
.mFocused
:= ctl
.findFirstFocus();
718 // ////////////////////////////////////////////////////////////////////////// //
720 uiTopList
: array of TUIControl
= nil;
721 uiGrabCtl
: TUIControl
= nil;
724 procedure uiUpdateStyles ();
728 for ctl
in uiTopList
do ctl
.updateStyle();
732 procedure uiMouseEvent (var evt
: THMouseEvent
);
740 if (evt
.eaten
) or (evt
.cancelled
) then exit
;
742 ev
.x
:= trunc(ev
.x
/fuiRenderScale
);
743 ev
.y
:= trunc(ev
.y
/fuiRenderScale
);
744 ev
.dx
:= trunc(ev
.dx
/fuiRenderScale
); //FIXME
745 ev
.dy
:= trunc(ev
.dy
/fuiRenderScale
); //FIXME
747 if (uiGrabCtl
<> nil) then
749 uiGrabCtl
.mouseEvent(ev
);
750 if (ev
.release
) and ((ev
.bstate
and (not ev
.but
)) = 0) then uiGrabCtl
:= nil;
754 if (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)].enabled
) then uiTopList
[High(uiTopList
)].mouseEvent(ev
);
755 if (not ev
.eaten
) and (not ev
.cancelled
) and (ev
.press
) then
757 for f
:= High(uiTopList
) downto 0 do
759 if uiTopList
[f
].toLocal(ev
.x
, ev
.y
, lx
, ly
) then
761 if (uiTopList
[f
].enabled
) and (f
<> High(uiTopList
)) then
763 uiTopList
[High(uiTopList
)].blurred();
764 ctmp
:= uiTopList
[f
];
766 for c
:= f
+1 to High(uiTopList
) do uiTopList
[c
-1] := uiTopList
[c
];
767 uiTopList
[High(uiTopList
)] := ctmp
;
777 if (ev
.eaten
) then evt
.eat();
778 if (ev
.cancelled
) then evt
.cancel();
783 procedure uiKeyEvent (var evt
: THKeyEvent
);
788 if (evt
.eaten
) or (evt
.cancelled
) then exit
;
790 ev
.x
:= trunc(ev
.x
/fuiRenderScale
);
791 ev
.y
:= trunc(ev
.y
/fuiRenderScale
);
793 if (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)].enabled
) then uiTopList
[High(uiTopList
)].keyEvent(ev
);
794 //if (ev.release) then begin ev.eat(); exit; end;
796 if (ev
.eaten
) then evt
.eat();
797 if (ev
.cancelled
) then evt
.cancel();
808 //if (uiContext = nil) then uiContext := TGxContext.Create();
809 gxSetContext(uiContext
, fuiRenderScale
);
810 uiContext
.resetClip();
812 for f
:= 0 to High(uiTopList
) do
816 if (f
<> High(uiTopList
)) then
818 cidx
:= ctl
.getColorIndex
;
819 uiContext
.darkenRect(ctl
.x0
, ctl
.y0
, ctl
.width
, ctl
.height
, ctl
.mDarken
[cidx
]);
828 procedure uiAddWindow (ctl
: TUIControl
);
832 if (ctl
= nil) then exit
;
834 if not (ctl
is TUITopWindow
) then exit
; // alas
835 for f
:= 0 to High(uiTopList
) do
837 if (uiTopList
[f
] = ctl
) then
839 if (f
<> High(uiTopList
)) then
841 uiTopList
[High(uiTopList
)].blurred();
842 for c
:= f
+1 to High(uiTopList
) do uiTopList
[c
-1] := uiTopList
[c
];
843 uiTopList
[High(uiTopList
)] := ctl
;
849 if (Length(uiTopList
) > 0) then uiTopList
[High(uiTopList
)].blurred();
850 SetLength(uiTopList
, Length(uiTopList
)+1);
851 uiTopList
[High(uiTopList
)] := ctl
;
852 if (not ctl
.mStyleLoaded
) then ctl
.updateStyle();
857 procedure uiRemoveWindow (ctl
: TUIControl
);
861 if (ctl
= nil) then exit
;
863 if not (ctl
is TUITopWindow
) then exit
; // alas
864 for f
:= 0 to High(uiTopList
) do
866 if (uiTopList
[f
] = ctl
) then
869 for c
:= f
+1 to High(uiTopList
) do uiTopList
[c
-1] := uiTopList
[c
];
870 SetLength(uiTopList
, Length(uiTopList
)-1);
871 if (ctl
is TUITopWindow
) then
874 if assigned(TUITopWindow(ctl
).closeCB
) then TUITopWindow(ctl
).closeCB(ctl
);
876 if (TUITopWindow(ctl
).mFreeOnClose
) then scheduleKill(ctl
);
885 function uiVisibleWindow (ctl
: TUIControl
): Boolean;
890 if (ctl
= nil) then exit
;
892 if not (ctl
is TUITopWindow
) then exit
; // alas
893 for f
:= 0 to High(uiTopList
) do
895 if (uiTopList
[f
] = ctl
) then begin result
:= true; exit
; end;
900 // ////////////////////////////////////////////////////////////////////////// //
901 constructor TUIControl
.Create ();
906 procedure TUIControl
.AfterConstruction ();
914 mHeight
:= uiContext
.charHeight(' ');
922 mDrawShadow
:= false;
924 // layouter interface
925 //mDefSize := TLaySize.Create(64, uiContext.charHeight(' ')); // default size
926 mDefSize
:= TLaySize
.Create(0, 0); // default size: hidden control
927 mMaxSize
:= TLaySize
.Create(-1, -1); // maximum size
928 mPadding
:= TLaySize
.Create(0, 0);
936 mAlign
:= -1; // left/top
938 mStyleLoaded
:= false;
942 destructor TUIControl
.Destroy ();
946 if (mParent
<> nil) then
949 for f
:= 0 to High(mParent
.mChildren
) do
951 if (mParent
.mChildren
[f
] = self
) then
953 for c
:= f
+1 to High(mParent
.mChildren
) do mParent
.mChildren
[c
-1] := mParent
.mChildren
[c
];
954 SetLength(mParent
.mChildren
, Length(mParent
.mChildren
)-1);
958 for f
:= 0 to High(mChildren
) do
960 mChildren
[f
].mParent
:= nil;
967 function TUIControl
.getColorIndex (): Integer; inline;
969 if (not enabled
) then begin result
:= ClrIdxDisabled
; exit
; end;
970 // top windows: no focus hack
971 if (self
is TUITopWindow
) then
973 if (getActive
) then begin result
:= ClrIdxActive
; exit
; end;
977 // if control cannot be focused, take "active" color scheme for it (it is easier this way)
978 if (not canFocus
) or (getActive
) then begin result
:= ClrIdxActive
; exit
; end;
980 result
:= ClrIdxInactive
;
983 procedure TUIControl
.updateStyle ();
989 while (ctl
<> nil) do
991 if (Length(ctl
.mStyleId
) <> 0) then begin stl
:= uiFindStyle(ctl
.mStyleId
); break
; end;
994 if (stl
= nil) then stl
:= uiFindStyle(''); // default
996 for ctl
in mChildren
do ctl
.updateStyle();
997 mStyleLoaded
:= true;
1000 procedure TUIControl
.cacheStyle (root
: TUIStyle
);
1004 //writeln('caching style for <', className, '> (', mCtl4Style, ')...');
1007 mBackColor
[ClrIdxActive
] := root
.get('back-color', 'active', cst
).asRGBADef(TGxRGBA
.Create(0, 0, 128));
1008 mTextColor
[ClrIdxActive
] := root
.get('text-color', 'active', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
1009 mFrameColor
[ClrIdxActive
] := root
.get('frame-color', 'active', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
1010 mFrameTextColor
[ClrIdxActive
] := root
.get('frame-text-color', 'active', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
1011 mFrameIconColor
[ClrIdxActive
] := root
.get('frame-icon-color', 'active', cst
).asRGBADef(TGxRGBA
.Create(0, 255, 0));
1012 mDarken
[ClrIdxActive
] := root
.get('darken', 'active', cst
).asInt(666);
1014 mBackColor
[ClrIdxDisabled
] := root
.get('back-color', 'disabled', cst
).asRGBADef(TGxRGBA
.Create(0, 0, 128));
1015 mTextColor
[ClrIdxDisabled
] := root
.get('text-color', 'disabled', cst
).asRGBADef(TGxRGBA
.Create(127, 127, 127));
1016 mFrameColor
[ClrIdxDisabled
] := root
.get('frame-color', 'disabled', cst
).asRGBADef(TGxRGBA
.Create(127, 127, 127));
1017 mFrameTextColor
[ClrIdxDisabled
] := root
.get('frame-text-color', 'disabled', cst
).asRGBADef(TGxRGBA
.Create(127, 127, 127));
1018 mFrameIconColor
[ClrIdxDisabled
] := root
.get('frame-icon-color', 'disabled', cst
).asRGBADef(TGxRGBA
.Create(0, 127, 0));
1019 mDarken
[ClrIdxDisabled
] := root
.get('darken', 'disabled', cst
).asInt(666);
1021 mBackColor
[ClrIdxInactive
] := root
.get('back-color', 'inactive', cst
).asRGBADef(TGxRGBA
.Create(0, 0, 128));
1022 mTextColor
[ClrIdxInactive
] := root
.get('text-color', 'inactive', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
1023 mFrameColor
[ClrIdxInactive
] := root
.get('frame-color', 'inactive', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
1024 mFrameTextColor
[ClrIdxInactive
] := root
.get('frame-text-color', 'inactive', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
1025 mFrameIconColor
[ClrIdxInactive
] := root
.get('frame-icon-color', 'inactive', cst
).asRGBADef(TGxRGBA
.Create(0, 255, 0));
1026 mDarken
[ClrIdxInactive
] := root
.get('darken', 'inactive', cst
).asInt(666);
1030 // ////////////////////////////////////////////////////////////////////////// //
1031 function TUIControl
.getDefSize (): TLaySize
; inline; begin result
:= mLayDefSize
; end;
1032 function TUIControl
.getMaxSize (): TLaySize
; inline; begin result
:= mLayMaxSize
; end;
1033 function TUIControl
.getPadding (): TLaySize
; inline; begin result
:= mPadding
; end;
1034 function TUIControl
.getFlex (): Integer; inline; begin result
:= mFlex
; end;
1035 function TUIControl
.isHorizBox (): Boolean; inline; begin result
:= mHoriz
; end;
1036 function TUIControl
.noPad (): Boolean; inline; begin result
:= mNoPad
; end;
1037 function TUIControl
.getAlign (): Integer; inline; begin result
:= mAlign
; end;
1038 function TUIControl
.getExpand (): Boolean; inline; begin result
:= mExpand
; end;
1039 function TUIControl
.getHGroup (): AnsiString; inline; begin result
:= mHGroup
; end;
1040 function TUIControl
.getVGroup (): AnsiString; inline; begin result
:= mVGroup
; end;
1041 function TUIControl
.getMargins (): TLayMargins
; inline; begin result
:= TLayMargins
.Create(mFrameHeight
, mFrameWidth
, mFrameHeight
, mFrameWidth
); end;
1043 procedure TUIControl
.setActualSizePos (constref apos
: TLayPos
; constref asize
: TLaySize
); inline;
1045 //writeln(self.className, '; pos=', apos.toString, '; size=', asize.toString);
1046 if (mParent
<> nil) then
1053 if (mLayMaxSize
.w
>= 0) then mWidth
:= nmin(mWidth
, mLayMaxSize
.w
);
1054 if (mLayMaxSize
.h
>= 0) then mHeight
:= nmin(mHeight
, mLayMaxSize
.h
);
1057 procedure TUIControl
.layPrepare ();
1059 mLayDefSize
:= mDefSize
;
1060 if (mLayDefSize
.w
<> 0) or (mLayDefSize
.h
<> 0) then
1062 mLayMaxSize
:= mMaxSize
;
1063 if (mLayMaxSize
.w
>= 0) then begin mLayDefSize
.w
+= mFrameWidth
*2; mLayMaxSize
.w
+= mFrameWidth
*2; end;
1064 if (mLayMaxSize
.h
>= 0) then begin mLayDefSize
.h
+= mFrameHeight
*2; mLayMaxSize
.h
+= mFrameHeight
*2; end;
1068 mLayMaxSize
:= TLaySize
.Create(0, 0);
1073 // ////////////////////////////////////////////////////////////////////////// //
1074 function TUIControl
.parsePos (par
: TTextParser
): TLayPos
;
1076 ech
: AnsiChar = ')';
1078 if (par
.eatDelim('[')) then ech
:= ']' else par
.expectDelim('(');
1079 result
.x
:= par
.expectInt();
1080 par
.eatDelim(','); // optional comma
1081 result
.y
:= par
.expectInt();
1082 par
.eatDelim(','); // optional comma
1083 par
.expectDelim(ech
);
1086 function TUIControl
.parseSize (par
: TTextParser
): TLaySize
;
1088 ech
: AnsiChar = ')';
1090 if (par
.eatDelim('[')) then ech
:= ']' else par
.expectDelim('(');
1091 result
.w
:= par
.expectInt();
1092 par
.eatDelim(','); // optional comma
1093 result
.h
:= par
.expectInt();
1094 par
.eatDelim(','); // optional comma
1095 par
.expectDelim(ech
);
1098 function TUIControl
.parsePadding (par
: TTextParser
): TLaySize
;
1100 result
:= parseSize(par
);
1103 function TUIControl
.parseHPadding (par
: TTextParser
; def
: Integer): TLaySize
;
1108 result
.w
:= par
.expectInt();
1112 result
:= parsePadding(par
);
1116 function TUIControl
.parseVPadding (par
: TTextParser
; def
: Integer): TLaySize
;
1121 result
.h
:= par
.expectInt();
1125 result
:= parsePadding(par
);
1129 function TUIControl
.parseBool (par
: TTextParser
): Boolean;
1132 par
.eatIdOrStrCI('true') or
1133 par
.eatIdOrStrCI('yes') or
1134 par
.eatIdOrStrCI('tan');
1137 if (not par
.eatIdOrStrCI('false')) and (not par
.eatIdOrStrCI('no')) and (not par
.eatIdOrStrCI('ona')) then
1139 par
.error('boolean value expected');
1144 function TUIControl
.parseAnyAlign (par
: TTextParser
): Integer;
1146 if (par
.eatIdOrStrCI('left')) or (par
.eatIdOrStrCI('top')) then result
:= -1
1147 else if (par
.eatIdOrStrCI('right')) or (par
.eatIdOrStrCI('bottom')) then result
:= 1
1148 else if (par
.eatIdOrStrCI('center')) then result
:= 0
1149 else par
.error('invalid align value');
1152 function TUIControl
.parseHAlign (par
: TTextParser
): Integer;
1154 if (par
.eatIdOrStrCI('left')) then result
:= -1
1155 else if (par
.eatIdOrStrCI('right')) then result
:= 1
1156 else if (par
.eatIdOrStrCI('center')) then result
:= 0
1157 else par
.error('invalid horizontal align value');
1160 function TUIControl
.parseVAlign (par
: TTextParser
): Integer;
1162 if (par
.eatIdOrStrCI('top')) then result
:= -1
1163 else if (par
.eatIdOrStrCI('bottom')) then result
:= 1
1164 else if (par
.eatIdOrStrCI('center')) then result
:= 0
1165 else par
.error('invalid vertical align value');
1168 procedure TUIControl
.parseTextAlign (par
: TTextParser
; var h
, v
: Integer);
1170 wasH
: Boolean = false;
1171 wasV
: Boolean = false;
1175 if (par
.eatIdOrStrCI('left')) then
1177 if wasH
then par
.error('too many align directives');
1182 if (par
.eatIdOrStrCI('right')) then
1184 if wasH
then par
.error('too many align directives');
1189 if (par
.eatIdOrStrCI('hcenter')) then
1191 if wasH
then par
.error('too many align directives');
1196 if (par
.eatIdOrStrCI('top')) then
1198 if wasV
then par
.error('too many align directives');
1203 if (par
.eatIdOrStrCI('bottom')) then
1205 if wasV
then par
.error('too many align directives');
1210 if (par
.eatIdOrStrCI('vcenter')) then
1212 if wasV
then par
.error('too many align directives');
1217 if (par
.eatIdOrStrCI('center')) then
1219 if wasV
or wasH
then par
.error('too many align directives');
1228 if not wasV
and not wasH
then par
.error('invalid align value');
1231 function TUIControl
.parseOrientation (const prname
: AnsiString; par
: TTextParser
): Boolean;
1233 if (strEquCI1251(prname
, 'orientation')) or (strEquCI1251(prname
, 'orient')) then
1235 if (par
.eatIdOrStrCI('horizontal')) or (par
.eatIdOrStrCI('horiz')) then mHoriz
:= true
1236 else if (par
.eatIdOrStrCI('vertical')) or (par
.eatIdOrStrCI('vert')) then mHoriz
:= false
1237 else par
.error('`horizontal` or `vertical` expected');
1246 // par should be on '{'; final '}' is eaten
1247 procedure TUIControl
.parseProperties (par
: TTextParser
);
1251 if (not par
.eatDelim('{')) then exit
;
1252 while (not par
.eatDelim('}')) do
1254 if (not par
.isIdOrStr
) then par
.error('property name expected');
1257 par
.eatDelim(':'); // optional
1258 if not parseProperty(pn
, par
) then par
.errorfmt('invalid property name ''%s''', [pn
]);
1259 par
.eatDelim(','); // optional
1263 // par should be on '{'
1264 procedure TUIControl
.parseChildren (par
: TTextParser
);
1266 cc
: TUIControlClass
;
1269 par
.expectDelim('{');
1270 while (not par
.eatDelim('}')) do
1272 if (not par
.isIdOrStr
) then par
.error('control name expected');
1273 cc
:= findCtlClass(par
.tokStr
);
1274 if (cc
= nil) then par
.errorfmt('unknown control name: ''%s''', [par
.tokStr
]);
1275 //writeln('children for <', par.tokStr, '>: <', cc.className, '>');
1277 par
.eatDelim(':'); // optional
1279 //writeln(' mHoriz=', ctl.mHoriz);
1281 ctl
.parseProperties(par
);
1286 //writeln(': ', ctl.mDefSize.toString);
1288 par
.eatDelim(','); // optional
1293 function TUIControl
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
1296 if (strEquCI1251(prname
, 'id')) then begin mId
:= par
.expectIdOrStr(true); exit
; end; // allow empty strings
1297 if (strEquCI1251(prname
, 'style')) then begin mStyleId
:= par
.expectIdOrStr(); exit
; end; // no empty strings
1298 if (strEquCI1251(prname
, 'flex')) then begin flex
:= par
.expectInt(); exit
; end;
1300 if (strEquCI1251(prname
, 'defsize')) or (strEquCI1251(prname
, 'size')) then begin mDefSize
:= parseSize(par
); exit
; end;
1301 if (strEquCI1251(prname
, 'maxsize')) then begin mMaxSize
:= parseSize(par
); exit
; end;
1302 if (strEquCI1251(prname
, 'defwidth')) or (strEquCI1251(prname
, 'width')) then begin mDefSize
.w
:= par
.expectInt(); exit
; end;
1303 if (strEquCI1251(prname
, 'defheight')) or (strEquCI1251(prname
, 'height')) then begin mDefSize
.h
:= par
.expectInt(); exit
; end;
1304 if (strEquCI1251(prname
, 'maxwidth')) then begin mMaxSize
.w
:= par
.expectInt(); exit
; end;
1305 if (strEquCI1251(prname
, 'maxheight')) then begin mMaxSize
.h
:= par
.expectInt(); exit
; end;
1307 if (strEquCI1251(prname
, 'padding')) then begin mPadding
:= parsePadding(par
); exit
; end;
1308 if (strEquCI1251(prname
, 'nopad')) then begin mNoPad
:= true; exit
; end;
1310 if (strEquCI1251(prname
, 'expand')) then begin mExpand
:= parseBool(par
); exit
; end;
1312 if (strEquCI1251(prname
, 'align')) then begin mAlign
:= parseAnyAlign(par
); exit
; end;
1313 if (strEquCI1251(prname
, 'hgroup')) then begin mHGroup
:= par
.expectIdOrStr(true); exit
; end; // allow empty strings
1314 if (strEquCI1251(prname
, 'vgroup')) then begin mVGroup
:= par
.expectIdOrStr(true); exit
; end; // allow empty strings
1316 if (strEquCI1251(prname
, 'canfocus')) then begin mCanFocus
:= true; exit
; end;
1317 if (strEquCI1251(prname
, 'nofocus')) then begin mCanFocus
:= false; exit
; end;
1318 if (strEquCI1251(prname
, 'disabled')) then begin mEnabled
:= false; exit
; end;
1319 if (strEquCI1251(prname
, 'enabled')) then begin mEnabled
:= true; exit
; end;
1320 if (strEquCI1251(prname
, 'escclose')) then begin mEscClose
:= not parseBool(par
); exit
; end;
1321 if (strEquCI1251(prname
, 'default')) then begin mDefault
:= true; exit
; end;
1322 if (strEquCI1251(prname
, 'cancel')) then begin mCancel
:= true; exit
; end;
1327 // ////////////////////////////////////////////////////////////////////////// //
1328 procedure TUIControl
.activated ();
1330 makeVisibleInParent();
1334 procedure TUIControl
.blurred ();
1336 if (uiGrabCtl
= self
) then uiGrabCtl
:= nil;
1340 procedure TUIControl
.calcFullClientSize ();
1344 mFullSize
:= TLaySize
.Create(0, 0);
1345 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1346 for ctl
in mChildren
do
1348 ctl
.calcFullClientSize();
1349 mFullSize
.w
:= nmax(mFullSize
.w
, ctl
.mX
-mFrameWidth
+ctl
.mFullSize
.w
);
1350 mFullSize
.h
:= nmax(mFullSize
.h
, ctl
.mY
-mFrameHeight
+ctl
.mFullSize
.h
);
1352 mFullSize
.w
:= nmax(mFullSize
.w
, mWidth
-mFrameWidth
*2);
1353 mFullSize
.h
:= nmax(mFullSize
.h
, mHeight
-mFrameHeight
*2);
1357 function TUIControl
.topLevel (): TUIControl
; inline;
1360 while (result
.mParent
<> nil) do result
:= result
.mParent
;
1364 function TUIControl
.getEnabled (): Boolean;
1369 if (not mEnabled
) then exit
;
1371 while (ctl
<> nil) do
1373 if (not ctl
.mEnabled
) then exit
;
1380 procedure TUIControl
.setEnabled (v
: Boolean); inline;
1382 if (mEnabled
= v
) then exit
;
1384 if (not v
) and focused
then setFocused(false);
1388 function TUIControl
.getFocused (): Boolean; inline;
1390 if (mParent
= nil) then
1392 result
:= (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)] = self
);
1396 result
:= (topLevel
.mFocused
= self
);
1397 if (result
) then result
:= (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)] = topLevel
);
1402 function TUIControl
.getActive (): Boolean; inline;
1406 if (mParent
= nil) then
1408 result
:= (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)] = self
);
1412 ctl
:= topLevel
.mFocused
;
1413 while (ctl
<> nil) and (ctl
<> self
) do ctl
:= ctl
.mParent
;
1414 result
:= (ctl
= self
);
1415 if (result
) then result
:= (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)] = topLevel
);
1420 procedure TUIControl
.setFocused (v
: Boolean); inline;
1427 if (tl
.mFocused
= self
) then
1429 blurred(); // this will reset grab, but still...
1430 if (uiGrabCtl
= self
) then uiGrabCtl
:= nil;
1431 tl
.mFocused
:= tl
.findNextFocus(self
, true);
1432 if (tl
.mFocused
= self
) then tl
.mFocused
:= nil;
1433 if (tl
.mFocused
<> nil) then tl
.mFocused
.activated();
1437 if (not canFocus
) then exit
;
1438 if (tl
.mFocused
<> self
) then
1440 if (tl
.mFocused
<> nil) then tl
.mFocused
.blurred();
1441 tl
.mFocused
:= self
;
1442 if (uiGrabCtl
<> self
) then uiGrabCtl
:= nil;
1448 function TUIControl
.getCanFocus (): Boolean; inline;
1450 result
:= (getEnabled
) and (mCanFocus
) and (mWidth
> 0) and (mHeight
> 0);
1454 function TUIControl
.isMyChild (ctl
: TUIControl
): Boolean;
1457 while (ctl
<> nil) do
1459 if (ctl
.mParent
= self
) then exit
;
1466 // returns `true` if global coords are inside this control
1467 function TUIControl
.toLocal (var x
, y
: Integer): Boolean;
1469 if (mParent
= nil) then
1473 result
:= true; // hack
1477 result
:= mParent
.toLocal(x
, y
);
1478 Inc(x
, mParent
.mScrollX
);
1479 Inc(y
, mParent
.mScrollY
);
1482 if result
then result
:= (x
>= 0) and (y
>= 0) and (x
< mParent
.mWidth
) and (y
< mParent
.mHeight
);
1484 if result
then result
:= (x
>= 0) and (y
>= 0) and (x
< mWidth
) and (y
< mHeight
);
1487 function TUIControl
.toLocal (gx
, gy
: Integer; out x
, y
: Integer): Boolean; inline;
1491 result
:= toLocal(x
, y
);
1495 procedure TUIControl
.toGlobal (var x
, y
: Integer);
1499 if (mParent
<> nil) then
1501 Dec(x
, mParent
.mScrollX
);
1502 Dec(y
, mParent
.mScrollY
);
1503 mParent
.toGlobal(x
, y
);
1507 procedure TUIControl
.toGlobal (lx
, ly
: Integer; out x
, y
: Integer); inline;
1514 procedure TUIControl
.getDrawRect (out gx
, gy
, wdt
, hgt
: Integer);
1518 if (mParent
= nil) then
1527 toGlobal(0, 0, cgx
, cgy
);
1528 mParent
.getDrawRect(gx
, gy
, wdt
, hgt
);
1529 if (wdt
> 0) and (hgt
> 0) then
1531 if (not intersectRect(gx
, gy
, wdt
, hgt
, cgx
, cgy
, mWidth
, mHeight
)) then
1541 // x and y are global coords
1542 function TUIControl
.controlAtXY (x
, y
: Integer; allowDisabled
: Boolean=false): TUIControl
;
1548 if (not allowDisabled
) and (not enabled
) then exit
;
1549 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1550 if not toLocal(x
, y
, lx
, ly
) then exit
;
1551 for f
:= High(mChildren
) downto 0 do
1553 result
:= mChildren
[f
].controlAtXY(x
, y
, allowDisabled
);
1554 if (result
<> nil) then exit
;
1560 function TUIControl
.parentScrollX (): Integer; inline; begin if (mParent
<> nil) then result
:= mParent
.mScrollX
else result
:= 0; end;
1561 function TUIControl
.parentScrollY (): Integer; inline; begin if (mParent
<> nil) then result
:= mParent
.mScrollY
else result
:= 0; end;
1564 procedure TUIControl
.makeVisibleInParent ();
1566 sy
, ey
, cy
: Integer;
1569 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1571 if (p
= nil) then exit
;
1572 if (p
.mFullSize
.w
< 1) or (p
.mFullSize
.h
< 1) then
1578 p
.makeVisibleInParent();
1579 cy
:= mY
-p
.mFrameHeight
;
1581 ey
:= sy
+(p
.mHeight
-p
.mFrameHeight
*2);
1584 p
.mScrollY
:= nmax(0, cy
);
1586 else if (cy
+mHeight
> ey
) then
1588 p
.mScrollY
:= nmax(0, cy
+mHeight
-(p
.mHeight
-p
.mFrameHeight
*2));
1593 // ////////////////////////////////////////////////////////////////////////// //
1594 function TUIControl
.prevSibling (): TUIControl
;
1598 if (mParent
<> nil) then
1600 for f
:= 1 to High(mParent
.mChildren
) do
1602 if (mParent
.mChildren
[f
] = self
) then begin result
:= mParent
.mChildren
[f
-1]; exit
; end;
1608 function TUIControl
.nextSibling (): TUIControl
;
1612 if (mParent
<> nil) then
1614 for f
:= 0 to High(mParent
.mChildren
)-1 do
1616 if (mParent
.mChildren
[f
] = self
) then begin result
:= mParent
.mChildren
[f
+1]; exit
; end;
1622 function TUIControl
.firstChild (): TUIControl
; inline;
1624 if (Length(mChildren
) <> 0) then result
:= mChildren
[0] else result
:= nil;
1627 function TUIControl
.lastChild (): TUIControl
; inline;
1629 if (Length(mChildren
) <> 0) then result
:= mChildren
[High(mChildren
)] else result
:= nil;
1633 function TUIControl
.findFirstFocus (): TUIControl
;
1640 for f
:= 0 to High(mChildren
) do
1642 result
:= mChildren
[f
].findFirstFocus();
1643 if (result
<> nil) then exit
;
1645 if (canFocus
) then result
:= self
;
1650 function TUIControl
.findLastFocus (): TUIControl
;
1657 for f
:= High(mChildren
) downto 0 do
1659 result
:= mChildren
[f
].findLastFocus();
1660 if (result
<> nil) then exit
;
1662 if (canFocus
) then result
:= self
;
1667 function TUIControl
.findNextFocus (cur
: TUIControl
; wrap
: Boolean): TUIControl
;
1669 curHit
: Boolean = false;
1671 function checkFocus (ctl
: TUIControl
): Boolean;
1675 result
:= (ctl
.canFocus
);
1679 curHit
:= (ctl
= cur
);
1680 result
:= false; // don't stop
1688 if not isMyChild(cur
) then
1690 result
:= findFirstFocus();
1694 result
:= forEachControl(checkFocus
);
1695 if (result
= nil) and (wrap
) then result
:= findFirstFocus();
1701 function TUIControl
.findPrevFocus (cur
: TUIControl
; wrap
: Boolean): TUIControl
;
1703 lastCtl
: TUIControl
= nil;
1705 function checkFocus (ctl
: TUIControl
): Boolean;
1714 if (ctl
.canFocus
) then lastCtl
:= ctl
;
1722 if not isMyChild(cur
) then
1724 result
:= findLastFocus();
1728 forEachControl(checkFocus
);
1729 if (lastCtl
= nil) and (wrap
) then lastCtl
:= findLastFocus();
1731 //if (lastCtl <> nil) then writeln('ctl<', lastCtl.className, '>: {', lastCtl.id, '}');
1737 function TUIControl
.findDefaulControl (): TUIControl
;
1743 if (mDefault
) then begin result
:= self
; exit
; end;
1744 for ctl
in mChildren
do
1746 result
:= ctl
.findDefaulControl();
1747 if (result
<> nil) then exit
;
1753 function TUIControl
.findCancelControl (): TUIControl
;
1759 if (mCancel
) then begin result
:= self
; exit
; end;
1760 for ctl
in mChildren
do
1762 result
:= ctl
.findCancelControl();
1763 if (result
<> nil) then exit
;
1770 function TUIControl
.findControlById (const aid
: AnsiString): TUIControl
;
1774 if (strEquCI1251(aid
, mId
)) then begin result
:= self
; exit
; end;
1775 for ctl
in mChildren
do
1777 result
:= ctl
.findControlById(aid
);
1778 if (result
<> nil) then exit
;
1784 procedure TUIControl
.appendChild (ctl
: TUIControl
);
1786 if (ctl
= nil) then exit
;
1787 if (ctl
.mParent
<> nil) then exit
;
1788 SetLength(mChildren
, Length(mChildren
)+1);
1789 mChildren
[High(mChildren
)] := ctl
;
1790 ctl
.mParent
:= self
;
1791 Inc(ctl
.mX
, mFrameWidth
);
1792 Inc(ctl
.mY
, mFrameHeight
);
1793 if (ctl
.mWidth
> 0) and (ctl
.mHeight
> 0) and
1794 (ctl
.mX
+ctl
.mWidth
> mFrameWidth
) and (ctl
.mY
+ctl
.mHeight
> mFrameHeight
) then
1796 if (mWidth
+mFrameWidth
< ctl
.mX
+ctl
.mWidth
) then mWidth
:= ctl
.mX
+ctl
.mWidth
+mFrameWidth
;
1797 if (mHeight
+mFrameHeight
< ctl
.mY
+ctl
.mHeight
) then mHeight
:= ctl
.mY
+ctl
.mHeight
+mFrameHeight
;
1802 function TUIControl
.setActionCBFor (const aid
: AnsiString; cb
: TActionCB
): TActionCB
;
1807 if (ctl
<> nil) then
1809 result
:= ctl
.actionCB
;
1819 function TUIControl
.forEachChildren (cb
: TCtlEnumCB
): TUIControl
;
1824 if (not assigned(cb
)) then exit
;
1825 for ctl
in mChildren
do
1827 if cb(ctl
) then begin result
:= ctl
; exit
; end;
1832 function TUIControl
.forEachControl (cb
: TCtlEnumCB
; includeSelf
: Boolean=true): TUIControl
;
1834 function forChildren (p
: TUIControl
; incSelf
: Boolean): TUIControl
;
1839 if (p
= nil) then exit
;
1840 if (incSelf
) and (cb(p
)) then begin result
:= p
; exit
; end;
1841 for ctl
in p
.mChildren
do
1843 result
:= forChildren(ctl
, true);
1844 if (result
<> nil) then break
;
1850 if (not assigned(cb
)) then exit
;
1851 result
:= forChildren(self
, includeSelf
);
1855 procedure TUIControl
.close (); // this closes *top-level* control
1860 uiRemoveWindow(ctl
);
1861 if (ctl
is TUITopWindow
) and (TUITopWindow(ctl
).mFreeOnClose
) then scheduleKill(ctl
); // just in case
1865 procedure TUIControl
.doAction ();
1867 if assigned(actionCB
) then actionCB(self
);
1871 // ////////////////////////////////////////////////////////////////////////// //
1872 procedure TUIControl
.setScissor (lx
, ly
, lw
, lh
: Integer);
1874 gx
, gy
, wdt
, hgt
, cgx
, cgy
: Integer;
1876 if (not intersectRect(lx
, ly
, lw
, lh
, 0, 0, mWidth
, mHeight
)) then
1878 uiContext
.clip
:= TGxRect
.Create(0, 0, 0, 0);
1882 getDrawRect(gx
, gy
, wdt
, hgt
);
1884 toGlobal(lx
, ly
, cgx
, cgy
);
1885 if (not intersectRect(gx
, gy
, wdt
, hgt
, cgx
, cgy
, lw
, lh
)) then
1887 uiContext
.clip
:= TGxRect
.Create(0, 0, 0, 0);
1891 uiContext
.clip
:= savedClip
;
1892 uiContext
.combineClip(TGxRect
.Create(gx
, gy
, wdt
, hgt
));
1893 //uiContext.clip := TGxRect.Create(gx, gy, wdt, hgt);
1898 // ////////////////////////////////////////////////////////////////////////// //
1899 procedure TUIControl
.drawFrame (gx
, gy
, resx
, thalign
: Integer; const text: AnsiString; dbl
: Boolean);
1901 cidx
, tx
, tw
: Integer;
1903 if (mFrameWidth
< 1) or (mFrameHeight
< 1) then exit
;
1904 cidx
:= getColorIndex
;
1905 uiContext
.color
:= mFrameColor
[cidx
];
1906 case mFrameHeight
of
1911 uiContext
.rect(gx
+3, gy
+3, mWidth
-6, mHeight
-6);
1912 uiContext
.rect(gx
+5, gy
+5, mWidth
-10, mHeight
-10);
1916 uiContext
.rect(gx
+4, gy
+4, mWidth
-8, mHeight
-8);
1923 uiContext
.rect(gx
+3, gy
+3+3, mWidth
-6, mHeight
-6-6);
1924 uiContext
.rect(gx
+5, gy
+5+3, mWidth
-10, mHeight
-10-6);
1928 uiContext
.rect(gx
+4, gy
+4+3, mWidth
-8, mHeight
-8-6);
1935 uiContext
.rect(gx
+3, gy
+3+4, mWidth
-6, mHeight
-6-8);
1936 uiContext
.rect(gx
+5, gy
+5+4, mWidth
-10, mHeight
-10-8);
1940 uiContext
.rect(gx
+4, gy
+4+4, mWidth
-8, mHeight
-8-8);
1956 if (Length(text) > 0) then
1958 if (resx
< 0) then resx
:= 0;
1959 tw
:= uiContext
.textWidth(text);
1960 setScissor(mFrameWidth
+resx
, 0, mWidth
-mFrameWidth
*2-resx
, mFrameHeight
);
1961 if (thalign
< 0) then tx
:= gx
+resx
+mFrameWidth
+2
1962 else if (thalign
> 0) then tx
:= gx
+mWidth
-mFrameWidth
-1-tw
1963 else tx
:= (gx
+resx
+mFrameWidth
)+(mWidth
-mFrameWidth
*2-resx
-tw
) div 2;
1964 uiContext
.color
:= mBackColor
[cidx
];
1965 uiContext
.fillRect(tx
-2, gy
, tw
+4, mFrameHeight
);
1966 uiContext
.color
:= mFrameTextColor
[cidx
];
1967 uiContext
.drawText(tx
, gy
, text);
1972 procedure TUIControl
.draw ();
1977 procedure resetScissor (fullArea
: Boolean); inline;
1979 uiContext
.clip
:= savedClip
;
1980 if (fullArea
) or ((mFrameWidth
= 0) and (mFrameHeight
= 0)) then
1982 setScissor(0, 0, mWidth
, mHeight
);
1986 //writeln('frm: (', mFrameWidth, 'x', mFrameHeight, ')');
1987 setScissor(mFrameWidth
, mFrameHeight
, mWidth
-mFrameWidth
*2, mHeight
-mFrameHeight
*2);
1992 if (mWidth
< 1) or (mHeight
< 1) or (uiContext
= nil) or (not uiContext
.active
) then exit
;
1993 toGlobal(0, 0, gx
, gy
);
1995 savedClip
:= uiContext
.clip
;
1997 resetScissor(true); // full area
1998 drawControl(gx
, gy
);
1999 resetScissor(false); // client area
2000 for f
:= 0 to High(mChildren
) do mChildren
[f
].draw();
2001 resetScissor(true); // full area
2002 if (self
is TUISwitchBox
) then
2004 uiContext
.color
:= TGxRGBA
.Create(255, 0, 0, 255);
2005 //uiContext.fillRect(gx, gy, mWidth, mHeight);
2006 //writeln('frm: (', mFrameWidth, 'x', mFrameHeight, '); sz=(', mWidth, 'x', mHeight, '); clip=', uiContext.clip.toString);
2008 if false and (mId
= 'cbtest') then
2010 uiContext
.color
:= TGxRGBA
.Create(255, 127, 0, 96);
2011 uiContext
.fillRect(gx
, gy
, mWidth
, mHeight
);
2012 if (mFrameWidth
> 0) and (mFrameHeight
> 0) then
2014 uiContext
.color
:= TGxRGBA
.Create(255, 255, 0, 96);
2015 uiContext
.fillRect(gx
+mFrameWidth
, gy
+mFrameHeight
, mWidth
-mFrameWidth
*2, mHeight
-mFrameHeight
*2);
2018 else if false and (self
is TUISwitchBox
) then
2020 uiContext
.color
:= TGxRGBA
.Create(255, 0, 0, 255);
2021 uiContext
.fillRect(gx
, gy
, mWidth
, mHeight
);
2022 //writeln('frm: (', mFrameWidth, 'x', mFrameHeight, ')');
2024 drawControlPost(gx
, gy
);
2026 uiContext
.clip
:= savedClip
;
2030 procedure TUIControl
.drawControl (gx
, gy
: Integer);
2032 //if (mParent = nil) then darkenRect(gx, gy, mWidth, mHeight, 64);
2035 procedure TUIControl
.drawControlPost (gx
, gy
: Integer);
2038 if (mParent
= nil) and (mDrawShadow
) and (mWidth
> 0) and (mHeight
> 0) then
2040 //setScissorGLInternal(gx+8, gy+8, mWidth, mHeight);
2041 uiContext
.resetClip();
2042 uiContext
.darkenRect(gx
+mWidth
, gy
+8, 8, mHeight
, 128);
2043 uiContext
.darkenRect(gx
+8, gy
+mHeight
, mWidth
-8, 8, 128);
2048 // ////////////////////////////////////////////////////////////////////////// //
2049 procedure TUIControl
.mouseEvent (var ev
: THMouseEvent
);
2053 if (not enabled
) then exit
;
2054 if (mWidth
< 1) or (mHeight
< 1) then exit
;
2055 ctl
:= controlAtXY(ev
.x
, ev
.y
);
2056 if (ctl
= nil) then exit
;
2057 if (ctl
.canFocus
) and (ev
.press
) then
2059 if (ctl
<> topLevel
.mFocused
) then ctl
.setFocused(true);
2062 if (ctl
<> self
) then ctl
.mouseEvent(ev
);
2067 procedure TUIControl
.keyEvent (var ev
: THKeyEvent
);
2069 function doPreKey (ctl
: TUIControl
): Boolean;
2071 if (not ctl
.enabled
) then begin result
:= false; exit
; end;
2072 ctl
.keyEventPre(ev
);
2073 result
:= (ev
.eaten
) or (ev
.cancelled
); // stop if event was consumed
2076 function doPostKey (ctl
: TUIControl
): Boolean;
2078 if (not ctl
.enabled
) then begin result
:= false; exit
; end;
2079 ctl
.keyEventPost(ev
);
2080 result
:= (ev
.eaten
) or (ev
.cancelled
); // stop if event was consumed
2086 if (not enabled
) then exit
;
2087 if (ev
.eaten
) or (ev
.cancelled
) then exit
;
2089 if (mParent
= nil) then
2091 forEachControl(doPreKey
);
2092 if (ev
.eaten
) or (ev
.cancelled
) then exit
;
2094 // focused control should process keyboard first
2095 if (topLevel
.mFocused
<> self
) and isMyChild(topLevel
.mFocused
) and (topLevel
.mFocused
.enabled
) then
2097 // bubble keyboard event
2098 ctl
:= topLevel
.mFocused
;
2099 while (ctl
<> nil) and (ctl
<> self
) do
2102 if (ev
.eaten
) or (ev
.cancelled
) then exit
;
2106 // for top-level controls
2107 if (mParent
= nil) then
2109 if (ev
= 'S-Tab') then
2111 ctl
:= findPrevFocus(mFocused
, true);
2112 if (ctl
<> nil) and (ctl
<> mFocused
) then ctl
.setFocused(true);
2116 if (ev
= 'Tab') then
2118 ctl
:= findNextFocus(mFocused
, true);
2119 if (ctl
<> nil) and (ctl
<> mFocused
) then ctl
.setFocused(true);
2123 if (ev
= 'Enter') or (ev
= 'C-Enter') then
2125 ctl
:= findDefaulControl();
2126 if (ctl
<> nil) then
2133 if (ev
= 'Escape') then
2135 ctl
:= findCancelControl();
2136 if (ctl
<> nil) then
2143 if mEscClose
and (ev
= 'Escape') then
2145 if (not assigned(closeRequestCB
)) or (closeRequestCB(self
)) then
2147 uiRemoveWindow(self
);
2153 if (ev
.eaten
) or (ev
.cancelled
) then exit
;
2154 forEachControl(doPostKey
);
2159 procedure TUIControl
.keyEventPre (var ev
: THKeyEvent
);
2164 procedure TUIControl
.keyEventPost (var ev
: THKeyEvent
);
2169 // ////////////////////////////////////////////////////////////////////////// //
2170 constructor TUITopWindow
.Create (const atitle
: AnsiString);
2177 procedure TUITopWindow
.AfterConstruction ();
2180 mFitToScreen
:= true;
2182 mFrameHeight
:= uiContext
.charHeight(#184);
2183 if (mWidth
< mFrameWidth
*2+uiContext
.iconWinWidth(TGxContext
.TWinIcon
.Close
)) then mWidth
:= mFrameWidth
*2+uiContext
.iconWinWidth(TGxContext
.TWinIcon
.Close
);
2184 if (mHeight
< mFrameHeight
*2) then mHeight
:= mFrameHeight
*2;
2185 if (Length(mTitle
) > 0) then
2187 if (mWidth
< uiContext
.textWidth(mTitle
)+mFrameWidth
*2+uiContext
.iconWinWidth(TGxContext
.TWinIcon
.Close
)) then
2189 mWidth
:= uiContext
.textWidth(mTitle
)+mFrameWidth
*2+uiContext
.iconWinWidth(TGxContext
.TWinIcon
.Close
);
2193 mDragScroll
:= TXMode
.None
;
2194 mDrawShadow
:= true;
2195 mWaitingClose
:= false;
2198 mCtl4Style
:= 'window';
2199 mDefSize
.w
:= nmax(1, mDefSize
.w
);
2200 mDefSize
.h
:= nmax(1, mDefSize
.h
);
2204 function TUITopWindow
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2206 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) then
2208 mTitle
:= par
.expectIdOrStr(true);
2212 if (strEquCI1251(prname
, 'children')) then
2218 if (strEquCI1251(prname
, 'position')) then
2220 if (par
.eatIdOrStrCI('default')) then mDoCenter
:= false
2221 else if (par
.eatIdOrStrCI('center')) then mDoCenter
:= true
2222 else par
.error('`center` or `default` expected');
2226 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
2227 result
:= inherited parseProperty(prname
, par
);
2231 procedure TUITopWindow
.flFitToScreen ();
2235 nsz
:= TLaySize
.Create(trunc(fuiScrWdt
/fuiRenderScale
)-mFrameWidth
*2-6, trunc(fuiScrHgt
/fuiRenderScale
)-mFrameHeight
*2-6);
2236 if (mMaxSize
.w
< 1) then mMaxSize
.w
:= nsz
.w
;
2237 if (mMaxSize
.h
< 1) then mMaxSize
.h
:= nsz
.h
;
2241 procedure TUITopWindow
.centerInScreen ();
2243 if (mWidth
> 0) and (mHeight
> 0) then
2245 mX
:= trunc((fuiScrWdt
/fuiRenderScale
-mWidth
)/2);
2246 mY
:= trunc((fuiScrHgt
/fuiRenderScale
-mHeight
)/2);
2251 procedure TUITopWindow
.drawControl (gx
, gy
: Integer);
2253 uiContext
.color
:= mBackColor
[getColorIndex
];
2254 uiContext
.fillRect(gx
, gy
, mWidth
, mHeight
);
2257 procedure TUITopWindow
.drawControlPost (gx
, gy
: Integer);
2260 hgt
, sbhgt
, iwdt
, ihgt
: Integer;
2262 cidx
:= getColorIndex
;
2263 iwdt
:= uiContext
.iconWinWidth(TGxContext
.TWinIcon
.Close
);
2264 if (mDragScroll
= TXMode
.Drag
) then
2266 //uiContext.color := mFrameColor[cidx];
2267 drawFrame(gx
, gy
, iwdt
, 0, mTitle
, false);
2271 ihgt
:= uiContext
.iconWinHeight(TGxContext
.TWinIcon
.Close
);
2272 //uiContext.color := mFrameColor[cidx];
2273 drawFrame(gx
, gy
, iwdt
, 0, mTitle
, true);
2274 // vertical scroll bar
2275 hgt
:= mHeight
-mFrameHeight
*2;
2276 if (hgt
> 0) and (mFullSize
.h
> hgt
) then
2278 //writeln(mTitle, ': height=', mHeight-mFrameHeight*2, '; fullsize=', mFullSize.toString);
2279 sbhgt
:= mHeight
-mFrameHeight
*2+2;
2280 uiContext
.fillRect(gx
+mWidth
-mFrameWidth
+1, gy
+mFrameHeight
-1, mFrameWidth
-3, sbhgt
);
2282 if (hgt
> mFullSize
.h
) then hgt
:= mFullSize
.h
;
2283 hgt
:= sbhgt
*hgt
div mFullSize
.h
;
2286 setScissor(mWidth
-mFrameWidth
+1, mFrameHeight
-1, mFrameWidth
-3, sbhgt
);
2287 uiContext
.darkenRect(gx
+mWidth
-mFrameWidth
+1, gy
+mFrameHeight
-1+hgt
, mFrameWidth
-3, sbhgt
, 128);
2291 setScissor(mFrameWidth
, 0, iwdt
, ihgt
);
2292 uiContext
.color
:= mBackColor
[cidx
];
2293 uiContext
.fillRect(gx
+mFrameWidth
, gy
, iwdt
, ihgt
);
2294 uiContext
.color
:= mFrameIconColor
[cidx
];
2295 uiContext
.drawIconWin(TGxContext
.TWinIcon
.Close
, gx
+mFrameWidth
, gy
, mInClose
);
2298 inherited drawControlPost(gx
, gy
);
2302 procedure TUITopWindow
.activated ();
2304 if (mFocused
= nil) or (mFocused
= self
) then
2306 mFocused
:= findFirstFocus();
2308 if (mFocused
<> nil) and (mFocused
<> self
) then mFocused
.activated();
2313 procedure TUITopWindow
.blurred ();
2315 mDragScroll
:= TXMode
.None
;
2316 mWaitingClose
:= false;
2318 if (mFocused
<> nil) and (mFocused
<> self
) then mFocused
.blurred();
2323 procedure TUITopWindow
.keyEvent (var ev
: THKeyEvent
);
2325 inherited keyEvent(ev
);
2326 if (ev
.eaten
) or (ev
.cancelled
) or (not enabled
) {or (not getFocused)} then exit
;
2327 if (ev
= 'M-F3') then
2329 if (not assigned(closeRequestCB
)) or (closeRequestCB(self
)) then
2331 uiRemoveWindow(self
);
2339 procedure TUITopWindow
.mouseEvent (var ev
: THMouseEvent
);
2342 hgt
, sbhgt
: Integer;
2344 if (not enabled
) then exit
;
2345 if (mWidth
< 1) or (mHeight
< 1) then exit
;
2347 if (mDragScroll
= TXMode
.Drag
) then
2349 mX
+= ev
.x
-mDragStartX
;
2350 mY
+= ev
.y
-mDragStartY
;
2351 mDragStartX
:= ev
.x
;
2352 mDragStartY
:= ev
.y
;
2353 if (ev
.release
) and (ev
.but
= ev
.Left
) then mDragScroll
:= TXMode
.None
;
2358 if (mDragScroll
= TXMode
.Scroll
) then
2360 // check for vertical scrollbar
2368 sbhgt
:= mHeight
-mFrameHeight
*2+2;
2369 hgt
:= mHeight
-mFrameHeight
*2;
2370 if (hgt
> 0) and (mFullSize
.h
> hgt
) then
2372 hgt
:= (mFullSize
.h
*(ly
-7) div (sbhgt
-1))-(mHeight
-mFrameHeight
*2);
2373 mScrollY
:= nmax(0, hgt
);
2374 hgt
:= mHeight
-mFrameHeight
*2;
2375 if (mScrollY
+hgt
> mFullSize
.h
) then mScrollY
:= nmax(0, mFullSize
.h
-hgt
);
2378 if (ev
.release
) and (ev
.but
= ev
.Left
) then mDragScroll
:= TXMode
.None
;
2383 if toLocal(ev
.x
, ev
.y
, lx
, ly
) then
2387 if (ly
< mFrameHeight
) then
2390 if (lx
>= mFrameWidth
) and (lx
< mFrameWidth
+uiContext
.iconWinWidth(TGxContext
.TWinIcon
.Close
)) then
2392 //uiRemoveWindow(self);
2393 mWaitingClose
:= true;
2398 mDragScroll
:= TXMode
.Drag
;
2399 mDragStartX
:= ev
.x
;
2400 mDragStartY
:= ev
.y
;
2405 // check for vertical scrollbar
2406 if (lx
>= mWidth
-mFrameWidth
+1) and (ly
>= 7) and (ly
< mHeight
-mFrameHeight
+1) then
2408 sbhgt
:= mHeight
-mFrameHeight
*2+2;
2409 hgt
:= mHeight
-mFrameHeight
*2;
2410 if (hgt
> 0) and (mFullSize
.h
> hgt
) then
2412 hgt
:= (mFullSize
.h
*(ly
-7) div (sbhgt
-1))-(mHeight
-mFrameHeight
*2);
2413 mScrollY
:= nmax(0, hgt
);
2415 mDragScroll
:= TXMode
.Scroll
;
2421 if (lx
< mFrameWidth
) or (lx
>= mWidth
-mFrameWidth
) or (ly
>= mHeight
-mFrameHeight
) then
2424 mDragScroll
:= TXMode
.Drag
;
2425 mDragStartX
:= ev
.x
;
2426 mDragStartY
:= ev
.y
;
2432 if (ev
.release
) then
2434 if mWaitingClose
then
2436 if (lx
>= mFrameWidth
) and (lx
< mFrameWidth
+uiContext
.iconWinWidth(TGxContext
.TWinIcon
.Close
)) then
2438 if (not assigned(closeRequestCB
)) or (closeRequestCB(self
)) then
2440 uiRemoveWindow(self
);
2443 mWaitingClose
:= false;
2452 if mWaitingClose
then
2454 mInClose
:= (lx
>= mFrameWidth
) and (lx
< mFrameWidth
+uiContext
.iconWinWidth(TGxContext
.TWinIcon
.Close
));
2460 inherited mouseEvent(ev
);
2465 if (not ev
.motion
) and (mWaitingClose
) then begin ev
.eat(); mWaitingClose
:= false; exit
; end;
2470 // ////////////////////////////////////////////////////////////////////////// //
2471 constructor TUIBox
.Create (ahoriz
: Boolean);
2478 procedure TUIBox
.AfterConstruction ();
2482 mHAlign
:= -1; // left
2483 mCtl4Style
:= 'box';
2484 mDefSize
:= TLaySize
.Create(-1, -1);
2488 procedure TUIBox
.setCaption (const acap
: AnsiString);
2491 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mCaption
)+3, uiContext
.textHeight(mCaption
));
2495 procedure TUIBox
.setHasFrame (v
: Boolean);
2498 if (mHasFrame
) then begin mFrameWidth
:= 8; mFrameHeight
:= uiContext
.charHeight(#184); end else begin mFrameWidth
:= 0; mFrameHeight
:= 0; end;
2499 if (mHasFrame
) then mNoPad
:= true;
2503 function TUIBox
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2505 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
2506 if (strEquCI1251(prname
, 'padding')) then
2508 if (mHoriz
) then mPadding
:= parseHPadding(par
, 0) else mPadding
:= parseVPadding(par
, 0);
2512 if (strEquCI1251(prname
, 'frame')) then
2514 setHasFrame(parseBool(par
));
2518 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) then
2520 setCaption(par
.expectIdOrStr(true));
2524 if (strEquCI1251(prname
, 'textalign')) or (strEquCI1251(prname
, 'text-align')) then
2526 mHAlign
:= parseHAlign(par
);
2530 if (strEquCI1251(prname
, 'children')) then
2536 result
:= inherited parseProperty(prname
, par
);
2540 procedure TUIBox
.drawControl (gx
, gy
: Integer);
2545 cidx
:= getColorIndex
;
2546 uiContext
.color
:= mBackColor
[cidx
];
2547 uiContext
.fillRect(gx
, gy
, mWidth
, mHeight
);
2551 drawFrame(gx
, gy
, 0, -1, mCaption
, false);
2552 //uiContext.color := mFrameColor[cidx];
2553 //uiContext.rect(gx+3, gy+3, mWidth-6, mHeight-6);
2555 else if (Length(mCaption
) > 0) then
2558 if (mHAlign
< 0) then xpos
:= 3
2559 else if (mHAlign
> 0) then xpos
:= mWidth
-mFrameWidth
*2-uiContext
.textWidth(mCaption
)
2560 else xpos
:= (mWidth
-mFrameWidth
*2-uiContext
.textWidth(mCaption
)) div 2;
2561 xpos
+= gx
+mFrameWidth
;
2563 setScissor(mFrameWidth
+1, 0, mWidth
-mFrameWidth
-2, uiContext
.textHeight(mCaption
));
2567 uiContext.color := mBackColor[cidx];
2568 uiContext.fillRect(xpos-3, gy, uiContext.textWidth(mCaption)+4, 8);
2571 uiContext
.color
:= mFrameTextColor
[cidx
];
2572 uiContext
.drawText(xpos
, gy
, mCaption
);
2577 procedure TUIBox
.mouseEvent (var ev
: THMouseEvent
);
2581 inherited mouseEvent(ev
);
2582 if (not ev
.eaten
) and (not ev
.cancelled
) and (enabled
) and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
2589 procedure TUIBox
.keyEvent (var ev
: THKeyEvent
);
2592 cur
, ctl
: TUIControl
;
2594 inherited keyEvent(ev
);
2595 if (ev
.eaten
) or (ev
.cancelled
) or (not ev
.press
) or (not enabled
) or (not getActive
) then exit
;
2596 if (Length(mChildren
) = 0) then exit
;
2597 if (mHoriz
) and (ev
= 'Left') then dir
:= -1
2598 else if (mHoriz
) and (ev
= 'Right') then dir
:= 1
2599 else if (not mHoriz
) and (ev
= 'Up') then dir
:= -1
2600 else if (not mHoriz
) and (ev
= 'Down') then dir
:= 1;
2601 if (dir
= 0) then exit
;
2603 cur
:= topLevel
.mFocused
;
2604 while (cur
<> nil) and (cur
.mParent
<> self
) do cur
:= cur
.mParent
;
2605 //if (cur = nil) then writeln('CUR: nil') else writeln('CUR: ', cur.className, '#', cur.id);
2606 if (dir
< 0) then ctl
:= findPrevFocus(cur
, true) else ctl
:= findNextFocus(cur
, true);
2607 //if (ctl = nil) then writeln('CTL: nil') else writeln('CTL: ', ctl.className, '#', ctl.id);
2608 if (ctl
<> nil) and (ctl
<> self
) then
2610 ctl
.focused
:= true;
2615 // ////////////////////////////////////////////////////////////////////////// //
2616 constructor TUIHBox
.Create ();
2621 procedure TUIHBox
.AfterConstruction ();
2628 // ////////////////////////////////////////////////////////////////////////// //
2629 constructor TUIVBox
.Create ();
2634 procedure TUIVBox
.AfterConstruction ();
2641 // ////////////////////////////////////////////////////////////////////////// //
2642 procedure TUISpan
.AfterConstruction ();
2648 mCtl4Style
:= 'span';
2649 mDefSize
:= TLaySize
.Create(-1, -1);
2653 function TUISpan
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2655 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
2656 result
:= inherited parseProperty(prname
, par
);
2660 procedure TUISpan
.drawControl (gx
, gy
: Integer);
2665 // ////////////////////////////////////////////////////////////////////// //
2666 procedure TUILine
.AfterConstruction ();
2672 mCtl4Style
:= 'line';
2673 mDefSize
:= TLaySize
.Create(-1, -1);
2677 function TUILine
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2679 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
2680 result
:= inherited parseProperty(prname
, par
);
2684 procedure TUILine
.layPrepare ();
2686 inherited layPrepare();
2687 if (mParent
<> nil) then mHoriz
:= not mParent
.mHoriz
;
2690 if (mLayDefSize
.w
< 0) then mLayDefSize
.w
:= 1;
2691 if (mLayDefSize
.h
< 0) then mLayDefSize
.h
:= 7;
2695 if (mLayDefSize
.w
< 0) then mLayDefSize
.w
:= 7;
2696 if (mLayDefSize
.h
< 0) then mLayDefSize
.h
:= 1;
2701 procedure TUILine
.drawControl (gx
, gy
: Integer);
2705 cidx
:= getColorIndex
;
2706 uiContext
.color
:= mTextColor
[cidx
];
2707 if mHoriz
then uiContext
.hline(gx
, gy
+(mHeight
div 2), mWidth
)
2708 else uiContext
.vline(gx
+(mWidth
div 2), gy
, mHeight
);
2712 // ////////////////////////////////////////////////////////////////////////// //
2713 procedure TUIStaticText
.AfterConstruction ();
2719 mHoriz
:= true; // nobody cares
2722 mCtl4Style
:= 'static';
2726 procedure TUIStaticText
.setText (const atext
: AnsiString);
2729 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
), uiContext
.textHeight(mText
));
2733 function TUIStaticText
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2735 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) or (strEquCI1251(prname
, 'text')) then
2737 setText(par
.expectIdOrStr(true));
2741 if (strEquCI1251(prname
, 'textalign')) or (strEquCI1251(prname
, 'text-align')) then
2743 parseTextAlign(par
, mHAlign
, mVAlign
);
2747 if (strEquCI1251(prname
, 'header')) then
2753 if (strEquCI1251(prname
, 'line')) then
2759 result
:= inherited parseProperty(prname
, par
);
2763 procedure TUIStaticText
.drawControl (gx
, gy
: Integer);
2765 xpos
, ypos
: Integer;
2768 cidx
:= getColorIndex
;
2769 uiContext
.color
:= mBackColor
[cidx
];
2770 uiContext
.fillRect(gx
, gy
, mWidth
, mHeight
);
2772 if (mHAlign
< 0) then xpos
:= 0
2773 else if (mHAlign
> 0) then xpos
:= mWidth
-uiContext
.textWidth(mText
)
2774 else xpos
:= (mWidth
-uiContext
.textWidth(mText
)) div 2;
2776 if (Length(mText
) > 0) then
2778 if (mHeader
) then uiContext
.color
:= mFrameTextColor
[cidx
] else uiContext
.color
:= mTextColor
[cidx
];
2780 if (mVAlign
< 0) then ypos
:= 0
2781 else if (mVAlign
> 0) then ypos
:= mHeight
-uiContext
.textHeight(mText
)
2782 else ypos
:= (mHeight
-uiContext
.textHeight(mText
)) div 2;
2784 uiContext
.drawText(gx
+xpos
, gy
+ypos
, mText
);
2789 if (mHeader
) then uiContext
.color
:= mFrameColor
[cidx
] else uiContext
.color
:= mTextColor
[cidx
];
2791 if (mVAlign
< 0) then ypos
:= 0
2792 else if (mVAlign
> 0) then ypos
:= mHeight
-1
2793 else ypos
:= (mHeight
div 2);
2796 if (Length(mText
) = 0) then
2798 uiContext
.hline(gx
, ypos
, mWidth
);
2802 uiContext
.hline(gx
, ypos
, xpos
-1);
2803 uiContext
.hline(gx
+xpos
+uiContext
.textWidth(mText
), ypos
, mWidth
);
2809 // ////////////////////////////////////////////////////////////////////////// //
2810 procedure TUITextLabel
.AfterConstruction ();
2816 mCtl4Style
:= 'label';
2821 procedure TUITextLabel
.cacheStyle (root
: TUIStyle
);
2823 inherited cacheStyle(root
);
2825 mHotColor
[ClrIdxActive
] := root
.get('hot-color', 'active', mCtl4Style
).asRGBADef(TGxRGBA
.Create(0, 128, 0));
2827 mHotColor
[ClrIdxDisabled
] := root
.get('hot-color', 'disabled', mCtl4Style
).asRGBADef(TGxRGBA
.Create(0, 64, 0));
2829 mHotColor
[ClrIdxInactive
] := root
.get('hot-color', 'inactive', mCtl4Style
).asRGBADef(TGxRGBA
.Create(0, 64, 0));
2833 procedure TUITextLabel
.setText (const s
: AnsiString);
2841 while (f
<= Length(s
)) do
2843 if (s
[f
] = '\\') then
2846 if (f
<= Length(s
)) then mText
+= s
[f
];
2849 else if (s
[f
] = '~') then
2852 if (f
<= Length(s
)) then
2854 if (mHotChar
= #0) then
2857 mHotOfs
:= Length(mText
);
2869 // fix hotchar offset
2870 if (mHotChar
<> #0) and (mHotOfs
> 0) then
2872 mHotOfs
:= uiContext
.textWidth(Copy(mText
, 1, mHotOfs
+1))-uiContext
.charWidth(mText
[mHotOfs
+1]);
2875 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
), uiContext
.textHeight(mText
));
2879 function TUITextLabel
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2881 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) or (strEquCI1251(prname
, 'text')) then
2883 setText(par
.expectIdOrStr(true));
2887 if (strEquCI1251(prname
, 'link')) then
2889 mLinkId
:= par
.expectIdOrStr(true);
2893 if (strEquCI1251(prname
, 'textalign')) or (strEquCI1251(prname
, 'text-align')) then
2895 parseTextAlign(par
, mHAlign
, mVAlign
);
2899 result
:= inherited parseProperty(prname
, par
);
2903 procedure TUITextLabel
.drawControl (gx
, gy
: Integer);
2905 xpos
, ypos
: Integer;
2908 cidx
:= getColorIndex
;
2909 uiContext
.color
:= mBackColor
[cidx
];
2910 uiContext
.fillRect(gx
, gy
, mWidth
, mHeight
);
2911 if (Length(mText
) > 0) then
2913 if (mHAlign
< 0) then xpos
:= 0
2914 else if (mHAlign
> 0) then xpos
:= mWidth
-uiContext
.textWidth(mText
)
2915 else xpos
:= (mWidth
-uiContext
.textWidth(mText
)) div 2;
2917 if (mVAlign
< 0) then ypos
:= 0
2918 else if (mVAlign
> 0) then ypos
:= mHeight
-uiContext
.textHeight(mText
)
2919 else ypos
:= (mHeight
-uiContext
.textHeight(mText
)) div 2;
2921 uiContext
.color
:= mTextColor
[cidx
];
2922 uiContext
.drawText(gx
+xpos
, gy
+ypos
, mText
);
2924 if (Length(mLinkId
) > 0) and (mHotChar
<> #0) and (mHotChar
<> ' ') then
2926 uiContext
.color
:= mHotColor
[cidx
];
2927 uiContext
.drawChar(gx
+xpos
+mHotOfs
, gy
+ypos
, mHotChar
);
2933 procedure TUITextLabel
.mouseEvent (var ev
: THMouseEvent
);
2937 inherited mouseEvent(ev
);
2938 if (not ev
.eaten
) and (not ev
.cancelled
) and (enabled
) and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
2945 procedure TUITextLabel
.doAction ();
2949 if (assigned(actionCB
)) then
2955 ctl
:= topLevel
[mLinkId
];
2956 if (ctl
<> nil) then
2958 if (ctl
.canFocus
) then ctl
.focused
:= true;
2964 procedure TUITextLabel
.keyEventPost (var ev
: THKeyEvent
);
2966 if (not enabled
) then exit
;
2967 if (mHotChar
= #0) then exit
;
2968 if (ev
.eaten
) or (ev
.cancelled
) or (not ev
.press
) then exit
;
2969 if (ev
.kstate
<> ev
.ModAlt
) then exit
;
2970 if (not ev
.isHot(mHotChar
)) then exit
;
2972 if (canFocus
) then focused
:= true;
2977 // ////////////////////////////////////////////////////////////////////////// //
2978 procedure TUIButton
.AfterConstruction ();
2985 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
)+uiContext
.textWidth('[ ]'), uiContext
.textHeight(mText
));
2986 mCtl4Style
:= 'button';
2987 mSkipLayPrepare
:= false;
2988 mAddMarkers
:= false;
2989 mHideMarkers
:= false;
2993 procedure TUIButton
.cacheStyle (root
: TUIStyle
);
2997 inherited cacheStyle(root
);
2999 sz
:= nmax(0, root
.get('shadow-size', 'active', mCtl4Style
).asInt(0));
3000 sz
:= nmax(sz
, root
.get('shadow-size', 'disabled', mCtl4Style
).asInt(0));
3001 sz
:= nmax(sz
, root
.get('shadow-size', 'inactive', mCtl4Style
).asInt(0));
3004 mAddMarkers
:= root
.get('add-markers', 'active', mCtl4Style
).asBool(false);
3005 mAddMarkers
:= mAddMarkers
or root
.get('add-markers', 'disabled', mCtl4Style
).asBool(false);
3006 mAddMarkers
:= mAddMarkers
or root
.get('add-markers', 'inactive', mCtl4Style
).asBool(false);
3008 mHideMarkers
:= root
.get('hide-markers', 'active', mCtl4Style
).asBool(false);
3009 mHideMarkers
:= mHideMarkers
or root
.get('hide-markers', 'disabled', mCtl4Style
).asBool(false);
3010 mHideMarkers
:= mHideMarkers
or root
.get('hide-markers', 'inactive', mCtl4Style
).asBool(false);
3014 procedure TUIButton
.setText (const s
: AnsiString);
3016 inherited setText(s
);
3017 if (mHideMarkers
) then
3019 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
)+10, uiContext
.textHeight(mText
));
3021 else if (mAddMarkers
) then
3023 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
)+uiContext
.textWidth('[<>]'), uiContext
.textHeight(mText
));
3027 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
)+uiContext
.textWidth('<>'), uiContext
.textHeight(mText
));
3032 procedure TUIButton
.layPrepare ();
3037 if (not mSkipLayPrepare
) then
3040 if (ods
.w
<> 0) or (ods
.h
<> 0) then
3042 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
), uiContext
.textHeight(mText
));
3043 if (mHideMarkers
) then
3047 else if (mAddMarkers
) then
3049 if (mDefault
) then ww
:= uiContext
.textWidth('[< >]')
3050 else if (mCancel
) then ww
:= uiContext
.textWidth('[{ }]')
3051 else ww
:= uiContext
.textWidth('[ ]');
3055 ww
:= nmax(0, uiContext
.textWidth('< >'));
3056 ww
:= nmax(ww
, uiContext
.textWidth('{ }'));
3057 ww
:= nmax(ww
, uiContext
.textWidth('[ ]'));
3059 mDefSize
.w
+= ww
+mShadowSize
;
3060 mDefSize
.h
+= mShadowSize
;
3065 ods
:= TLaySize
.Create(0, 0); // fpc is dumb!
3067 inherited layPrepare();
3068 if (not mSkipLayPrepare
) then mDefSize
:= ods
;
3072 procedure TUIButton
.drawControl (gx
, gy
: Integer);
3075 xpos
, ypos
, xofsl
, xofsr
{, sofs}: Integer;
3078 lstr
, rstr
: AnsiString;
3080 cidx
:= getColorIndex
;
3082 wdt
:= mWidth
-mShadowSize
;
3083 hgt
:= mHeight
-mShadowSize
;
3084 if (mPushed
) {or (cidx = ClrIdxActive)} then
3086 //sofs := mShadowSize;
3093 if (mShadowSize
> 0) then
3095 uiContext
.darkenRect(gx
+mShadowSize
, gy
+hgt
, wdt
, mShadowSize
, 96);
3096 uiContext
.darkenRect(gx
+wdt
, gy
+mShadowSize
, mShadowSize
, hgt
-mShadowSize
, 96);
3100 uiContext
.color
:= mBackColor
[cidx
];
3101 //setScissor(sofs, sofs, wdt, hgt);
3102 uiContext
.fillRect(gx
, gy
, wdt
, hgt
);
3104 if (mVAlign
< 0) then ypos
:= 0
3105 else if (mVAlign
> 0) then ypos
:= hgt
-uiContext
.textHeight(mText
)
3106 else ypos
:= (hgt
-uiContext
.textHeight(mText
)) div 2;
3109 uiContext
.color
:= mTextColor
[cidx
];
3111 if (mHideMarkers
) then
3118 if (mAddMarkers
) then
3120 if (mDefault
) then begin lstr
:= '[< '; rstr
:= ' >]'; end
3121 else if (mCancel
) then begin lstr
:= '[{ '; rstr
:= ' }]'; end
3122 else begin lstr
:= '[ '; rstr
:= ' ]'; end;
3123 xofsl
:= uiContext
.textWidth(lstr
);
3124 xofsr
:= uiContext
.textWidth(rstr
);
3125 uiContext
.drawText(gx
, ypos
, lstr
);
3126 uiContext
.drawText(gx
+wdt
-uiContext
.textWidth(rstr
), ypos
, rstr
);
3130 xofsl
:= nmax(0, uiContext
.textWidth('< '));
3131 xofsl
:= nmax(xofsl
, uiContext
.textWidth('{ '));
3132 xofsl
:= nmax(xofsl
, uiContext
.textWidth('[ '));
3133 xofsr
:= nmax(0, uiContext
.textWidth(' >'));
3134 xofsr
:= nmax(xofsr
, uiContext
.textWidth(' }'));
3135 xofsr
:= nmax(xofsr
, uiContext
.textWidth(' ]'));
3136 if (mDefault
) then begin lch
:= '<'; rch
:= '>'; end
3137 else if (mCancel
) then begin lch
:= '{'; rch
:= '}'; end
3138 else begin lch
:= '['; rch
:= ']'; end;
3139 uiContext
.drawChar(gx
, ypos
, lch
);
3140 uiContext
.drawChar(gx
+wdt
-uiContext
.charWidth(rch
), ypos
, rch
);
3144 if (Length(mText
) > 0) then
3146 if (mHAlign
< 0) then xpos
:= 0
3147 else begin xpos
:= wdt
-xofsl
-xofsr
-uiContext
.textWidth(mText
); if (mHAlign
= 0) then xpos
:= xpos
div 2; end;
3150 //setScissor(xofsl+sofs, sofs, wdt-xofsl-xofsr, hgt);
3151 uiContext
.drawText(gx
+xpos
, ypos
, mText
);
3153 if (mHotChar
<> #0) and (mHotChar
<> ' ') then
3155 uiContext
.color
:= mHotColor
[cidx
];
3156 uiContext
.drawChar(gx
+xpos
+mHotOfs
, ypos
, mHotChar
);
3162 procedure TUIButton
.mouseEvent (var ev
: THMouseEvent
);
3166 inherited mouseEvent(ev
);
3167 if (uiGrabCtl
= self
) then
3170 mPushed
:= toLocal(ev
.x
, ev
.y
, lx
, ly
);
3171 if (ev
= '-lmb') and focused
and mPushed
then
3178 if (ev
.eaten
) or (ev
.cancelled
) or (not enabled
) or not focused
then exit
;
3184 procedure TUIButton
.keyEvent (var ev
: THKeyEvent
);
3186 inherited keyEvent(ev
);
3187 if (not ev
.eaten
) and (not ev
.cancelled
) and (enabled
) then
3189 if (ev
= 'Enter') or (ev
= 'Space') then
3199 // ////////////////////////////////////////////////////////////////////////// //
3200 procedure TUIButtonRound
.AfterConstruction ();
3206 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
)+8*2, uiContext
.textHeight(mText
)+2);
3207 mCtl4Style
:= 'button-round';
3208 mSkipLayPrepare
:= true;
3212 procedure TUIButtonRound
.setText (const s
: AnsiString);
3214 inherited setText(s
);
3215 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
)+8*2, uiContext
.textHeight(mText
)+2);
3219 procedure TUIButtonRound
.layPrepare ();
3224 if (ods
.w
<> 0) or (ods
.h
<> 0) then
3226 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
)+8*2, uiContext
.textHeight(mText
)+2);
3228 inherited layPrepare();
3233 procedure TUIButtonRound
.drawControl (gx
, gy
: Integer);
3235 xpos
, ypos
: Integer;
3238 cidx
:= getColorIndex
;
3240 uiContext
.color
:= mBackColor
[cidx
];
3241 uiContext
.fillRect(gx
+1, gy
, mWidth
-2, mHeight
);
3242 uiContext
.fillRect(gx
, gy
+1, 1, mHeight
-2);
3243 uiContext
.fillRect(gx
+mWidth
-1, gy
+1, 1, mHeight
-2);
3245 if (Length(mText
) > 0) then
3247 if (mHAlign
< 0) then xpos
:= 0
3248 else if (mHAlign
> 0) then xpos
:= mWidth
-uiContext
.textWidth(mText
)
3249 else xpos
:= (mWidth
-uiContext
.textWidth(mText
)) div 2;
3251 if (mVAlign
< 0) then ypos
:= 0
3252 else if (mVAlign
> 0) then ypos
:= mHeight
-uiContext
.textHeight(mText
)
3253 else ypos
:= (mHeight
-uiContext
.textHeight(mText
)) div 2;
3255 setScissor(8, 0, mWidth
-16, mHeight
);
3256 uiContext
.color
:= mTextColor
[cidx
];
3257 uiContext
.drawText(gx
+xpos
+8, gy
+ypos
, mText
);
3259 if (mHotChar
<> #0) and (mHotChar
<> ' ') then
3261 uiContext
.color
:= mHotColor
[cidx
];
3262 uiContext
.drawChar(gx
+xpos
+8+mHotOfs
, gy
+ypos
, mHotChar
);
3268 // ////////////////////////////////////////////////////////////////////////// //
3269 procedure TUISwitchBox
.AfterConstruction ();
3275 mIcon
:= TGxContext
.TMarkIcon
.Checkbox
;
3276 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
)+3+uiContext
.iconMarkWidth(mIcon
), nmax(uiContext
.iconMarkHeight(mIcon
), uiContext
.textHeight(mText
)));
3277 mCtl4Style
:= 'switchbox';
3279 mBoolVar
:= @mChecked
;
3283 procedure TUISwitchBox
.cacheStyle (root
: TUIStyle
);
3285 inherited cacheStyle(root
);
3287 mSwitchColor
[ClrIdxActive
] := root
.get('switch-color', 'active', mCtl4Style
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
3289 mSwitchColor
[ClrIdxDisabled
] := root
.get('switch-color', 'disabled', mCtl4Style
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
3291 mSwitchColor
[ClrIdxInactive
] := root
.get('switch-color', 'inactive', mCtl4Style
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
3295 procedure TUISwitchBox
.setText (const s
: AnsiString);
3297 inherited setText(s
);
3298 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
)+3+uiContext
.iconMarkWidth(mIcon
), nmax(uiContext
.iconMarkHeight(mIcon
), uiContext
.textHeight(mText
)));
3302 function TUISwitchBox
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
3304 if (strEquCI1251(prname
, 'checked')) then
3310 result
:= inherited parseProperty(prname
, par
);
3314 function TUISwitchBox
.getChecked (): Boolean;
3316 if (mBoolVar
<> nil) then result
:= mBoolVar
^ else result
:= false;
3320 procedure TUISwitchBox
.setVar (pvar
: PBoolean);
3322 if (pvar
= nil) then pvar
:= @mChecked
;
3323 if (pvar
<> mBoolVar
) then
3326 setChecked(mBoolVar
^);
3331 procedure TUISwitchBox
.drawControl (gx
, gy
: Integer);
3333 xpos
, ypos
, iwdt
, dy
: Integer;
3336 cidx
:= getColorIndex
;
3338 iwdt
:= uiContext
.iconMarkWidth(mIcon
);
3339 if (mHAlign
< 0) then xpos
:= 0
3340 else if (mHAlign
> 0) then xpos
:= mWidth
-(uiContext
.textWidth(mText
)+3+iwdt
)
3341 else xpos
:= (mWidth
-(uiContext
.textWidth(mText
)+3+iwdt
)) div 2;
3343 if (mVAlign
< 0) then ypos
:= 0
3344 else if (mVAlign
> 0) then ypos
:= mHeight
-uiContext
.textHeight(mText
)
3345 else ypos
:= (mHeight
-uiContext
.textHeight(mText
)) div 2;
3347 uiContext
.color
:= mBackColor
[cidx
];
3348 uiContext
.fillRect(gx
, gy
, mWidth
, mHeight
);
3350 uiContext
.color
:= mSwitchColor
[cidx
];
3351 if (uiContext
.iconMarkHeight(mIcon
) < uiContext
.textHeight(mText
)) then
3353 case uiContext
.textHeight(mText
) of
3358 uiContext
.drawIconMark(mIcon
, gx
, gy
+ypos
+uiContext
.textHeight(mText
)-uiContext
.iconMarkHeight(mIcon
)-dy
, checked
);
3362 uiContext
.drawIconMark(mIcon
, gx
, gy
, checked
);
3365 uiContext
.color
:= mTextColor
[cidx
];
3366 uiContext
.drawText(gx
+xpos
+3+iwdt
, gy
+ypos
, mText
);
3368 if (mHotChar
<> #0) and (mHotChar
<> ' ') then
3370 uiContext
.color
:= mHotColor
[cidx
];
3371 uiContext
.drawChar(gx
+xpos
+3+iwdt
+mHotOfs
, gy
+ypos
, mHotChar
);
3376 procedure TUISwitchBox
.mouseEvent (var ev
: THMouseEvent
);
3380 inherited mouseEvent(ev
);
3381 if (uiGrabCtl
= self
) then
3384 if (ev
= '-lmb') and focused
and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
3390 if (ev
.eaten
) or (ev
.cancelled
) or (not enabled
) or not focused
then exit
;
3395 procedure TUISwitchBox
.keyEvent (var ev
: THKeyEvent
);
3397 inherited keyEvent(ev
);
3398 if (not ev
.eaten
) and (not ev
.cancelled
) and (enabled
) then
3400 if (ev
= 'Space') then
3410 // ////////////////////////////////////////////////////////////////////////// //
3411 procedure TUICheckBox
.AfterConstruction ();
3415 mBoolVar
:= @mChecked
;
3416 mIcon
:= TGxContext
.TMarkIcon
.Checkbox
;
3421 procedure TUICheckBox
.setChecked (v
: Boolean);
3427 procedure TUICheckBox
.doAction ();
3429 if (assigned(actionCB
)) then
3435 setChecked(not getChecked
);
3440 // ////////////////////////////////////////////////////////////////////////// //
3441 procedure TUIRadioBox
.AfterConstruction ();
3445 mBoolVar
:= @mChecked
;
3447 mIcon
:= TGxContext
.TMarkIcon
.Radiobox
;
3452 function TUIRadioBox
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
3454 if (strEquCI1251(prname
, 'group')) then
3456 mRadioGroup
:= par
.expectIdOrStr(true);
3457 if (getChecked
) then setChecked(true);
3461 if (strEquCI1251(prname
, 'checked')) then
3467 result
:= inherited parseProperty(prname
, par
);
3471 procedure TUIRadioBox
.setChecked (v
: Boolean);
3473 function resetGroup (ctl
: TUIControl
): Boolean;
3476 if (ctl
<> self
) and (ctl
is TUIRadioBox
) and (TUIRadioBox(ctl
).mRadioGroup
= mRadioGroup
) then
3478 TUIRadioBox(ctl
).mBoolVar
^ := false;
3484 if v
then topLevel
.forEachControl(resetGroup
);
3488 procedure TUIRadioBox
.doAction ();
3490 if (assigned(actionCB
)) then
3501 // ////////////////////////////////////////////////////////////////////////// //
3503 registerCtlClass(TUIHBox
, 'hbox');
3504 registerCtlClass(TUIVBox
, 'vbox');
3505 registerCtlClass(TUISpan
, 'span');
3506 registerCtlClass(TUILine
, 'line');
3507 registerCtlClass(TUITextLabel
, 'label');
3508 registerCtlClass(TUIStaticText
, 'static');
3509 registerCtlClass(TUIButtonRound
, 'round-button');
3510 registerCtlClass(TUIButton
, 'button');
3511 registerCtlClass(TUICheckBox
, 'checkbox');
3512 registerCtlClass(TUIRadioBox
, 'radiobox');