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 mSBarFullColor
: array[0..ClrIdxMax
] of TGxRGBA
;
75 mSBarEmptyColor
: array[0..ClrIdxMax
] of TGxRGBA
;
76 mDarken
: array[0..ClrIdxMax
] of Integer; // >255: none
79 procedure updateStyle (); virtual;
80 procedure cacheStyle (root
: TUIStyle
); virtual;
81 function getColorIndex (): Integer; inline;
84 function getEnabled (): Boolean;
85 procedure setEnabled (v
: Boolean); inline;
87 function getFocused (): Boolean; inline;
88 procedure setFocused (v
: Boolean); inline;
90 function getActive (): Boolean; inline;
92 function getCanFocus (): Boolean; inline;
94 function isMyChild (ctl
: TUIControl
): Boolean;
96 function findFirstFocus (): TUIControl
;
97 function findLastFocus (): TUIControl
;
99 function findNextFocus (cur
: TUIControl
; wrap
: Boolean): TUIControl
;
100 function findPrevFocus (cur
: TUIControl
; wrap
: Boolean): TUIControl
;
102 function findCancelControl (): TUIControl
;
103 function findDefaulControl (): TUIControl
;
105 function findControlById (const aid
: AnsiString): TUIControl
;
107 procedure activated (); virtual;
108 procedure blurred (); virtual;
110 procedure calcFullClientSize ();
112 procedure drawFrame (gx
, gy
, resx
, thalign
: Integer; const text: AnsiString; dbl
: Boolean);
115 var savedClip
: TGxRect
; // valid only in `draw*()` calls
116 //WARNING! do not call scissor functions outside `.draw*()` API!
117 // set scissor to this rect (in local coords)
118 procedure setScissor (lx
, ly
, lw
, lh
: Integer); // valid only in `draw*()` calls
119 procedure resetScissor (); inline; // only client area, w/o frame
120 procedure resetScissorNC (); inline; // full drawing area, with frame
124 closeRequestCB
: TCloseRequestCB
;
127 mDefSize
: TLaySize
; // default size
128 mMaxSize
: TLaySize
; // maximum size
135 mLayDefSize
: TLaySize
;
136 mLayMaxSize
: TLaySize
;
142 // layouter interface
143 function getDefSize (): TLaySize
; inline; // default size; <0: use max size
144 //procedure setDefSize (const sz: TLaySize); inline; // default size; <0: use max size
145 function getMargins (): TLayMargins
; inline;
146 function getPadding (): TLaySize
; inline; // children padding (each non-first child will get this on left/top)
147 function getMaxSize (): TLaySize
; inline; // max size; <0: set to some huge value
148 //procedure setMaxSize (const sz: TLaySize); inline; // max size; <0: set to some huge value
149 function getFlex (): Integer; inline; // <=0: not flexible
150 function isHorizBox (): Boolean; inline; // horizontal layout for children?
151 function noPad (): Boolean; inline; // ignore padding in box direction for this control
152 function getAlign (): Integer; inline; // aligning in non-main direction: <0: left/up; 0: center; >0: right/down
153 function getExpand (): Boolean; inline; // expanding in non-main direction: `true` will ignore align and eat all available space
154 function getHGroup (): AnsiString; inline; // empty: not grouped
155 function getVGroup (): AnsiString; inline; // empty: not grouped
157 procedure setActualSizePos (constref apos
: TLayPos
; constref asize
: TLaySize
); inline;
159 procedure layPrepare (); virtual; // called before registering control in layouter
162 property flex
: Integer read mFlex write mFlex
;
163 property flDefaultSize
: TLaySize read mDefSize write mDefSize
;
164 property flMaxSize
: TLaySize read mMaxSize write mMaxSize
;
165 property flPadding
: TLaySize read mPadding write mPadding
;
166 property flHoriz
: Boolean read mHoriz write mHoriz
;
167 property flAlign
: Integer read mAlign write mAlign
;
168 property flExpand
: Boolean read mExpand write mExpand
;
169 property flHGroup
: AnsiString read mHGroup write mHGroup
;
170 property flVGroup
: AnsiString read mVGroup write mVGroup
;
171 property flNoPad
: Boolean read mNoPad write mNoPad
;
172 property fullSize
: TLaySize read mFullSize
;
175 function parsePos (par
: TTextParser
): TLayPos
;
176 function parseSize (par
: TTextParser
): TLaySize
;
177 function parsePadding (par
: TTextParser
): TLaySize
;
178 function parseHPadding (par
: TTextParser
; def
: Integer): TLaySize
;
179 function parseVPadding (par
: TTextParser
; def
: Integer): TLaySize
;
180 function parseBool (par
: TTextParser
): Boolean;
181 function parseAnyAlign (par
: TTextParser
): Integer;
182 function parseHAlign (par
: TTextParser
): Integer;
183 function parseVAlign (par
: TTextParser
): Integer;
184 function parseOrientation (const prname
: AnsiString; par
: TTextParser
): Boolean;
185 procedure parseTextAlign (par
: TTextParser
; var h
, v
: Integer);
186 procedure parseChildren (par
: TTextParser
); // par should be on '{'; final '}' is eaten
189 // par is on property data
190 // there may be more data in text stream, don't eat it!
191 // return `true` if property name is valid and value was parsed
192 // return `false` if property name is invalid; don't advance parser in this case
193 // throw on property data errors
194 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; virtual;
196 // par should be on '{'; final '}' is eaten
197 procedure parseProperties (par
: TTextParser
);
200 constructor Create ();
201 destructor Destroy (); override;
203 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
205 // `sx` and `sy` are screen coordinates
206 procedure drawControl (gx
, gy
: Integer); virtual;
208 // called after all children drawn
209 procedure drawControlPost (gx
, gy
: Integer); virtual;
211 procedure draw (); virtual;
213 function topLevel (): TUIControl
; inline;
215 // returns `true` if global coords are inside this control
216 function toLocal (var x
, y
: Integer): Boolean;
217 function toLocal (gx
, gy
: Integer; out x
, y
: Integer): Boolean; inline;
218 procedure toGlobal (var x
, y
: Integer);
219 procedure toGlobal (lx
, ly
: Integer; out x
, y
: Integer); inline;
221 procedure getDrawRect (out gx
, gy
, wdt
, hgt
: Integer);
223 // x and y are global coords
224 function controlAtXY (x
, y
: Integer; allowDisabled
: Boolean=false): TUIControl
;
226 function parentScrollX (): Integer; inline;
227 function parentScrollY (): Integer; inline;
229 procedure makeVisibleInParent ();
231 procedure doAction (); virtual; // so user controls can override it
233 procedure onEvent (var ev
: TFUIEvent
); virtual; // general dispatcher
235 procedure mouseEvent (var ev
: TFUIEvent
); virtual;
236 procedure mouseEventSink (var ev
: TFUIEvent
); virtual;
237 procedure mouseEventBubble (var ev
: TFUIEvent
); virtual;
239 procedure keyEvent (var ev
: TFUIEvent
); virtual;
240 procedure keyEventSink (var ev
: TFUIEvent
); virtual;
241 procedure keyEventBubble (var ev
: TFUIEvent
); virtual;
243 function prevSibling (): TUIControl
;
244 function nextSibling (): TUIControl
;
245 function firstChild (): TUIControl
; inline;
246 function lastChild (): TUIControl
; inline;
248 procedure appendChild (ctl
: TUIControl
); virtual;
250 function setActionCBFor (const aid
: AnsiString; cb
: TActionCB
): TActionCB
; // returns previous cb
252 function forEachChildren (cb
: TCtlEnumCB
): TUIControl
; // doesn't recurse
253 function forEachControl (cb
: TCtlEnumCB
; includeSelf
: Boolean=true): TUIControl
;
255 procedure close (); // this closes *top-level* control
258 property id
: AnsiString read mId write mId
;
259 property styleId
: AnsiString read mStyleId
;
260 property scrollX
: Integer read mScrollX write mScrollX
;
261 property scrollY
: Integer read mScrollY write mScrollY
;
262 property x0
: Integer read mX write mX
;
263 property y0
: Integer read mY write mY
;
264 property width
: Integer read mWidth write mWidth
;
265 property height
: Integer read mHeight write mHeight
;
266 property enabled
: Boolean read getEnabled write setEnabled
;
267 property parent
: TUIControl read mParent
;
268 property focused
: Boolean read getFocused write setFocused
;
269 property active
: Boolean read getActive
;
270 property escClose
: Boolean read mEscClose write mEscClose
;
271 property cancel
: Boolean read mCancel write mCancel
;
272 property defctl
: Boolean read mDefault write mDefault
;
273 property canFocus
: Boolean read getCanFocus write mCanFocus
;
274 property ctlById
[const aid
: AnsiString]: TUIControl read findControlById
; default
;
278 TUITopWindow
= class(TUIControl
)
280 type TXMode
= (None
, Drag
, VScroll
, HScroll
);
285 mDragStartX
, mDragStartY
: Integer;
286 mWaitingClose
: Boolean;
288 mFreeOnClose
: Boolean; // default: false
289 mDoCenter
: Boolean; // after layouting
290 mFitToScreen
: Boolean;
293 procedure activated (); override;
294 procedure blurred (); override;
297 closeCB
: TActionCB
; // called after window was removed from ui window list
300 constructor Create (const atitle
: AnsiString);
302 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
304 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
306 procedure flFitToScreen (); // call this before layouting
308 procedure centerInScreen ();
310 // `sx` and `sy` are screen coordinates
311 procedure drawControl (gx
, gy
: Integer); override;
312 procedure drawControlPost (gx
, gy
: Integer); override;
314 procedure keyEventBubble (var ev
: TFUIEvent
); override; // returns `true` if event was eaten
315 procedure mouseEvent (var ev
: TFUIEvent
); override; // returns `true` if event was eaten
318 property freeOnClose
: Boolean read mFreeOnClose write mFreeOnClose
;
319 property fitToScreen
: Boolean read mFitToScreen write mFitToScreen
;
322 // ////////////////////////////////////////////////////////////////////// //
323 TUIBox
= class(TUIControl
)
326 mCaption
: AnsiString;
327 mHAlign
: Integer; // -1: left; 0: center; 1: right; default: left
330 procedure setCaption (const acap
: AnsiString);
331 procedure setHasFrame (v
: Boolean);
334 constructor Create (ahoriz
: Boolean);
336 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
338 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
340 procedure drawControl (gx
, gy
: Integer); override;
342 procedure mouseEvent (var ev
: TFUIEvent
); override;
343 procedure keyEvent (var ev
: TFUIEvent
); override;
346 property caption
: AnsiString read mCaption write setCaption
;
347 property hasFrame
: Boolean read mHasFrame write setHasFrame
;
348 property captionAlign
: Integer read mHAlign write mHAlign
;
351 TUIHBox
= class(TUIBox
)
353 constructor Create ();
355 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
358 TUIVBox
= class(TUIBox
)
360 constructor Create ();
362 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
365 // ////////////////////////////////////////////////////////////////////// //
366 TUISpan
= class(TUIControl
)
368 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
370 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
373 // ////////////////////////////////////////////////////////////////////// //
374 TUILine
= class(TUIControl
)
376 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
378 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
380 procedure layPrepare (); override; // called before registering control in layouter
382 procedure drawControl (gx
, gy
: Integer); override;
385 // ////////////////////////////////////////////////////////////////////// //
386 TUIStaticText
= class(TUIControl
)
389 mHAlign
: Integer; // -1: left; 0: center; 1: right; default: left
390 mVAlign
: Integer; // -1: top; 0: center; 1: bottom; default: center
391 mHeader
: Boolean; // true: draw with frame text color
392 mLine
: Boolean; // true: draw horizontal line
395 procedure setText (const atext
: AnsiString);
398 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
400 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
402 procedure drawControl (gx
, gy
: Integer); override;
405 property text: AnsiString read mText write setText
;
406 property halign
: Integer read mHAlign write mHAlign
;
407 property valign
: Integer read mVAlign write mVAlign
;
408 property header
: Boolean read mHeader write mHeader
;
409 property line
: Boolean read mLine write mLine
;
412 // ////////////////////////////////////////////////////////////////////// //
413 TUITextLabel
= class(TUIControl
)
416 mHAlign
: Integer; // -1: left; 0: center; 1: right; default: left
417 mVAlign
: Integer; // -1: top; 0: center; 1: bottom; default: center
419 mHotOfs
: Integer; // from text start, in pixels
420 mHotColor
: array[0..ClrIdxMax
] of TGxRGBA
;
421 mLinkId
: AnsiString; // linked control
424 procedure cacheStyle (root
: TUIStyle
); override;
426 procedure setText (const s
: AnsiString); virtual;
429 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
431 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
433 procedure doAction (); override;
435 procedure drawControl (gx
, gy
: Integer); override;
437 procedure mouseEvent (var ev
: TFUIEvent
); override;
438 procedure keyEventBubble (var ev
: TFUIEvent
); override;
441 property text: AnsiString read mText write setText
;
442 property halign
: Integer read mHAlign write mHAlign
;
443 property valign
: Integer read mVAlign write mVAlign
;
446 // ////////////////////////////////////////////////////////////////////// //
447 TUIButton
= class(TUITextLabel
)
449 mSkipLayPrepare
: Boolean;
450 mShadowSize
: Integer;
451 mAddMarkers
: Boolean;
452 mHideMarkers
: Boolean;
456 procedure setText (const s
: AnsiString); override;
458 procedure cacheStyle (root
: TUIStyle
); override;
460 procedure blurred (); override;
463 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
465 procedure layPrepare (); override; // called before registering control in layouter
467 procedure drawControl (gx
, gy
: Integer); override;
469 procedure mouseEvent (var ev
: TFUIEvent
); override;
470 procedure keyEvent (var ev
: TFUIEvent
); override;
473 // ////////////////////////////////////////////////////////////////////// //
474 TUIButtonRound
= class(TUIButton
)
476 procedure setText (const s
: AnsiString); override;
479 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
481 procedure layPrepare (); override; // called before registering control in layouter
483 procedure drawControl (gx
, gy
: Integer); override;
486 // ////////////////////////////////////////////////////////////////////// //
487 TUISwitchBox
= class(TUITextLabel
)
491 mIcon
: TGxContext
.TMarkIcon
;
492 mSwitchColor
: array[0..ClrIdxMax
] of TGxRGBA
;
495 procedure cacheStyle (root
: TUIStyle
); override;
497 procedure setText (const s
: AnsiString); override;
499 function getChecked (): Boolean; virtual;
500 procedure setChecked (v
: Boolean); virtual; abstract;
503 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
505 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
507 procedure drawControl (gx
, gy
: Integer); override;
509 procedure mouseEvent (var ev
: TFUIEvent
); override;
510 procedure keyEvent (var ev
: TFUIEvent
); override;
512 procedure setVar (pvar
: PBoolean);
515 property checked
: Boolean read getChecked write setChecked
;
518 TUICheckBox
= class(TUISwitchBox
)
520 procedure setChecked (v
: Boolean); override;
523 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
525 procedure doAction (); override;
528 TUIRadioBox
= class(TUISwitchBox
)
530 mRadioGroup
: AnsiString;
533 procedure setChecked (v
: Boolean); override;
536 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
538 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
540 procedure doAction (); override;
543 property radioGroup
: AnsiString read mRadioGroup write mRadioGroup
; //FIXME
547 // ////////////////////////////////////////////////////////////////////////// //
548 procedure uiDispatchEvent (var evt
: TFUIEvent
);
551 procedure uiFocus ();
555 // ////////////////////////////////////////////////////////////////////////// //
556 procedure uiAddWindow (ctl
: TUIControl
);
557 procedure uiRemoveWindow (ctl
: TUIControl
); // will free window if `mFreeOnClose` is `true`
558 function uiVisibleWindow (ctl
: TUIControl
): Boolean;
560 // this can return `nil` or disabled control
561 function uiGetFocusedCtl (): TUIControl
;
563 procedure uiUpdateStyles ();
566 // ////////////////////////////////////////////////////////////////////////// //
568 procedure uiLayoutCtl (ctl
: TUIControl
);
571 // ////////////////////////////////////////////////////////////////////////// //
572 procedure uiInitialize ();
573 procedure uiDeinitialize ();
576 // ////////////////////////////////////////////////////////////////////////// //
578 fuiRenderScale
: Single = 1.0;
579 uiContext
: TGxContext
= nil;
590 uiTopList
: array of TUIControl
= nil;
591 uiGrabCtl
: TUIControl
= nil;
594 // ////////////////////////////////////////////////////////////////////////// //
595 procedure uiDeinitialize ();
597 FreeAndNil(uiContext
);
601 procedure uiInitialize ();
603 if (uiContext
<> nil) then raise Exception
.Create('FlexUI already initialized');
604 uiContext
:= TGxContext
.Create();
608 // ////////////////////////////////////////////////////////////////////////// //
610 ctlsToKill
: array of TUIControl
= nil;
613 procedure scheduleKill (ctl
: TUIControl
);
617 if (ctl
= nil) then exit
;
619 for f
:= 0 to High(ctlsToKill
) do
621 if (ctlsToKill
[f
] = ctl
) then exit
;
622 if (ctlsToKill
[f
] = nil) then begin ctlsToKill
[f
] := ctl
; exit
; end;
624 SetLength(ctlsToKill
, Length(ctlsToKill
)+1);
625 ctlsToKill
[High(ctlsToKill
)] := ctl
;
629 procedure processKills ();
634 for f
:= 0 to High(ctlsToKill
) do
636 ctl
:= ctlsToKill
[f
];
637 if (ctl
= nil) then break
;
638 if (uiGrabCtl
<> nil) and (ctl
.isMyChild(uiGrabCtl
)) then uiGrabCtl
:= nil; // just in case
639 ctlsToKill
[f
] := nil;
642 if (Length(ctlsToKill
) > 0) then ctlsToKill
[0] := nil; // just in case
646 // ////////////////////////////////////////////////////////////////////////// //
648 knownCtlClasses
: array of record
649 klass
: TUIControlClass
;
654 procedure registerCtlClass (aklass
: TUIControlClass
; const aname
: AnsiString);
656 assert(aklass
<> nil);
657 assert(Length(aname
) > 0);
658 SetLength(knownCtlClasses
, Length(knownCtlClasses
)+1);
659 knownCtlClasses
[High(knownCtlClasses
)].klass
:= aklass
;
660 knownCtlClasses
[High(knownCtlClasses
)].name
:= aname
;
664 function findCtlClass (const aname
: AnsiString): TUIControlClass
;
668 for f
:= 0 to High(knownCtlClasses
) do
670 if (strEquCI1251(aname
, knownCtlClasses
[f
].name
)) then
672 result
:= knownCtlClasses
[f
].klass
;
680 // ////////////////////////////////////////////////////////////////////////// //
682 TFlexLayouter
= specialize TFlexLayouterBase
<TUIControl
>;
684 procedure uiLayoutCtl (ctl
: TUIControl
);
688 if (ctl
= nil) then exit
;
689 lay
:= TFlexLayouter
.Create();
691 if (not ctl
.mStyleLoaded
) then ctl
.updateStyle();
692 if (ctl
is TUITopWindow
) and (TUITopWindow(ctl
).fitToScreen
) then TUITopWindow(ctl
).flFitToScreen();
697 //writeln('============================'); lay.dumpFlat();
699 //writeln('=== initial ==='); lay.dump();
701 //lay.calcMaxSizeInternal(0);
704 writeln('=== after first pass ===');
708 writeln('=== after second pass ===');
713 //writeln('=== final ==='); lay.dump();
715 if (ctl
.mParent
= nil) and (ctl
is TUITopWindow
) and (TUITopWindow(ctl
).mDoCenter
) then
717 TUITopWindow(ctl
).centerInScreen();
720 // calculate full size
721 ctl
.calcFullClientSize();
724 if (ctl
.mParent
= nil) then
726 if (ctl
.mFocused
= nil) or (ctl
.mFocused
= ctl
) or (not ctl
.mFocused
.enabled
) then
728 ctl
.mFocused
:= ctl
.findFirstFocus();
738 // ////////////////////////////////////////////////////////////////////////// //
739 procedure uiUpdateStyles ();
743 for ctl
in uiTopList
do ctl
.updateStyle();
747 procedure uiDispatchEvent (var evt
: TFUIEvent
);
752 procedure doSink (ctl
: TUIControl
);
754 if (ctl
= nil) or (not ev
.alive
) then exit
;
755 if (ctl
.mParent
<> nil) then
758 if (not ev
.alive
) then exit
;
760 //if (ctl = destCtl) then writeln(' SINK: MINE! <', ctl.className, '>');
763 if (ctl
= destCtl
) and (ev
.alive
) then
770 procedure dispatchTo (ctl
: TUIControl
);
772 if (ctl
= nil) then exit
;
777 //ctl := ctl.mParent; // 'cause "mine" is processed in `doSink()`
778 while (ctl
<> nil) and (ev
.alive
) do
786 procedure doMouseEvent ();
794 // pass mouse events to control with grab, if there is any
795 if (uiGrabCtl
<> nil) then
797 //writeln('GRABBED: ', uiGrabCtl.className);
798 doUngrab
:= (ev
.release
) and ((ev
.bstate
and (not ev
.but
)) = 0);
799 dispatchTo(uiGrabCtl
);
800 //FIXME: create API to get grabs, so control can regrab itself event on release
801 if (doUngrab
) and (uiGrabCtl
= destCtl
) then uiGrabCtl
:= nil;
806 if (Length(uiTopList
) > 0) then win
:= uiTopList
[High(uiTopList
)] else win
:= nil;
807 // check if we're still in top window
808 if (ev
.press
) and (win
<> nil) and (not win
.toLocal(0, 0, lx
, ly
)) then
810 // we have other windows too; check for window switching
811 for f
:= High(uiTopList
)-1 downto 0 do
813 if (uiTopList
[f
].enabled
) and (uiTopList
[f
].toLocal(ev
.x
, ev
.y
, lx
, ly
)) then
818 for c
:= f
+1 to High(uiTopList
) do uiTopList
[c
-1] := uiTopList
[c
];
819 uiTopList
[High(uiTopList
)] := win
;
826 if (win
<> nil) and (win
.toLocal(ev
.x
, ev
.y
, lx
, ly
)) then
828 ctl
:= win
.controlAtXY(ev
.x
, ev
.y
); // don't allow disabled controls
829 if (ctl
= nil) or (not ctl
.canFocus
) or (not ctl
.enabled
) then ctl
:= win
;
830 // pass focus to another event and set grab, if necessary
833 // pass focus, if necessary
834 if (win
.mFocused
<> ctl
) then
836 if (win
.mFocused
<> nil) then win
.mFocused
.blurred();
839 if (ctl
<> win
) then ctl
.activated();
851 svx
, svy
, svdx
, svdy
: Integer;
855 if (not evt
.alive
) then exit
;
856 //writeln('ENTER: FUI DISPATCH');
858 // normalize mouse coordinates
859 svscale
:= fuiRenderScale
;
860 ev
.x
:= trunc(ev
.x
/svscale
);
861 ev
.y
:= trunc(ev
.y
/svscale
);
862 ev
.dx
:= trunc(ev
.dx
/svscale
); //FIXME
863 ev
.dy
:= trunc(ev
.dy
/svscale
); //FIXME
869 // "event grab" eats only mouse events
872 // we need to so some special processing here
877 // simply dispatch to focused control
878 dispatchTo(uiGetFocusedCtl
);
881 if (ev
.x
= svx
) and (ev
.y
= svy
) and (ev
.dx
= svdx
) and (ev
.dy
= svdy
) then
883 // due to possible precision loss
898 evt
.x
:= trunc(evt
.x
*svscale
);
899 evt
.y
:= trunc(evt
.y
*svscale
);
900 evt
.dx
:= trunc(evt
.dx
*svscale
);
901 evt
.dy
:= trunc(evt
.dy
*svscale
);
905 //writeln('EXIT: FUI DISPATCH');
908 procedure uiFocus ();
910 if (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)].enabled
) then uiTopList
[High(uiTopList
)].activated();
916 if (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)].enabled
) then uiTopList
[High(uiTopList
)].blurred();
926 //if (uiContext = nil) then uiContext := TGxContext.Create();
927 gxSetContext(uiContext
, fuiRenderScale
);
928 uiContext
.resetClip();
930 for f
:= 0 to High(uiTopList
) do
934 if (f
<> High(uiTopList
)) then
936 cidx
:= ctl
.getColorIndex
;
937 uiContext
.darkenRect(ctl
.x0
, ctl
.y0
, ctl
.width
, ctl
.height
, ctl
.mDarken
[cidx
]);
946 function uiGetFocusedCtl (): TUIControl
;
948 if (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)].enabled
) then result
:= uiTopList
[High(uiTopList
)].mFocused
else result
:= nil;
952 procedure uiAddWindow (ctl
: TUIControl
);
956 if (ctl
= nil) then exit
;
958 if not (ctl
is TUITopWindow
) then exit
; // alas
959 for f
:= 0 to High(uiTopList
) do
961 if (uiTopList
[f
] = ctl
) then
963 if (f
<> High(uiTopList
)) then
965 if (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)].enabled
) then uiTopList
[High(uiTopList
)].blurred();
966 for c
:= f
+1 to High(uiTopList
) do uiTopList
[c
-1] := uiTopList
[c
];
967 uiTopList
[High(uiTopList
)] := ctl
;
973 if (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)].enabled
) then uiTopList
[High(uiTopList
)].blurred();
974 SetLength(uiTopList
, Length(uiTopList
)+1);
975 uiTopList
[High(uiTopList
)] := ctl
;
976 if (not ctl
.mStyleLoaded
) then ctl
.updateStyle();
981 procedure uiRemoveWindow (ctl
: TUIControl
);
985 if (ctl
= nil) then exit
;
987 if not (ctl
is TUITopWindow
) then exit
; // alas
988 for f
:= 0 to High(uiTopList
) do
990 if (uiTopList
[f
] = ctl
) then
993 for c
:= f
+1 to High(uiTopList
) do uiTopList
[c
-1] := uiTopList
[c
];
994 SetLength(uiTopList
, Length(uiTopList
)-1);
995 if (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)].enabled
) then uiTopList
[High(uiTopList
)].activated();
996 if (ctl
is TUITopWindow
) then
999 if assigned(TUITopWindow(ctl
).closeCB
) then TUITopWindow(ctl
).closeCB(ctl
);
1001 if (TUITopWindow(ctl
).mFreeOnClose
) then scheduleKill(ctl
);
1010 function uiVisibleWindow (ctl
: TUIControl
): Boolean;
1015 if (ctl
= nil) then exit
;
1016 ctl
:= ctl
.topLevel
;
1017 if not (ctl
is TUITopWindow
) then exit
; // alas
1018 for f
:= 0 to High(uiTopList
) do
1020 if (uiTopList
[f
] = ctl
) then begin result
:= true; exit
; end;
1025 // ////////////////////////////////////////////////////////////////////////// //
1026 constructor TUIControl
.Create ();
1031 procedure TUIControl
.AfterConstruction ();
1039 mHeight
:= uiContext
.charHeight(' ');
1047 mDrawShadow
:= false;
1049 // layouter interface
1050 //mDefSize := TLaySize.Create(64, uiContext.charHeight(' ')); // default size
1051 mDefSize
:= TLaySize
.Create(0, 0); // default size: hidden control
1052 mMaxSize
:= TLaySize
.Create(-1, -1); // maximum size
1053 mPadding
:= TLaySize
.Create(0, 0);
1061 mAlign
:= -1; // left/top
1063 mStyleLoaded
:= false;
1067 destructor TUIControl
.Destroy ();
1071 if (mParent
<> nil) then
1074 for f
:= 0 to High(mParent
.mChildren
) do
1076 if (mParent
.mChildren
[f
] = self
) then
1078 for c
:= f
+1 to High(mParent
.mChildren
) do mParent
.mChildren
[c
-1] := mParent
.mChildren
[c
];
1079 SetLength(mParent
.mChildren
, Length(mParent
.mChildren
)-1);
1083 for f
:= 0 to High(mChildren
) do
1085 mChildren
[f
].mParent
:= nil;
1086 mChildren
[f
].Free();
1092 function TUIControl
.getColorIndex (): Integer; inline;
1094 if (not enabled
) then begin result
:= ClrIdxDisabled
; exit
; end;
1095 // top windows: no focus hack
1096 if (self
is TUITopWindow
) then
1098 if (getActive
) then begin result
:= ClrIdxActive
; exit
; end;
1102 // if control cannot be focused, take "active" color scheme for it (it is easier this way)
1103 if (not canFocus
) or (getActive
) then begin result
:= ClrIdxActive
; exit
; end;
1105 result
:= ClrIdxInactive
;
1108 procedure TUIControl
.updateStyle ();
1110 stl
: TUIStyle
= nil;
1114 while (ctl
<> nil) do
1116 if (Length(ctl
.mStyleId
) <> 0) then begin stl
:= uiFindStyle(ctl
.mStyleId
); break
; end;
1119 if (stl
= nil) then stl
:= uiFindStyle(''); // default
1121 for ctl
in mChildren
do ctl
.updateStyle();
1122 mStyleLoaded
:= true;
1125 procedure TUIControl
.cacheStyle (root
: TUIStyle
);
1129 //writeln('caching style for <', className, '> (', mCtl4Style, ')...');
1132 mBackColor
[ClrIdxActive
] := root
.get('back-color', 'active', cst
).asRGBADef(TGxRGBA
.Create(0, 0, 128));
1133 mTextColor
[ClrIdxActive
] := root
.get('text-color', 'active', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
1134 mFrameColor
[ClrIdxActive
] := root
.get('frame-color', 'active', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
1135 mFrameTextColor
[ClrIdxActive
] := root
.get('frame-text-color', 'active', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
1136 mFrameIconColor
[ClrIdxActive
] := root
.get('frame-icon-color', 'active', cst
).asRGBADef(TGxRGBA
.Create(0, 255, 0));
1137 mSBarFullColor
[ClrIdxActive
] := root
.get('scrollbar-full-color', 'active', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
1138 mSBarEmptyColor
[ClrIdxActive
] := root
.get('scrollbar-empty-color', 'active', cst
).asRGBADef(TGxRGBA
.Create(128, 128, 128));
1139 mDarken
[ClrIdxActive
] := root
.get('darken', 'active', cst
).asInt(666);
1141 mBackColor
[ClrIdxDisabled
] := root
.get('back-color', 'disabled', cst
).asRGBADef(TGxRGBA
.Create(0, 0, 128));
1142 mTextColor
[ClrIdxDisabled
] := root
.get('text-color', 'disabled', cst
).asRGBADef(TGxRGBA
.Create(127, 127, 127));
1143 mFrameColor
[ClrIdxDisabled
] := root
.get('frame-color', 'disabled', cst
).asRGBADef(TGxRGBA
.Create(127, 127, 127));
1144 mFrameTextColor
[ClrIdxDisabled
] := root
.get('frame-text-color', 'disabled', cst
).asRGBADef(TGxRGBA
.Create(127, 127, 127));
1145 mFrameIconColor
[ClrIdxDisabled
] := root
.get('frame-icon-color', 'disabled', cst
).asRGBADef(TGxRGBA
.Create(0, 127, 0));
1146 mSBarFullColor
[ClrIdxDisabled
] := root
.get('scrollbar-full-color', 'disabled', cst
).asRGBADef(TGxRGBA
.Create(127, 127, 127));
1147 mSBarEmptyColor
[ClrIdxDisabled
] := root
.get('scrollbar-empty-color', 'disabled', cst
).asRGBADef(TGxRGBA
.Create(98, 98, 98));
1148 mDarken
[ClrIdxDisabled
] := root
.get('darken', 'disabled', cst
).asInt(666);
1150 mBackColor
[ClrIdxInactive
] := root
.get('back-color', 'inactive', cst
).asRGBADef(TGxRGBA
.Create(0, 0, 128));
1151 mTextColor
[ClrIdxInactive
] := root
.get('text-color', 'inactive', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
1152 mFrameColor
[ClrIdxInactive
] := root
.get('frame-color', 'inactive', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
1153 mFrameTextColor
[ClrIdxInactive
] := root
.get('frame-text-color', 'inactive', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
1154 mFrameIconColor
[ClrIdxInactive
] := root
.get('frame-icon-color', 'inactive', cst
).asRGBADef(TGxRGBA
.Create(0, 255, 0));
1155 mSBarFullColor
[ClrIdxInactive
] := root
.get('scrollbar-full-color', 'inactive', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
1156 mSBarEmptyColor
[ClrIdxInactive
] := root
.get('scrollbar-empty-color', 'inactive', cst
).asRGBADef(TGxRGBA
.Create(128, 128, 128));
1157 mDarken
[ClrIdxInactive
] := root
.get('darken', 'inactive', cst
).asInt(666);
1161 // ////////////////////////////////////////////////////////////////////////// //
1162 function TUIControl
.getDefSize (): TLaySize
; inline; begin result
:= mLayDefSize
; end;
1163 function TUIControl
.getMaxSize (): TLaySize
; inline; begin result
:= mLayMaxSize
; end;
1164 function TUIControl
.getPadding (): TLaySize
; inline; begin result
:= mPadding
; end;
1165 function TUIControl
.getFlex (): Integer; inline; begin result
:= mFlex
; end;
1166 function TUIControl
.isHorizBox (): Boolean; inline; begin result
:= mHoriz
; end;
1167 function TUIControl
.noPad (): Boolean; inline; begin result
:= mNoPad
; end;
1168 function TUIControl
.getAlign (): Integer; inline; begin result
:= mAlign
; end;
1169 function TUIControl
.getExpand (): Boolean; inline; begin result
:= mExpand
; end;
1170 function TUIControl
.getHGroup (): AnsiString; inline; begin result
:= mHGroup
; end;
1171 function TUIControl
.getVGroup (): AnsiString; inline; begin result
:= mVGroup
; end;
1172 function TUIControl
.getMargins (): TLayMargins
; inline; begin result
:= TLayMargins
.Create(mFrameHeight
, mFrameWidth
, mFrameHeight
, mFrameWidth
); end;
1174 procedure TUIControl
.setActualSizePos (constref apos
: TLayPos
; constref asize
: TLaySize
); inline;
1176 //writeln(self.className, '; pos=', apos.toString, '; size=', asize.toString);
1177 if (mParent
<> nil) then
1184 if (mLayMaxSize
.w
>= 0) then mWidth
:= nmin(mWidth
, mLayMaxSize
.w
);
1185 if (mLayMaxSize
.h
>= 0) then mHeight
:= nmin(mHeight
, mLayMaxSize
.h
);
1188 procedure TUIControl
.layPrepare ();
1190 mLayDefSize
:= mDefSize
;
1191 if (mLayDefSize
.w
<> 0) or (mLayDefSize
.h
<> 0) then
1193 mLayMaxSize
:= mMaxSize
;
1194 if (mLayMaxSize
.w
>= 0) then begin mLayDefSize
.w
+= mFrameWidth
*2; mLayMaxSize
.w
+= mFrameWidth
*2; end;
1195 if (mLayMaxSize
.h
>= 0) then begin mLayDefSize
.h
+= mFrameHeight
*2; mLayMaxSize
.h
+= mFrameHeight
*2; end;
1199 mLayMaxSize
:= TLaySize
.Create(0, 0);
1204 // ////////////////////////////////////////////////////////////////////////// //
1205 function TUIControl
.parsePos (par
: TTextParser
): TLayPos
;
1207 ech
: AnsiChar = ')';
1209 if (par
.eatDelim('[')) then ech
:= ']' else par
.expectDelim('(');
1210 result
.x
:= par
.expectInt();
1211 par
.eatDelim(','); // optional comma
1212 result
.y
:= par
.expectInt();
1213 par
.eatDelim(','); // optional comma
1214 par
.expectDelim(ech
);
1217 function TUIControl
.parseSize (par
: TTextParser
): TLaySize
;
1219 ech
: AnsiChar = ')';
1221 if (par
.eatDelim('[')) then ech
:= ']' else par
.expectDelim('(');
1222 result
.w
:= par
.expectInt();
1223 par
.eatDelim(','); // optional comma
1224 result
.h
:= par
.expectInt();
1225 par
.eatDelim(','); // optional comma
1226 par
.expectDelim(ech
);
1229 function TUIControl
.parsePadding (par
: TTextParser
): TLaySize
;
1231 result
:= parseSize(par
);
1234 function TUIControl
.parseHPadding (par
: TTextParser
; def
: Integer): TLaySize
;
1239 result
.w
:= par
.expectInt();
1243 result
:= parsePadding(par
);
1247 function TUIControl
.parseVPadding (par
: TTextParser
; def
: Integer): TLaySize
;
1252 result
.h
:= par
.expectInt();
1256 result
:= parsePadding(par
);
1260 function TUIControl
.parseBool (par
: TTextParser
): Boolean;
1263 par
.eatIdOrStrCI('true') or
1264 par
.eatIdOrStrCI('yes') or
1265 par
.eatIdOrStrCI('tan');
1268 if (not par
.eatIdOrStrCI('false')) and (not par
.eatIdOrStrCI('no')) and (not par
.eatIdOrStrCI('ona')) then
1270 par
.error('boolean value expected');
1275 function TUIControl
.parseAnyAlign (par
: TTextParser
): Integer;
1277 if (par
.eatIdOrStrCI('left')) or (par
.eatIdOrStrCI('top')) then result
:= -1
1278 else if (par
.eatIdOrStrCI('right')) or (par
.eatIdOrStrCI('bottom')) then result
:= 1
1279 else if (par
.eatIdOrStrCI('center')) then result
:= 0
1280 else par
.error('invalid align value');
1283 function TUIControl
.parseHAlign (par
: TTextParser
): Integer;
1285 if (par
.eatIdOrStrCI('left')) then result
:= -1
1286 else if (par
.eatIdOrStrCI('right')) then result
:= 1
1287 else if (par
.eatIdOrStrCI('center')) then result
:= 0
1288 else par
.error('invalid horizontal align value');
1291 function TUIControl
.parseVAlign (par
: TTextParser
): Integer;
1293 if (par
.eatIdOrStrCI('top')) then result
:= -1
1294 else if (par
.eatIdOrStrCI('bottom')) then result
:= 1
1295 else if (par
.eatIdOrStrCI('center')) then result
:= 0
1296 else par
.error('invalid vertical align value');
1299 procedure TUIControl
.parseTextAlign (par
: TTextParser
; var h
, v
: Integer);
1301 wasH
: Boolean = false;
1302 wasV
: Boolean = false;
1306 if (par
.eatIdOrStrCI('left')) then
1308 if wasH
then par
.error('too many align directives');
1313 if (par
.eatIdOrStrCI('right')) then
1315 if wasH
then par
.error('too many align directives');
1320 if (par
.eatIdOrStrCI('hcenter')) then
1322 if wasH
then par
.error('too many align directives');
1327 if (par
.eatIdOrStrCI('top')) then
1329 if wasV
then par
.error('too many align directives');
1334 if (par
.eatIdOrStrCI('bottom')) then
1336 if wasV
then par
.error('too many align directives');
1341 if (par
.eatIdOrStrCI('vcenter')) then
1343 if wasV
then par
.error('too many align directives');
1348 if (par
.eatIdOrStrCI('center')) then
1350 if wasV
or wasH
then par
.error('too many align directives');
1359 if not wasV
and not wasH
then par
.error('invalid align value');
1362 function TUIControl
.parseOrientation (const prname
: AnsiString; par
: TTextParser
): Boolean;
1364 if (strEquCI1251(prname
, 'orientation')) or (strEquCI1251(prname
, 'orient')) then
1366 if (par
.eatIdOrStrCI('horizontal')) or (par
.eatIdOrStrCI('horiz')) then mHoriz
:= true
1367 else if (par
.eatIdOrStrCI('vertical')) or (par
.eatIdOrStrCI('vert')) then mHoriz
:= false
1368 else par
.error('`horizontal` or `vertical` expected');
1377 // par should be on '{'; final '}' is eaten
1378 procedure TUIControl
.parseProperties (par
: TTextParser
);
1382 if (not par
.eatDelim('{')) then exit
;
1383 while (not par
.eatDelim('}')) do
1385 if (not par
.isIdOrStr
) then par
.error('property name expected');
1388 par
.eatDelim(':'); // optional
1389 if not parseProperty(pn
, par
) then par
.errorfmt('invalid property name ''%s''', [pn
]);
1390 par
.eatDelim(','); // optional
1394 // par should be on '{'
1395 procedure TUIControl
.parseChildren (par
: TTextParser
);
1397 cc
: TUIControlClass
;
1400 par
.expectDelim('{');
1401 while (not par
.eatDelim('}')) do
1403 if (not par
.isIdOrStr
) then par
.error('control name expected');
1404 cc
:= findCtlClass(par
.tokStr
);
1405 if (cc
= nil) then par
.errorfmt('unknown control name: ''%s''', [par
.tokStr
]);
1406 //writeln('children for <', par.tokStr, '>: <', cc.className, '>');
1408 par
.eatDelim(':'); // optional
1410 //writeln(' mHoriz=', ctl.mHoriz);
1412 ctl
.parseProperties(par
);
1417 //writeln(': ', ctl.mDefSize.toString);
1419 par
.eatDelim(','); // optional
1424 function TUIControl
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
1427 if (strEquCI1251(prname
, 'id')) then begin mId
:= par
.expectIdOrStr(true); exit
; end; // allow empty strings
1428 if (strEquCI1251(prname
, 'style')) then begin mStyleId
:= par
.expectIdOrStr(); exit
; end; // no empty strings
1429 if (strEquCI1251(prname
, 'flex')) then begin flex
:= par
.expectInt(); exit
; end;
1431 if (strEquCI1251(prname
, 'defsize')) or (strEquCI1251(prname
, 'size')) then begin mDefSize
:= parseSize(par
); exit
; end;
1432 if (strEquCI1251(prname
, 'maxsize')) then begin mMaxSize
:= parseSize(par
); exit
; end;
1433 if (strEquCI1251(prname
, 'defwidth')) or (strEquCI1251(prname
, 'width')) then begin mDefSize
.w
:= par
.expectInt(); exit
; end;
1434 if (strEquCI1251(prname
, 'defheight')) or (strEquCI1251(prname
, 'height')) then begin mDefSize
.h
:= par
.expectInt(); exit
; end;
1435 if (strEquCI1251(prname
, 'maxwidth')) then begin mMaxSize
.w
:= par
.expectInt(); exit
; end;
1436 if (strEquCI1251(prname
, 'maxheight')) then begin mMaxSize
.h
:= par
.expectInt(); exit
; end;
1438 if (strEquCI1251(prname
, 'padding')) then begin mPadding
:= parsePadding(par
); exit
; end;
1439 if (strEquCI1251(prname
, 'nopad')) then begin mNoPad
:= true; exit
; end;
1441 if (strEquCI1251(prname
, 'expand')) then begin mExpand
:= parseBool(par
); exit
; end;
1443 if (strEquCI1251(prname
, 'align')) then begin mAlign
:= parseAnyAlign(par
); exit
; end;
1444 if (strEquCI1251(prname
, 'hgroup')) then begin mHGroup
:= par
.expectIdOrStr(true); exit
; end; // allow empty strings
1445 if (strEquCI1251(prname
, 'vgroup')) then begin mVGroup
:= par
.expectIdOrStr(true); exit
; end; // allow empty strings
1447 if (strEquCI1251(prname
, 'canfocus')) then begin mCanFocus
:= true; exit
; end;
1448 if (strEquCI1251(prname
, 'nofocus')) then begin mCanFocus
:= false; exit
; end;
1449 if (strEquCI1251(prname
, 'disabled')) then begin mEnabled
:= false; exit
; end;
1450 if (strEquCI1251(prname
, 'enabled')) then begin mEnabled
:= true; exit
; end;
1451 if (strEquCI1251(prname
, 'escclose')) then begin mEscClose
:= not parseBool(par
); exit
; end;
1452 if (strEquCI1251(prname
, 'default')) then begin mDefault
:= true; exit
; end;
1453 if (strEquCI1251(prname
, 'cancel')) then begin mCancel
:= true; exit
; end;
1458 // ////////////////////////////////////////////////////////////////////////// //
1459 procedure TUIControl
.activated ();
1461 makeVisibleInParent();
1465 procedure TUIControl
.blurred ();
1467 if (uiGrabCtl
= self
) then uiGrabCtl
:= nil;
1471 procedure TUIControl
.calcFullClientSize ();
1475 mFullSize
:= TLaySize
.Create(0, 0);
1476 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1477 for ctl
in mChildren
do
1479 ctl
.calcFullClientSize();
1480 mFullSize
.w
:= nmax(mFullSize
.w
, ctl
.mX
-mFrameWidth
+ctl
.mFullSize
.w
);
1481 mFullSize
.h
:= nmax(mFullSize
.h
, ctl
.mY
-mFrameHeight
+ctl
.mFullSize
.h
);
1483 mFullSize
.w
:= nmax(mFullSize
.w
, mWidth
-mFrameWidth
*2);
1484 mFullSize
.h
:= nmax(mFullSize
.h
, mHeight
-mFrameHeight
*2);
1488 function TUIControl
.topLevel (): TUIControl
; inline;
1491 while (result
.mParent
<> nil) do result
:= result
.mParent
;
1495 function TUIControl
.getEnabled (): Boolean;
1500 if (not mEnabled
) then exit
;
1502 while (ctl
<> nil) do
1504 if (not ctl
.mEnabled
) then exit
;
1511 procedure TUIControl
.setEnabled (v
: Boolean); inline;
1513 if (mEnabled
= v
) then exit
;
1515 if (not v
) and focused
then setFocused(false);
1519 function TUIControl
.getFocused (): Boolean; inline;
1521 if (mParent
= nil) then
1523 result
:= (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)] = self
);
1527 result
:= (topLevel
.mFocused
= self
);
1528 if (result
) then result
:= (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)] = topLevel
);
1533 function TUIControl
.getActive (): Boolean; inline;
1537 if (mParent
= nil) then
1539 result
:= (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)] = self
);
1543 ctl
:= topLevel
.mFocused
;
1544 while (ctl
<> nil) and (ctl
<> self
) do ctl
:= ctl
.mParent
;
1545 result
:= (ctl
= self
);
1546 if (result
) then result
:= (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)] = topLevel
);
1551 procedure TUIControl
.setFocused (v
: Boolean); inline;
1558 if (tl
.mFocused
= self
) then
1560 blurred(); // this will reset grab, but still...
1561 if (uiGrabCtl
= self
) then uiGrabCtl
:= nil;
1562 tl
.mFocused
:= tl
.findNextFocus(self
, true);
1563 if (tl
.mFocused
= self
) then tl
.mFocused
:= nil;
1564 if (tl
.mFocused
<> nil) then tl
.mFocused
.activated();
1568 if (not canFocus
) then exit
;
1569 if (tl
.mFocused
<> self
) then
1571 if (tl
.mFocused
<> nil) then tl
.mFocused
.blurred();
1572 tl
.mFocused
:= self
;
1573 if (uiGrabCtl
<> self
) then uiGrabCtl
:= nil;
1579 function TUIControl
.getCanFocus (): Boolean; inline;
1581 result
:= (getEnabled
) and (mCanFocus
) and (mWidth
> 0) and (mHeight
> 0);
1585 function TUIControl
.isMyChild (ctl
: TUIControl
): Boolean;
1588 while (ctl
<> nil) do
1590 if (ctl
.mParent
= self
) then exit
;
1597 // returns `true` if global coords are inside this control
1598 function TUIControl
.toLocal (var x
, y
: Integer): Boolean;
1600 if (mParent
= nil) then
1604 result
:= true; // hack
1608 result
:= mParent
.toLocal(x
, y
);
1609 Inc(x
, mParent
.mScrollX
);
1610 Inc(y
, mParent
.mScrollY
);
1613 if result
then result
:= (x
>= 0) and (y
>= 0) and (x
< mParent
.mWidth
) and (y
< mParent
.mHeight
);
1615 if result
then result
:= (x
>= 0) and (y
>= 0) and (x
< mWidth
) and (y
< mHeight
);
1618 function TUIControl
.toLocal (gx
, gy
: Integer; out x
, y
: Integer): Boolean; inline;
1622 result
:= toLocal(x
, y
);
1626 procedure TUIControl
.toGlobal (var x
, y
: Integer);
1630 if (mParent
<> nil) then
1632 Dec(x
, mParent
.mScrollX
);
1633 Dec(y
, mParent
.mScrollY
);
1634 mParent
.toGlobal(x
, y
);
1638 procedure TUIControl
.toGlobal (lx
, ly
: Integer; out x
, y
: Integer); inline;
1645 procedure TUIControl
.getDrawRect (out gx
, gy
, wdt
, hgt
: Integer);
1649 if (mParent
= nil) then
1658 toGlobal(0, 0, cgx
, cgy
);
1659 mParent
.getDrawRect(gx
, gy
, wdt
, hgt
);
1660 if (wdt
> 0) and (hgt
> 0) then
1662 if (not intersectRect(gx
, gy
, wdt
, hgt
, cgx
, cgy
, mWidth
, mHeight
)) then
1672 // x and y are global coords
1673 function TUIControl
.controlAtXY (x
, y
: Integer; allowDisabled
: Boolean=false): TUIControl
;
1679 if (not allowDisabled
) and (not enabled
) then exit
;
1680 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1681 if not toLocal(x
, y
, lx
, ly
) then exit
;
1682 for f
:= High(mChildren
) downto 0 do
1684 result
:= mChildren
[f
].controlAtXY(x
, y
, allowDisabled
);
1685 if (result
<> nil) then exit
;
1691 function TUIControl
.parentScrollX (): Integer; inline; begin if (mParent
<> nil) then result
:= mParent
.mScrollX
else result
:= 0; end;
1692 function TUIControl
.parentScrollY (): Integer; inline; begin if (mParent
<> nil) then result
:= mParent
.mScrollY
else result
:= 0; end;
1695 procedure TUIControl
.makeVisibleInParent ();
1697 sy
, ey
, cy
: Integer;
1700 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1702 if (p
= nil) then exit
;
1703 if (p
.mFullSize
.w
< 1) or (p
.mFullSize
.h
< 1) then
1709 p
.makeVisibleInParent();
1710 cy
:= mY
-p
.mFrameHeight
;
1712 ey
:= sy
+(p
.mHeight
-p
.mFrameHeight
*2);
1715 p
.mScrollY
:= nmax(0, cy
);
1717 else if (cy
+mHeight
> ey
) then
1719 p
.mScrollY
:= nmax(0, cy
+mHeight
-(p
.mHeight
-p
.mFrameHeight
*2));
1724 // ////////////////////////////////////////////////////////////////////////// //
1725 function TUIControl
.prevSibling (): TUIControl
;
1729 if (mParent
<> nil) then
1731 for f
:= 1 to High(mParent
.mChildren
) do
1733 if (mParent
.mChildren
[f
] = self
) then begin result
:= mParent
.mChildren
[f
-1]; exit
; end;
1739 function TUIControl
.nextSibling (): TUIControl
;
1743 if (mParent
<> nil) then
1745 for f
:= 0 to High(mParent
.mChildren
)-1 do
1747 if (mParent
.mChildren
[f
] = self
) then begin result
:= mParent
.mChildren
[f
+1]; exit
; end;
1753 function TUIControl
.firstChild (): TUIControl
; inline;
1755 if (Length(mChildren
) <> 0) then result
:= mChildren
[0] else result
:= nil;
1758 function TUIControl
.lastChild (): TUIControl
; inline;
1760 if (Length(mChildren
) <> 0) then result
:= mChildren
[High(mChildren
)] else result
:= nil;
1764 function TUIControl
.findFirstFocus (): TUIControl
;
1771 for f
:= 0 to High(mChildren
) do
1773 result
:= mChildren
[f
].findFirstFocus();
1774 if (result
<> nil) then exit
;
1776 if (canFocus
) then result
:= self
;
1781 function TUIControl
.findLastFocus (): TUIControl
;
1788 for f
:= High(mChildren
) downto 0 do
1790 result
:= mChildren
[f
].findLastFocus();
1791 if (result
<> nil) then exit
;
1793 if (canFocus
) then result
:= self
;
1798 function TUIControl
.findNextFocus (cur
: TUIControl
; wrap
: Boolean): TUIControl
;
1800 curHit
: Boolean = false;
1802 function checkFocus (ctl
: TUIControl
): Boolean;
1806 result
:= (ctl
.canFocus
);
1810 curHit
:= (ctl
= cur
);
1811 result
:= false; // don't stop
1819 if not isMyChild(cur
) then
1821 result
:= findFirstFocus();
1825 result
:= forEachControl(checkFocus
);
1826 if (result
= nil) and (wrap
) then result
:= findFirstFocus();
1832 function TUIControl
.findPrevFocus (cur
: TUIControl
; wrap
: Boolean): TUIControl
;
1834 lastCtl
: TUIControl
= nil;
1836 function checkFocus (ctl
: TUIControl
): Boolean;
1845 if (ctl
.canFocus
) then lastCtl
:= ctl
;
1853 if not isMyChild(cur
) then
1855 result
:= findLastFocus();
1859 forEachControl(checkFocus
);
1860 if (lastCtl
= nil) and (wrap
) then lastCtl
:= findLastFocus();
1862 //if (lastCtl <> nil) then writeln('ctl<', lastCtl.className, '>: {', lastCtl.id, '}');
1868 function TUIControl
.findDefaulControl (): TUIControl
;
1874 if (mDefault
) then begin result
:= self
; exit
; end;
1875 for ctl
in mChildren
do
1877 result
:= ctl
.findDefaulControl();
1878 if (result
<> nil) then exit
;
1884 function TUIControl
.findCancelControl (): TUIControl
;
1890 if (mCancel
) then begin result
:= self
; exit
; end;
1891 for ctl
in mChildren
do
1893 result
:= ctl
.findCancelControl();
1894 if (result
<> nil) then exit
;
1901 function TUIControl
.findControlById (const aid
: AnsiString): TUIControl
;
1905 if (strEquCI1251(aid
, mId
)) then begin result
:= self
; exit
; end;
1906 for ctl
in mChildren
do
1908 result
:= ctl
.findControlById(aid
);
1909 if (result
<> nil) then exit
;
1915 procedure TUIControl
.appendChild (ctl
: TUIControl
);
1917 if (ctl
= nil) then exit
;
1918 if (ctl
.mParent
<> nil) then exit
;
1919 SetLength(mChildren
, Length(mChildren
)+1);
1920 mChildren
[High(mChildren
)] := ctl
;
1921 ctl
.mParent
:= self
;
1922 Inc(ctl
.mX
, mFrameWidth
);
1923 Inc(ctl
.mY
, mFrameHeight
);
1924 if (ctl
.mWidth
> 0) and (ctl
.mHeight
> 0) and
1925 (ctl
.mX
+ctl
.mWidth
> mFrameWidth
) and (ctl
.mY
+ctl
.mHeight
> mFrameHeight
) then
1927 if (mWidth
+mFrameWidth
< ctl
.mX
+ctl
.mWidth
) then mWidth
:= ctl
.mX
+ctl
.mWidth
+mFrameWidth
;
1928 if (mHeight
+mFrameHeight
< ctl
.mY
+ctl
.mHeight
) then mHeight
:= ctl
.mY
+ctl
.mHeight
+mFrameHeight
;
1933 function TUIControl
.setActionCBFor (const aid
: AnsiString; cb
: TActionCB
): TActionCB
;
1938 if (ctl
<> nil) then
1940 result
:= ctl
.actionCB
;
1950 function TUIControl
.forEachChildren (cb
: TCtlEnumCB
): TUIControl
;
1955 if (not assigned(cb
)) then exit
;
1956 for ctl
in mChildren
do
1958 if cb(ctl
) then begin result
:= ctl
; exit
; end;
1963 function TUIControl
.forEachControl (cb
: TCtlEnumCB
; includeSelf
: Boolean=true): TUIControl
;
1965 function forChildren (p
: TUIControl
; incSelf
: Boolean): TUIControl
;
1970 if (p
= nil) then exit
;
1971 if (incSelf
) and (cb(p
)) then begin result
:= p
; exit
; end;
1972 for ctl
in p
.mChildren
do
1974 result
:= forChildren(ctl
, true);
1975 if (result
<> nil) then break
;
1981 if (not assigned(cb
)) then exit
;
1982 result
:= forChildren(self
, includeSelf
);
1986 procedure TUIControl
.close (); // this closes *top-level* control
1991 uiRemoveWindow(ctl
);
1992 if (ctl
is TUITopWindow
) and (TUITopWindow(ctl
).mFreeOnClose
) then scheduleKill(ctl
); // just in case
1996 procedure TUIControl
.doAction ();
1998 if assigned(actionCB
) then actionCB(self
);
2002 // ////////////////////////////////////////////////////////////////////////// //
2003 procedure TUIControl
.setScissor (lx
, ly
, lw
, lh
: Integer);
2005 gx
, gy
, wdt
, hgt
, cgx
, cgy
: Integer;
2007 if (not intersectRect(lx
, ly
, lw
, lh
, 0, 0, mWidth
, mHeight
)) then
2009 uiContext
.clip
:= TGxRect
.Create(0, 0, 0, 0);
2013 getDrawRect(gx
, gy
, wdt
, hgt
);
2015 toGlobal(lx
, ly
, cgx
, cgy
);
2016 if (not intersectRect(gx
, gy
, wdt
, hgt
, cgx
, cgy
, lw
, lh
)) then
2018 uiContext
.clip
:= TGxRect
.Create(0, 0, 0, 0);
2022 uiContext
.clip
:= savedClip
;
2023 uiContext
.combineClip(TGxRect
.Create(gx
, gy
, wdt
, hgt
));
2024 //uiContext.clip := TGxRect.Create(gx, gy, wdt, hgt);
2027 procedure TUIControl
.resetScissorNC (); inline;
2029 setScissor(0, 0, mWidth
, mHeight
);
2032 procedure TUIControl
.resetScissor (); inline;
2034 if ((mFrameWidth
<= 0) and (mFrameHeight
<= 0)) then
2040 setScissor(mFrameWidth
, mFrameHeight
, mWidth
-mFrameWidth
*2, mHeight
-mFrameHeight
*2);
2045 // ////////////////////////////////////////////////////////////////////////// //
2046 procedure TUIControl
.drawFrame (gx
, gy
, resx
, thalign
: Integer; const text: AnsiString; dbl
: Boolean);
2048 cidx
, tx
, tw
: Integer;
2050 if (mFrameWidth
< 1) or (mFrameHeight
< 1) then exit
;
2051 cidx
:= getColorIndex
;
2052 uiContext
.color
:= mFrameColor
[cidx
];
2053 case mFrameHeight
of
2058 uiContext
.rect(gx
+3, gy
+3, mWidth
-6, mHeight
-6);
2059 uiContext
.rect(gx
+5, gy
+5, mWidth
-10, mHeight
-10);
2063 uiContext
.rect(gx
+4, gy
+4, mWidth
-8, mHeight
-8);
2070 uiContext
.rect(gx
+3, gy
+3+3, mWidth
-6, mHeight
-6-6);
2071 uiContext
.rect(gx
+5, gy
+5+3, mWidth
-10, mHeight
-10-6);
2075 uiContext
.rect(gx
+4, gy
+4+3, mWidth
-8, mHeight
-8-6);
2082 uiContext
.rect(gx
+3, gy
+3+4, mWidth
-6, mHeight
-6-8);
2083 uiContext
.rect(gx
+5, gy
+5+4, mWidth
-10, mHeight
-10-8);
2087 uiContext
.rect(gx
+4, gy
+4+4, mWidth
-8, mHeight
-8-8);
2103 if (Length(text) > 0) then
2105 if (resx
< 0) then resx
:= 0;
2106 tw
:= uiContext
.textWidth(text);
2107 setScissor(mFrameWidth
+resx
, 0, mWidth
-mFrameWidth
*2-resx
, mFrameHeight
);
2108 if (thalign
< 0) then tx
:= gx
+resx
+mFrameWidth
+2
2109 else if (thalign
> 0) then tx
:= gx
+mWidth
-mFrameWidth
-1-tw
2110 else tx
:= (gx
+resx
+mFrameWidth
)+(mWidth
-mFrameWidth
*2-resx
-tw
) div 2;
2111 uiContext
.color
:= mBackColor
[cidx
];
2112 uiContext
.fillRect(tx
-2, gy
, tw
+4, mFrameHeight
);
2113 uiContext
.color
:= mFrameTextColor
[cidx
];
2114 uiContext
.drawText(tx
, gy
, text);
2119 procedure TUIControl
.draw ();
2125 if (mWidth
< 1) or (mHeight
< 1) or (uiContext
= nil) or (not uiContext
.active
) then exit
;
2126 toGlobal(0, 0, gx
, gy
);
2128 savedClip
:= uiContext
.clip
;
2131 drawControl(gx
, gy
);
2133 for f
:= 0 to High(mChildren
) do mChildren
[f
].draw();
2135 drawControlPost(gx
, gy
);
2137 uiContext
.clip
:= savedClip
;
2141 procedure TUIControl
.drawControl (gx
, gy
: Integer);
2145 procedure TUIControl
.drawControlPost (gx
, gy
: Integer);
2147 // shadow for top-level controls
2148 if (mParent
= nil) and (mDrawShadow
) and (mWidth
> 0) and (mHeight
> 0) then
2150 uiContext
.resetClip();
2151 uiContext
.darkenRect(gx
+mWidth
, gy
+8, 8, mHeight
, 128);
2152 uiContext
.darkenRect(gx
+8, gy
+mHeight
, mWidth
-8, 8, 128);
2157 // ////////////////////////////////////////////////////////////////////////// //
2158 procedure TUIControl
.onEvent (var ev
: TFUIEvent
);
2160 if (not ev
.alive
) or (not enabled
) then exit
;
2161 //if (ev.mine) then writeln(' MINE: <', className, '>');
2164 if (ev
.sinking
) then keyEventSink(ev
)
2165 else if (ev
.bubbling
) then keyEventBubble(ev
)
2166 else if (ev
.mine
) then keyEvent(ev
);
2168 else if (ev
.mouse
) then
2170 if (ev
.sinking
) then mouseEventSink(ev
)
2171 else if (ev
.bubbling
) then mouseEventBubble(ev
)
2172 else if (ev
.mine
) then mouseEvent(ev
);
2177 procedure TUIControl
.mouseEventSink (var ev
: TFUIEvent
);
2181 procedure TUIControl
.mouseEventBubble (var ev
: TFUIEvent
);
2185 procedure TUIControl
.mouseEvent (var ev
: TFUIEvent
);
2190 procedure TUIControl
.keyEventSink (var ev
: TFUIEvent
);
2194 if (not enabled
) then exit
;
2195 if (not ev
.alive
) then exit
;
2196 // for top-level controls
2197 if (mParent
<> nil) then exit
;
2198 if (mEscClose
) and (ev
= 'Escape') then
2200 if (not assigned(closeRequestCB
)) or (closeRequestCB(self
)) then
2202 uiRemoveWindow(self
);
2207 if (ev
= 'Enter') or (ev
= 'C-Enter') then
2209 ctl
:= findDefaulControl();
2210 if (ctl
<> nil) then
2217 if (ev
= 'Escape') then
2219 ctl
:= findCancelControl();
2220 if (ctl
<> nil) then
2229 procedure TUIControl
.keyEventBubble (var ev
: TFUIEvent
);
2233 if (not enabled
) then exit
;
2234 if (not ev
.alive
) then exit
;
2235 // for top-level controls
2236 if (mParent
<> nil) then exit
;
2237 if (ev
= 'S-Tab') then
2239 ctl
:= findPrevFocus(mFocused
, true);
2240 if (ctl
<> nil) and (ctl
<> mFocused
) then ctl
.setFocused(true);
2244 if (ev
= 'Tab') then
2246 ctl
:= findNextFocus(mFocused
, true);
2247 if (ctl
<> nil) and (ctl
<> mFocused
) then ctl
.setFocused(true);
2253 procedure TUIControl
.keyEvent (var ev
: TFUIEvent
);
2258 // ////////////////////////////////////////////////////////////////////////// //
2259 constructor TUITopWindow
.Create (const atitle
: AnsiString);
2266 procedure TUITopWindow
.AfterConstruction ();
2269 mFitToScreen
:= true;
2271 mFrameHeight
:= uiContext
.charHeight(#184);
2272 if (mWidth
< mFrameWidth
*2+uiContext
.iconWinWidth(TGxContext
.TWinIcon
.Close
)) then mWidth
:= mFrameWidth
*2+uiContext
.iconWinWidth(TGxContext
.TWinIcon
.Close
);
2273 if (mHeight
< mFrameHeight
*2) then mHeight
:= mFrameHeight
*2;
2274 if (Length(mTitle
) > 0) then
2276 if (mWidth
< uiContext
.textWidth(mTitle
)+mFrameWidth
*2+uiContext
.iconWinWidth(TGxContext
.TWinIcon
.Close
)) then
2278 mWidth
:= uiContext
.textWidth(mTitle
)+mFrameWidth
*2+uiContext
.iconWinWidth(TGxContext
.TWinIcon
.Close
);
2282 mDragScroll
:= TXMode
.None
;
2283 mDrawShadow
:= true;
2284 mWaitingClose
:= false;
2287 mCtl4Style
:= 'window';
2288 mDefSize
.w
:= nmax(1, mDefSize
.w
);
2289 mDefSize
.h
:= nmax(1, mDefSize
.h
);
2293 function TUITopWindow
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2295 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) then
2297 mTitle
:= par
.expectIdOrStr(true);
2301 if (strEquCI1251(prname
, 'children')) then
2307 if (strEquCI1251(prname
, 'position')) then
2309 if (par
.eatIdOrStrCI('default')) then mDoCenter
:= false
2310 else if (par
.eatIdOrStrCI('center')) then mDoCenter
:= true
2311 else par
.error('`center` or `default` expected');
2315 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
2316 result
:= inherited parseProperty(prname
, par
);
2320 procedure TUITopWindow
.flFitToScreen ();
2324 nsz
:= TLaySize
.Create(trunc(fuiScrWdt
/fuiRenderScale
)-mFrameWidth
*2-6, trunc(fuiScrHgt
/fuiRenderScale
)-mFrameHeight
*2-6);
2325 if (mMaxSize
.w
< 1) then mMaxSize
.w
:= nsz
.w
;
2326 if (mMaxSize
.h
< 1) then mMaxSize
.h
:= nsz
.h
;
2330 procedure TUITopWindow
.centerInScreen ();
2332 if (mWidth
> 0) and (mHeight
> 0) then
2334 mX
:= trunc((fuiScrWdt
/fuiRenderScale
-mWidth
)/2);
2335 mY
:= trunc((fuiScrHgt
/fuiRenderScale
-mHeight
)/2);
2340 // ////////////////////////////////////////////////////////////////////////// //
2341 procedure TUITopWindow
.drawControl (gx
, gy
: Integer);
2343 uiContext
.color
:= mBackColor
[getColorIndex
];
2344 uiContext
.fillRect(gx
, gy
, mWidth
, mHeight
);
2347 procedure TUITopWindow
.drawControlPost (gx
, gy
: Integer);
2349 cidx
, iwdt
, ihgt
: Integer;
2350 ybot
, xend
, vhgt
, vwdt
: Integer;
2352 cidx
:= getColorIndex
;
2353 iwdt
:= uiContext
.iconWinWidth(TGxContext
.TWinIcon
.Close
);
2354 if (mDragScroll
= TXMode
.Drag
) then
2356 drawFrame(gx
, gy
, iwdt
, 0, mTitle
, false);
2360 ihgt
:= uiContext
.iconWinHeight(TGxContext
.TWinIcon
.Close
);
2361 drawFrame(gx
, gy
, iwdt
, 0, mTitle
, true);
2362 // vertical scroll bar
2363 vhgt
:= mHeight
-mFrameHeight
*2;
2364 if (mFullSize
.h
> vhgt
) then
2366 ybot
:= mScrollY
+vhgt
;
2368 uiContext
.drawVSBar(gx
+mWidth
-mFrameWidth
+1, gy
+mFrameHeight
-1, mFrameWidth
-3, vhgt
+2, ybot
, 0, mFullSize
.h
, mSBarFullColor
[cidx
], mSBarEmptyColor
[cidx
]);
2370 // horizontal scroll bar
2371 vwdt
:= mWidth
-mFrameWidth
*2;
2372 if (mFullSize
.w
> vwdt
) then
2374 xend
:= mScrollX
+vwdt
;
2376 uiContext
.drawHSBar(gx
+mFrameWidth
+1, gy
+mHeight
-mFrameHeight
+1, vwdt
-2, mFrameHeight
-3, xend
, 0, mFullSize
.w
, mSBarFullColor
[cidx
], mSBarEmptyColor
[cidx
]);
2379 setScissor(mFrameWidth
, 0, iwdt
, ihgt
);
2380 uiContext
.color
:= mBackColor
[cidx
];
2381 uiContext
.fillRect(gx
+mFrameWidth
, gy
, iwdt
, ihgt
);
2382 uiContext
.color
:= mFrameIconColor
[cidx
];
2383 uiContext
.drawIconWin(TGxContext
.TWinIcon
.Close
, gx
+mFrameWidth
, gy
, mInClose
);
2385 // shadow (no need to reset scissor, as draw should do it)
2386 inherited drawControlPost(gx
, gy
);
2390 // ////////////////////////////////////////////////////////////////////////// //
2391 procedure TUITopWindow
.activated ();
2393 if (mFocused
= nil) or (mFocused
= self
) then
2395 mFocused
:= findFirstFocus();
2397 if (mFocused
<> nil) and (mFocused
<> self
) then mFocused
.activated();
2402 procedure TUITopWindow
.blurred ();
2404 mDragScroll
:= TXMode
.None
;
2405 mWaitingClose
:= false;
2407 if (mFocused
<> nil) and (mFocused
<> self
) then mFocused
.blurred();
2412 procedure TUITopWindow
.keyEventBubble (var ev
: TFUIEvent
);
2414 inherited keyEvent(ev
);
2415 if (not ev
.alive
) or (not enabled
) {or (not getFocused)} then exit
;
2416 if (ev
= 'M-F3') then
2418 if (not assigned(closeRequestCB
)) or (closeRequestCB(self
)) then
2420 uiRemoveWindow(self
);
2428 procedure TUITopWindow
.mouseEvent (var ev
: TFUIEvent
);
2431 vhgt
, ytop
: Integer;
2432 vwdt
, xend
: Integer;
2434 if (not enabled
) then exit
;
2435 if (mWidth
< 1) or (mHeight
< 1) then exit
;
2437 if (mDragScroll
= TXMode
.Drag
) then
2439 mX
+= ev
.x
-mDragStartX
;
2440 mY
+= ev
.y
-mDragStartY
;
2441 mDragStartX
:= ev
.x
;
2442 mDragStartY
:= ev
.y
;
2443 if (ev
.release
) and (ev
.but
= ev
.Left
) then mDragScroll
:= TXMode
.None
;
2448 if (mDragScroll
= TXMode
.VScroll
) then
2451 vhgt
:= mHeight
-mFrameHeight
*2;
2452 ytop
:= uiContext
.sbarPos(ly
, mFrameHeight
-1, vhgt
+2, 0, mFullSize
.h
)-vhgt
;
2453 mScrollY
:= nmax(0, ytop
);
2454 if (ev
.release
) and (ev
.but
= ev
.Left
) then mDragScroll
:= TXMode
.None
;
2459 if (mDragScroll
= TXMode
.HScroll
) then
2462 vwdt
:= mWidth
-mFrameWidth
*2;
2463 xend
:= uiContext
.sbarPos(lx
, mFrameWidth
+1, vwdt
-2, 0, mFullSize
.w
)-vwdt
;
2464 mScrollX
:= nmax(0, xend
);
2465 if (ev
.release
) and (ev
.but
= ev
.Left
) then mDragScroll
:= TXMode
.None
;
2470 if toLocal(ev
.x
, ev
.y
, lx
, ly
) then
2474 if (ly
< mFrameHeight
) then
2477 if (lx
>= mFrameWidth
) and (lx
< mFrameWidth
+uiContext
.iconWinWidth(TGxContext
.TWinIcon
.Close
)) then
2479 //uiRemoveWindow(self);
2480 mWaitingClose
:= true;
2485 mDragScroll
:= TXMode
.Drag
;
2486 mDragStartX
:= ev
.x
;
2487 mDragStartY
:= ev
.y
;
2492 // check for vertical scrollbar
2493 if (lx
>= mWidth
-mFrameWidth
+1) and (ly
>= mFrameHeight
-1) and (ly
< mHeight
-mFrameHeight
+2) then
2495 vhgt
:= mHeight
-mFrameHeight
*2;
2496 if (mFullSize
.h
> vhgt
) then
2499 mDragScroll
:= TXMode
.VScroll
;
2501 ytop
:= uiContext
.sbarPos(ly
, mFrameHeight
-1, vhgt
+2, 0, mFullSize
.h
)-vhgt
;
2502 mScrollY
:= nmax(0, ytop
);
2506 // check for horizontal scrollbar
2507 if (ly
>= mHeight
-mFrameHeight
+1) and (lx
>= mFrameWidth
+1) and (lx
< mWidth
-mFrameWidth
-1) then
2509 vwdt
:= mWidth
-mFrameWidth
*2;
2510 if (mFullSize
.w
> vwdt
) then
2513 mDragScroll
:= TXMode
.HScroll
;
2515 xend
:= uiContext
.sbarPos(lx
, mFrameWidth
+1, vwdt
-2, 0, mFullSize
.w
)-vwdt
;
2516 mScrollX
:= nmax(0, xend
);
2521 if (lx
< mFrameWidth
) or (lx
>= mWidth
-mFrameWidth
) or (ly
>= mHeight
-mFrameHeight
) then
2524 mDragScroll
:= TXMode
.Drag
;
2525 mDragStartX
:= ev
.x
;
2526 mDragStartY
:= ev
.y
;
2532 if (ev
.release
) then
2534 if mWaitingClose
then
2536 if (lx
>= mFrameWidth
) and (lx
< mFrameWidth
+uiContext
.iconWinWidth(TGxContext
.TWinIcon
.Close
)) then
2538 if (not assigned(closeRequestCB
)) or (closeRequestCB(self
)) then
2540 uiRemoveWindow(self
);
2543 mWaitingClose
:= false;
2552 if mWaitingClose
then
2554 mInClose
:= (lx
>= mFrameWidth
) and (lx
< mFrameWidth
+uiContext
.iconWinWidth(TGxContext
.TWinIcon
.Close
));
2560 inherited mouseEvent(ev
);
2565 if (not ev
.motion
) and (mWaitingClose
) then begin ev
.eat(); mWaitingClose
:= false; exit
; end;
2570 // ////////////////////////////////////////////////////////////////////////// //
2571 constructor TUIBox
.Create (ahoriz
: Boolean);
2578 procedure TUIBox
.AfterConstruction ();
2582 mHAlign
:= -1; // left
2583 mCtl4Style
:= 'box';
2584 mDefSize
:= TLaySize
.Create(-1, -1);
2588 procedure TUIBox
.setCaption (const acap
: AnsiString);
2591 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mCaption
)+3, uiContext
.textHeight(mCaption
));
2595 procedure TUIBox
.setHasFrame (v
: Boolean);
2598 if (mHasFrame
) then begin mFrameWidth
:= 8; mFrameHeight
:= uiContext
.charHeight(#184); end else begin mFrameWidth
:= 0; mFrameHeight
:= 0; end;
2599 if (mHasFrame
) then mNoPad
:= true;
2603 function TUIBox
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2605 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
2606 if (strEquCI1251(prname
, 'padding')) then
2608 if (mHoriz
) then mPadding
:= parseHPadding(par
, 0) else mPadding
:= parseVPadding(par
, 0);
2612 if (strEquCI1251(prname
, 'frame')) then
2614 setHasFrame(parseBool(par
));
2618 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) then
2620 setCaption(par
.expectIdOrStr(true));
2624 if (strEquCI1251(prname
, 'textalign')) or (strEquCI1251(prname
, 'text-align')) then
2626 mHAlign
:= parseHAlign(par
);
2630 if (strEquCI1251(prname
, 'children')) then
2636 result
:= inherited parseProperty(prname
, par
);
2640 procedure TUIBox
.drawControl (gx
, gy
: Integer);
2645 cidx
:= getColorIndex
;
2646 uiContext
.color
:= mBackColor
[cidx
];
2647 uiContext
.fillRect(gx
, gy
, mWidth
, mHeight
);
2651 drawFrame(gx
, gy
, 0, mHAlign
, mCaption
, false);
2653 // no frame -- no caption
2655 else if (Length(mCaption) > 0) then
2658 if (mHAlign < 0) then xpos := 3
2659 else if (mHAlign > 0) then xpos := mWidth-mFrameWidth*2-uiContext.textWidth(mCaption)
2660 else xpos := (mWidth-mFrameWidth*2-uiContext.textWidth(mCaption)) div 2;
2661 xpos += gx+mFrameWidth;
2663 setScissor(mFrameWidth+1, 0, mWidth-mFrameWidth-2, uiContext.textHeight(mCaption));
2664 uiContext.color := mFrameTextColor[cidx];
2665 uiContext.drawText(xpos, gy, mCaption);
2671 procedure TUIBox
.mouseEvent (var ev
: TFUIEvent
);
2675 inherited mouseEvent(ev
);
2676 if (ev
.alive
) and (enabled
) and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
2683 procedure TUIBox
.keyEvent (var ev
: TFUIEvent
);
2686 cur
, ctl
: TUIControl
;
2688 inherited keyEvent(ev
);
2689 if (not ev
.alive
) or (not ev
.press
) or (not enabled
) or (not getActive
) then exit
;
2690 if (Length(mChildren
) = 0) then exit
;
2691 if (mHoriz
) and (ev
= 'Left') then dir
:= -1
2692 else if (mHoriz
) and (ev
= 'Right') then dir
:= 1
2693 else if (not mHoriz
) and (ev
= 'Up') then dir
:= -1
2694 else if (not mHoriz
) and (ev
= 'Down') then dir
:= 1;
2695 if (dir
= 0) then exit
;
2697 cur
:= topLevel
.mFocused
;
2698 while (cur
<> nil) and (cur
.mParent
<> self
) do cur
:= cur
.mParent
;
2699 //if (cur = nil) then writeln('CUR: nil') else writeln('CUR: ', cur.className, '#', cur.id);
2700 if (dir
< 0) then ctl
:= findPrevFocus(cur
, true) else ctl
:= findNextFocus(cur
, true);
2701 //if (ctl = nil) then writeln('CTL: nil') else writeln('CTL: ', ctl.className, '#', ctl.id);
2702 if (ctl
<> nil) and (ctl
<> self
) then
2704 ctl
.focused
:= true;
2709 // ////////////////////////////////////////////////////////////////////////// //
2710 constructor TUIHBox
.Create ();
2715 procedure TUIHBox
.AfterConstruction ();
2722 // ////////////////////////////////////////////////////////////////////////// //
2723 constructor TUIVBox
.Create ();
2728 procedure TUIVBox
.AfterConstruction ();
2735 // ////////////////////////////////////////////////////////////////////////// //
2736 procedure TUISpan
.AfterConstruction ();
2742 mCtl4Style
:= 'span';
2743 mDefSize
:= TLaySize
.Create(-1, -1);
2747 function TUISpan
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2749 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
2750 result
:= inherited parseProperty(prname
, par
);
2754 // ////////////////////////////////////////////////////////////////////// //
2755 procedure TUILine
.AfterConstruction ();
2761 mCtl4Style
:= 'line';
2762 mDefSize
:= TLaySize
.Create(-1, -1);
2766 function TUILine
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2768 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
2769 result
:= inherited parseProperty(prname
, par
);
2773 procedure TUILine
.layPrepare ();
2775 inherited layPrepare();
2776 if (mParent
<> nil) then mHoriz
:= not mParent
.mHoriz
;
2779 if (mLayDefSize
.w
< 0) then mLayDefSize
.w
:= 1;
2780 if (mLayDefSize
.h
< 0) then mLayDefSize
.h
:= 7;
2784 if (mLayDefSize
.w
< 0) then mLayDefSize
.w
:= 7;
2785 if (mLayDefSize
.h
< 0) then mLayDefSize
.h
:= 1;
2790 procedure TUILine
.drawControl (gx
, gy
: Integer);
2794 cidx
:= getColorIndex
;
2795 uiContext
.color
:= mTextColor
[cidx
];
2796 if mHoriz
then uiContext
.hline(gx
, gy
+(mHeight
div 2), mWidth
)
2797 else uiContext
.vline(gx
+(mWidth
div 2), gy
, mHeight
);
2801 // ////////////////////////////////////////////////////////////////////////// //
2802 procedure TUIStaticText
.AfterConstruction ();
2808 mHoriz
:= true; // nobody cares
2811 mCtl4Style
:= 'static';
2815 procedure TUIStaticText
.setText (const atext
: AnsiString);
2818 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
), uiContext
.textHeight(mText
));
2822 function TUIStaticText
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2824 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) or (strEquCI1251(prname
, 'text')) then
2826 setText(par
.expectIdOrStr(true));
2830 if (strEquCI1251(prname
, 'textalign')) or (strEquCI1251(prname
, 'text-align')) then
2832 parseTextAlign(par
, mHAlign
, mVAlign
);
2836 if (strEquCI1251(prname
, 'header')) then
2842 if (strEquCI1251(prname
, 'line')) then
2848 result
:= inherited parseProperty(prname
, par
);
2852 procedure TUIStaticText
.drawControl (gx
, gy
: Integer);
2854 xpos
, ypos
: Integer;
2857 cidx
:= getColorIndex
;
2858 uiContext
.color
:= mBackColor
[cidx
];
2859 uiContext
.fillRect(gx
, gy
, mWidth
, mHeight
);
2861 if (mHAlign
< 0) then xpos
:= 0
2862 else if (mHAlign
> 0) then xpos
:= mWidth
-uiContext
.textWidth(mText
)
2863 else xpos
:= (mWidth
-uiContext
.textWidth(mText
)) div 2;
2865 if (Length(mText
) > 0) then
2867 if (mHeader
) then uiContext
.color
:= mFrameTextColor
[cidx
] else uiContext
.color
:= mTextColor
[cidx
];
2869 if (mVAlign
< 0) then ypos
:= 0
2870 else if (mVAlign
> 0) then ypos
:= mHeight
-uiContext
.textHeight(mText
)
2871 else ypos
:= (mHeight
-uiContext
.textHeight(mText
)) div 2;
2873 uiContext
.drawText(gx
+xpos
, gy
+ypos
, mText
);
2878 if (mHeader
) then uiContext
.color
:= mFrameColor
[cidx
] else uiContext
.color
:= mTextColor
[cidx
];
2880 if (mVAlign
< 0) then ypos
:= 0
2881 else if (mVAlign
> 0) then ypos
:= mHeight
-1
2882 else ypos
:= (mHeight
div 2);
2885 if (Length(mText
) = 0) then
2887 uiContext
.hline(gx
, ypos
, mWidth
);
2891 uiContext
.hline(gx
, ypos
, xpos
-1);
2892 uiContext
.hline(gx
+xpos
+uiContext
.textWidth(mText
), ypos
, mWidth
);
2898 // ////////////////////////////////////////////////////////////////////////// //
2899 procedure TUITextLabel
.AfterConstruction ();
2905 mCtl4Style
:= 'label';
2910 procedure TUITextLabel
.cacheStyle (root
: TUIStyle
);
2912 inherited cacheStyle(root
);
2914 mHotColor
[ClrIdxActive
] := root
.get('hot-color', 'active', mCtl4Style
).asRGBADef(TGxRGBA
.Create(0, 128, 0));
2916 mHotColor
[ClrIdxDisabled
] := root
.get('hot-color', 'disabled', mCtl4Style
).asRGBADef(TGxRGBA
.Create(0, 64, 0));
2918 mHotColor
[ClrIdxInactive
] := root
.get('hot-color', 'inactive', mCtl4Style
).asRGBADef(TGxRGBA
.Create(0, 64, 0));
2922 procedure TUITextLabel
.setText (const s
: AnsiString);
2930 while (f
<= Length(s
)) do
2932 if (s
[f
] = '\\') then
2935 if (f
<= Length(s
)) then mText
+= s
[f
];
2938 else if (s
[f
] = '~') then
2941 if (f
<= Length(s
)) then
2943 if (mHotChar
= #0) then
2946 mHotOfs
:= Length(mText
);
2958 // fix hotchar offset
2959 if (mHotChar
<> #0) and (mHotOfs
> 0) then
2961 mHotOfs
:= uiContext
.textWidth(Copy(mText
, 1, mHotOfs
+1))-uiContext
.charWidth(mText
[mHotOfs
+1]);
2964 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
), uiContext
.textHeight(mText
));
2968 function TUITextLabel
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2970 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) or (strEquCI1251(prname
, 'text')) then
2972 setText(par
.expectIdOrStr(true));
2976 if (strEquCI1251(prname
, 'link')) then
2978 mLinkId
:= par
.expectIdOrStr(true);
2982 if (strEquCI1251(prname
, 'textalign')) or (strEquCI1251(prname
, 'text-align')) then
2984 parseTextAlign(par
, mHAlign
, mVAlign
);
2988 result
:= inherited parseProperty(prname
, par
);
2992 procedure TUITextLabel
.drawControl (gx
, gy
: Integer);
2994 xpos
, ypos
: Integer;
2997 cidx
:= getColorIndex
;
2998 uiContext
.color
:= mBackColor
[cidx
];
2999 uiContext
.fillRect(gx
, gy
, mWidth
, mHeight
);
3000 if (Length(mText
) > 0) then
3002 if (mHAlign
< 0) then xpos
:= 0
3003 else if (mHAlign
> 0) then xpos
:= mWidth
-uiContext
.textWidth(mText
)
3004 else xpos
:= (mWidth
-uiContext
.textWidth(mText
)) div 2;
3006 if (mVAlign
< 0) then ypos
:= 0
3007 else if (mVAlign
> 0) then ypos
:= mHeight
-uiContext
.textHeight(mText
)
3008 else ypos
:= (mHeight
-uiContext
.textHeight(mText
)) div 2;
3010 uiContext
.color
:= mTextColor
[cidx
];
3011 uiContext
.drawText(gx
+xpos
, gy
+ypos
, mText
);
3013 if (Length(mLinkId
) > 0) and (mHotChar
<> #0) and (mHotChar
<> ' ') then
3015 uiContext
.color
:= mHotColor
[cidx
];
3016 uiContext
.drawChar(gx
+xpos
+mHotOfs
, gy
+ypos
, mHotChar
);
3022 procedure TUITextLabel
.mouseEvent (var ev
: TFUIEvent
);
3026 inherited mouseEvent(ev
);
3027 if (ev
.alive
) and (enabled
) and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
3034 procedure TUITextLabel
.doAction ();
3038 if (assigned(actionCB
)) then
3044 ctl
:= topLevel
[mLinkId
];
3045 if (ctl
<> nil) then
3047 if (ctl
.canFocus
) then ctl
.focused
:= true;
3053 procedure TUITextLabel
.keyEventBubble (var ev
: TFUIEvent
);
3055 if (not enabled
) then exit
;
3056 if (mHotChar
= #0) then exit
;
3057 if (not ev
.alive
) or (not ev
.press
) then exit
;
3058 if (ev
.kstate
<> ev
.ModAlt
) then exit
;
3059 if (not ev
.isHot(mHotChar
)) then exit
;
3061 if (canFocus
) then focused
:= true;
3066 // ////////////////////////////////////////////////////////////////////////// //
3067 procedure TUIButton
.AfterConstruction ();
3074 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
)+uiContext
.textWidth('[ ]'), uiContext
.textHeight(mText
));
3075 mCtl4Style
:= 'button';
3076 mSkipLayPrepare
:= false;
3077 mAddMarkers
:= false;
3078 mHideMarkers
:= false;
3082 procedure TUIButton
.cacheStyle (root
: TUIStyle
);
3086 inherited cacheStyle(root
);
3088 sz
:= nmax(0, root
.get('shadow-size', 'active', mCtl4Style
).asInt(0));
3089 sz
:= nmax(sz
, root
.get('shadow-size', 'disabled', mCtl4Style
).asInt(0));
3090 sz
:= nmax(sz
, root
.get('shadow-size', 'inactive', mCtl4Style
).asInt(0));
3093 mAddMarkers
:= root
.get('add-markers', 'active', mCtl4Style
).asBool(false);
3094 mAddMarkers
:= mAddMarkers
or root
.get('add-markers', 'disabled', mCtl4Style
).asBool(false);
3095 mAddMarkers
:= mAddMarkers
or root
.get('add-markers', 'inactive', mCtl4Style
).asBool(false);
3097 mHideMarkers
:= root
.get('hide-markers', 'active', mCtl4Style
).asBool(false);
3098 mHideMarkers
:= mHideMarkers
or root
.get('hide-markers', 'disabled', mCtl4Style
).asBool(false);
3099 mHideMarkers
:= mHideMarkers
or root
.get('hide-markers', 'inactive', mCtl4Style
).asBool(false);
3103 procedure TUIButton
.setText (const s
: AnsiString);
3105 inherited setText(s
);
3106 if (mHideMarkers
) then
3108 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
)+10, uiContext
.textHeight(mText
));
3110 else if (mAddMarkers
) then
3112 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
)+uiContext
.textWidth('[<>]'), uiContext
.textHeight(mText
));
3116 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
)+uiContext
.textWidth('<>'), uiContext
.textHeight(mText
));
3121 procedure TUIButton
.layPrepare ();
3126 if (not mSkipLayPrepare
) then
3129 if (ods
.w
<> 0) or (ods
.h
<> 0) then
3131 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
), uiContext
.textHeight(mText
));
3132 if (mHideMarkers
) then
3136 else if (mAddMarkers
) then
3138 if (mDefault
) then ww
:= uiContext
.textWidth('[< >]')
3139 else if (mCancel
) then ww
:= uiContext
.textWidth('[{ }]')
3140 else ww
:= uiContext
.textWidth('[ ]');
3144 ww
:= nmax(0, uiContext
.textWidth('< >'));
3145 ww
:= nmax(ww
, uiContext
.textWidth('{ }'));
3146 ww
:= nmax(ww
, uiContext
.textWidth('[ ]'));
3148 mDefSize
.w
+= ww
+mShadowSize
;
3149 mDefSize
.h
+= mShadowSize
;
3154 ods
:= TLaySize
.Create(0, 0); // fpc is dumb!
3156 inherited layPrepare();
3157 if (not mSkipLayPrepare
) then mDefSize
:= ods
;
3161 procedure TUIButton
.blurred ();
3167 procedure TUIButton
.drawControl (gx
, gy
: Integer);
3170 xpos
, ypos
, xofsl
, xofsr
, sofs
: Integer;
3173 lstr
, rstr
: AnsiString;
3175 cidx
:= getColorIndex
;
3177 wdt
:= mWidth
-mShadowSize
;
3178 hgt
:= mHeight
-mShadowSize
;
3179 if (mPushed
) {or (cidx = ClrIdxActive)} then
3181 sofs
:= mShadowSize
;
3188 if (mShadowSize
> 0) then
3190 uiContext
.darkenRect(gx
+mShadowSize
, gy
+hgt
, wdt
, mShadowSize
, 96);
3191 uiContext
.darkenRect(gx
+wdt
, gy
+mShadowSize
, mShadowSize
, hgt
-mShadowSize
, 96);
3195 uiContext
.color
:= mBackColor
[cidx
];
3196 uiContext
.fillRect(gx
, gy
, wdt
, hgt
);
3198 if (mVAlign
< 0) then ypos
:= 0
3199 else if (mVAlign
> 0) then ypos
:= hgt
-uiContext
.textHeight(mText
)
3200 else ypos
:= (hgt
-uiContext
.textHeight(mText
)) div 2;
3203 uiContext
.color
:= mTextColor
[cidx
];
3205 if (mHideMarkers
) then
3212 if (mAddMarkers
) then
3214 if (mDefault
) then begin lstr
:= '[< '; rstr
:= ' >]'; end
3215 else if (mCancel
) then begin lstr
:= '[{ '; rstr
:= ' }]'; end
3216 else begin lstr
:= '[ '; rstr
:= ' ]'; end;
3217 xofsl
:= uiContext
.textWidth(lstr
);
3218 xofsr
:= uiContext
.textWidth(rstr
);
3219 uiContext
.drawText(gx
, ypos
, lstr
);
3220 uiContext
.drawText(gx
+wdt
-uiContext
.textWidth(rstr
), ypos
, rstr
);
3224 xofsl
:= nmax(0, uiContext
.textWidth('< '));
3225 xofsl
:= nmax(xofsl
, uiContext
.textWidth('{ '));
3226 xofsl
:= nmax(xofsl
, uiContext
.textWidth('[ '));
3227 xofsr
:= nmax(0, uiContext
.textWidth(' >'));
3228 xofsr
:= nmax(xofsr
, uiContext
.textWidth(' }'));
3229 xofsr
:= nmax(xofsr
, uiContext
.textWidth(' ]'));
3230 if (mDefault
) then begin lch
:= '<'; rch
:= '>'; end
3231 else if (mCancel
) then begin lch
:= '{'; rch
:= '}'; end
3232 else begin lch
:= '['; rch
:= ']'; end;
3233 uiContext
.drawChar(gx
, ypos
, lch
);
3234 uiContext
.drawChar(gx
+wdt
-uiContext
.charWidth(rch
), ypos
, rch
);
3238 if (Length(mText
) > 0) then
3240 if (mHAlign
< 0) then xpos
:= 0
3241 else begin xpos
:= wdt
-xofsl
-xofsr
-uiContext
.textWidth(mText
); if (mHAlign
= 0) then xpos
:= xpos
div 2; end;
3244 setScissor(sofs
+xofsl
, sofs
, wdt
-xofsl
-xofsr
, hgt
);
3245 uiContext
.drawText(gx
+xpos
, ypos
, mText
);
3247 if (mHotChar
<> #0) and (mHotChar
<> ' ') then
3249 uiContext
.color
:= mHotColor
[cidx
];
3250 uiContext
.drawChar(gx
+xpos
+mHotOfs
, ypos
, mHotChar
);
3256 procedure TUIButton
.mouseEvent (var ev
: TFUIEvent
);
3260 inherited mouseEvent(ev
);
3261 if (uiGrabCtl
= self
) then
3264 mPushed
:= toLocal(ev
.x
, ev
.y
, lx
, ly
);
3265 if (ev
= '-lmb') and (focused
) and (mPushed
) then
3272 if (not ev
.alive
) or (not enabled
) or (not focused
) then exit
;
3278 procedure TUIButton
.keyEvent (var ev
: TFUIEvent
);
3280 inherited keyEvent(ev
);
3281 if (ev
.alive
) and (enabled
) then
3283 if (ev
= '+Enter') or (ev
= '+Space') then
3290 if (focused
) and ((ev
= '-Enter') or (ev
= '-Space')) then
3308 // ////////////////////////////////////////////////////////////////////////// //
3309 procedure TUIButtonRound
.AfterConstruction ();
3315 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
)+8*2, uiContext
.textHeight(mText
)+2);
3316 mCtl4Style
:= 'button-round';
3317 mSkipLayPrepare
:= true;
3321 procedure TUIButtonRound
.setText (const s
: AnsiString);
3323 inherited setText(s
);
3324 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
)+8*2, uiContext
.textHeight(mText
)+2);
3328 procedure TUIButtonRound
.layPrepare ();
3333 if (ods
.w
<> 0) or (ods
.h
<> 0) then
3335 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
)+8*2, uiContext
.textHeight(mText
)+2);
3337 inherited layPrepare();
3342 procedure TUIButtonRound
.drawControl (gx
, gy
: Integer);
3344 xpos
, ypos
: Integer;
3347 cidx
:= getColorIndex
;
3349 uiContext
.color
:= mBackColor
[cidx
];
3350 uiContext
.fillRect(gx
+1, gy
, mWidth
-2, mHeight
);
3351 uiContext
.fillRect(gx
, gy
+1, 1, mHeight
-2);
3352 uiContext
.fillRect(gx
+mWidth
-1, gy
+1, 1, mHeight
-2);
3354 if (Length(mText
) > 0) then
3356 if (mHAlign
< 0) then xpos
:= 0
3357 else if (mHAlign
> 0) then xpos
:= mWidth
-uiContext
.textWidth(mText
)
3358 else xpos
:= (mWidth
-uiContext
.textWidth(mText
)) div 2;
3360 if (mVAlign
< 0) then ypos
:= 0
3361 else if (mVAlign
> 0) then ypos
:= mHeight
-uiContext
.textHeight(mText
)
3362 else ypos
:= (mHeight
-uiContext
.textHeight(mText
)) div 2;
3364 setScissor(8, 0, mWidth
-16, mHeight
);
3365 uiContext
.color
:= mTextColor
[cidx
];
3366 uiContext
.drawText(gx
+xpos
+8, gy
+ypos
, mText
);
3368 if (mHotChar
<> #0) and (mHotChar
<> ' ') then
3370 uiContext
.color
:= mHotColor
[cidx
];
3371 uiContext
.drawChar(gx
+xpos
+8+mHotOfs
, gy
+ypos
, mHotChar
);
3377 // ////////////////////////////////////////////////////////////////////////// //
3378 procedure TUISwitchBox
.AfterConstruction ();
3384 mIcon
:= TGxContext
.TMarkIcon
.Checkbox
;
3385 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
)+3+uiContext
.iconMarkWidth(mIcon
), nmax(uiContext
.iconMarkHeight(mIcon
), uiContext
.textHeight(mText
)));
3386 mCtl4Style
:= 'switchbox';
3388 mBoolVar
:= @mChecked
;
3392 procedure TUISwitchBox
.cacheStyle (root
: TUIStyle
);
3394 inherited cacheStyle(root
);
3396 mSwitchColor
[ClrIdxActive
] := root
.get('switch-color', 'active', mCtl4Style
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
3398 mSwitchColor
[ClrIdxDisabled
] := root
.get('switch-color', 'disabled', mCtl4Style
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
3400 mSwitchColor
[ClrIdxInactive
] := root
.get('switch-color', 'inactive', mCtl4Style
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
3404 procedure TUISwitchBox
.setText (const s
: AnsiString);
3406 inherited setText(s
);
3407 mDefSize
:= TLaySize
.Create(uiContext
.textWidth(mText
)+3+uiContext
.iconMarkWidth(mIcon
), nmax(uiContext
.iconMarkHeight(mIcon
), uiContext
.textHeight(mText
)));
3411 function TUISwitchBox
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
3413 if (strEquCI1251(prname
, 'checked')) then
3419 result
:= inherited parseProperty(prname
, par
);
3423 function TUISwitchBox
.getChecked (): Boolean;
3425 if (mBoolVar
<> nil) then result
:= mBoolVar
^ else result
:= false;
3429 procedure TUISwitchBox
.setVar (pvar
: PBoolean);
3431 if (pvar
= nil) then pvar
:= @mChecked
;
3432 if (pvar
<> mBoolVar
) then
3435 setChecked(mBoolVar
^);
3440 procedure TUISwitchBox
.drawControl (gx
, gy
: Integer);
3442 xpos
, ypos
, iwdt
, dy
: Integer;
3445 cidx
:= getColorIndex
;
3447 iwdt
:= uiContext
.iconMarkWidth(mIcon
);
3448 if (mHAlign
< 0) then xpos
:= 0
3449 else if (mHAlign
> 0) then xpos
:= mWidth
-(uiContext
.textWidth(mText
)+3+iwdt
)
3450 else xpos
:= (mWidth
-(uiContext
.textWidth(mText
)+3+iwdt
)) div 2;
3452 if (mVAlign
< 0) then ypos
:= 0
3453 else if (mVAlign
> 0) then ypos
:= mHeight
-uiContext
.textHeight(mText
)
3454 else ypos
:= (mHeight
-uiContext
.textHeight(mText
)) div 2;
3456 uiContext
.color
:= mBackColor
[cidx
];
3457 uiContext
.fillRect(gx
, gy
, mWidth
, mHeight
);
3459 uiContext
.color
:= mSwitchColor
[cidx
];
3460 if (uiContext
.iconMarkHeight(mIcon
) < uiContext
.textHeight(mText
)) then
3462 case uiContext
.textHeight(mText
) of
3467 uiContext
.drawIconMark(mIcon
, gx
, gy
+ypos
+uiContext
.textHeight(mText
)-uiContext
.iconMarkHeight(mIcon
)-dy
, checked
);
3471 uiContext
.drawIconMark(mIcon
, gx
, gy
, checked
);
3474 uiContext
.color
:= mTextColor
[cidx
];
3475 uiContext
.drawText(gx
+xpos
+3+iwdt
, gy
+ypos
, mText
);
3477 if (mHotChar
<> #0) and (mHotChar
<> ' ') then
3479 uiContext
.color
:= mHotColor
[cidx
];
3480 uiContext
.drawChar(gx
+xpos
+3+iwdt
+mHotOfs
, gy
+ypos
, mHotChar
);
3485 procedure TUISwitchBox
.mouseEvent (var ev
: TFUIEvent
);
3489 inherited mouseEvent(ev
);
3490 if (uiGrabCtl
= self
) then
3493 if (ev
= '-lmb') and focused
and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
3499 if (not ev
.alive
) or (not enabled
) or not focused
then exit
;
3504 procedure TUISwitchBox
.keyEvent (var ev
: TFUIEvent
);
3506 inherited keyEvent(ev
);
3507 if (ev
.alive
) and (enabled
) then
3509 if (ev
= 'Space') then
3519 // ////////////////////////////////////////////////////////////////////////// //
3520 procedure TUICheckBox
.AfterConstruction ();
3524 mBoolVar
:= @mChecked
;
3525 mIcon
:= TGxContext
.TMarkIcon
.Checkbox
;
3530 procedure TUICheckBox
.setChecked (v
: Boolean);
3536 procedure TUICheckBox
.doAction ();
3538 if (assigned(actionCB
)) then
3544 setChecked(not getChecked
);
3549 // ////////////////////////////////////////////////////////////////////////// //
3550 procedure TUIRadioBox
.AfterConstruction ();
3554 mBoolVar
:= @mChecked
;
3556 mIcon
:= TGxContext
.TMarkIcon
.Radiobox
;
3561 function TUIRadioBox
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
3563 if (strEquCI1251(prname
, 'group')) then
3565 mRadioGroup
:= par
.expectIdOrStr(true);
3566 if (getChecked
) then setChecked(true);
3570 if (strEquCI1251(prname
, 'checked')) then
3576 result
:= inherited parseProperty(prname
, par
);
3580 procedure TUIRadioBox
.setChecked (v
: Boolean);
3582 function resetGroup (ctl
: TUIControl
): Boolean;
3585 if (ctl
<> self
) and (ctl
is TUIRadioBox
) and (TUIRadioBox(ctl
).mRadioGroup
= mRadioGroup
) then
3587 TUIRadioBox(ctl
).mBoolVar
^ := false;
3593 if v
then topLevel
.forEachControl(resetGroup
);
3597 procedure TUIRadioBox
.doAction ();
3599 if (assigned(actionCB
)) then
3610 // ////////////////////////////////////////////////////////////////////////// //
3612 oldFocus
: procedure () = nil;
3613 oldBlur
: procedure () = nil;
3615 procedure onWinFocus (); begin uiFocus(); if (assigned(oldFocus
)) then oldFocus(); end;
3616 procedure onWinBlur (); begin fuiResetKMState(true); uiBlur(); if (assigned(oldBlur
)) then oldBlur(); end;
3619 registerCtlClass(TUIHBox
, 'hbox');
3620 registerCtlClass(TUIVBox
, 'vbox');
3621 registerCtlClass(TUISpan
, 'span');
3622 registerCtlClass(TUILine
, 'line');
3623 registerCtlClass(TUITextLabel
, 'label');
3624 registerCtlClass(TUIStaticText
, 'static');
3625 registerCtlClass(TUIButtonRound
, 'round-button');
3626 registerCtlClass(TUIButton
, 'button');
3627 registerCtlClass(TUICheckBox
, 'checkbox');
3628 registerCtlClass(TUIRadioBox
, 'radiobox');
3630 oldFocus
:= winFocusCB
;
3631 oldBlur
:= winBlurCB
;
3632 winFocusCB
:= onWinFocus
;
3633 winBlurCB
:= onWinBlur
;