1 (* coded by Ketmar // Invisible Vector <ketmar@ketmar.no-ip.org>
2 * Understanding is not required. Only obedience.
4 * This program is free software: you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation, either version 3 of the License, or
7 * (at your option) any later version.
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
14 * You should have received a copy of the GNU General Public License
15 * along with this program. If not, see <http://www.gnu.org/licenses/>.
17 {$INCLUDE ../shared/a_modes.inc}
32 // ////////////////////////////////////////////////////////////////////////// //
34 TUIControlClass
= class of TUIControl
;
38 type TActionCB
= procedure (me
: TUIControl
; uinfo
: Integer);
39 type TCloseRequestCB
= function (me
: TUIControl
): Boolean; // top-level windows will call this before closing with icon/keyboard
41 // return `true` to stop
42 type TCtlEnumCB
= function (ctl
: TUIControl
): Boolean is nested
;
45 const ClrIdxActive
= 0;
46 const ClrIdxDisabled
= 1;
47 const ClrIdxInactive
= 2;
55 mWidth
, mHeight
: Integer;
56 mFrameWidth
, mFrameHeight
: Integer;
57 mScrollX
, mScrollY
: Integer;
60 mChildren
: array of TUIControl
;
61 mFocused
: TUIControl
; // valid only for top-level controls
62 mEscClose
: Boolean; // valid only for top-level controls
67 mCtl4Style
: AnsiString;
68 mBackColor
: array[0..ClrIdxMax
] of TGxRGBA
;
69 mTextColor
: array[0..ClrIdxMax
] of TGxRGBA
;
70 mFrameColor
: array[0..ClrIdxMax
] of TGxRGBA
;
71 mFrameTextColor
: array[0..ClrIdxMax
] of TGxRGBA
;
72 mFrameIconColor
: array[0..ClrIdxMax
] of TGxRGBA
;
73 mDarken
: array[0..ClrIdxMax
] of Integer; // -1: none
80 procedure updateStyle (); virtual;
81 procedure cacheStyle (root
: TUIStyle
); virtual;
82 function getColorIndex (): Integer; inline;
85 function getEnabled (): Boolean;
86 procedure setEnabled (v
: Boolean); inline;
88 function getFocused (): Boolean; inline;
89 procedure setFocused (v
: Boolean); inline;
91 function getActive (): Boolean; inline;
93 function getCanFocus (): Boolean; inline;
95 function isMyChild (ctl
: TUIControl
): Boolean;
97 function findFirstFocus (): TUIControl
;
98 function findLastFocus (): TUIControl
;
100 function findNextFocus (cur
: TUIControl
): TUIControl
;
101 function findPrevFocus (cur
: TUIControl
): TUIControl
;
103 function findCancelControl (): TUIControl
;
104 function findDefaulControl (): TUIControl
;
106 function findControlById (const aid
: AnsiString): TUIControl
;
108 procedure activated (); virtual;
109 procedure blurred (); virtual;
111 procedure calcFullClientSize ();
113 //WARNING! do not call scissor functions outside `.draw*()` API!
114 // set scissor to this rect (in local coords)
115 procedure setScissor (lx
, ly
, lw
, lh
: Integer);
116 // reset scissor to whole control
117 procedure resetScissor (fullArea
: Boolean); inline; // "full area" means "with frame"
120 // set scissor to this rect (in global coords)
121 procedure setScissorGLInternal (x
, y
, w
, h
: Integer);
125 closeRequestCB
: TCloseRequestCB
;
128 mDefSize
: TLaySize
; // default size
129 mMaxSize
: TLaySize
; // maximum size
138 mLayDefSize
: TLaySize
;
139 mLayMaxSize
: TLaySize
;
143 // layouter interface
144 function getDefSize (): TLaySize
; inline; // default size; <0: use max size
145 //procedure setDefSize (const sz: TLaySize); inline; // default size; <0: use max size
146 function getMargins (): TLayMargins
; inline;
147 function getMaxSize (): TLaySize
; inline; // max size; <0: set to some huge value
148 //procedure setMaxSize (const sz: TLaySize); inline; // max size; <0: set to some huge value
149 function getFlex (): Integer; inline; // <=0: not flexible
150 function isHorizBox (): Boolean; inline; // horizontal layout for children?
151 procedure setHorizBox (v
: Boolean); inline; // horizontal layout for children?
152 function canWrap (): Boolean; inline; // for horizontal boxes: can wrap children? for child: `false` means 'nonbreakable at *next* ctl'
153 procedure setCanWrap (v
: Boolean); inline; // for horizontal boxes: can wrap children? for child: `false` means 'nonbreakable at *next* ctl'
154 function isLineStart (): Boolean; inline; // `true` if this ctl should start a new line; ignored for vertical boxes
155 procedure setLineStart (v
: Boolean); inline; // `true` if this ctl should start a new line; ignored for vertical boxes
156 function getAlign (): Integer; inline; // aligning in non-main direction: <0: left/up; 0: center; >0: right/down
157 procedure setAlign (v
: Integer); inline; // aligning in non-main direction: <0: left/up; 0: center; >0: right/down
158 function getExpand (): Boolean; inline; // expanding in non-main direction: `true` will ignore align and eat all available space
159 procedure setExpand (v
: Boolean); inline; // expanding in non-main direction: `true` will ignore align and eat all available space
160 function getHGroup (): AnsiString; inline; // empty: not grouped
161 procedure setHGroup (const v
: AnsiString); inline; // empty: not grouped
162 function getVGroup (): AnsiString; inline; // empty: not grouped
163 procedure setVGroup (const v
: AnsiString); inline; // empty: not grouped
165 procedure setActualSizePos (constref apos
: TLayPos
; constref asize
: TLaySize
); inline;
167 procedure layPrepare (); virtual; // called before registering control in layouter
170 property flex
: Integer read mFlex write mFlex
;
171 property flDefaultSize
: TLaySize read mDefSize write mDefSize
;
172 property flMaxSize
: TLaySize read mMaxSize write mMaxSize
;
173 property flHoriz
: Boolean read isHorizBox write setHorizBox
;
174 property flCanWrap
: Boolean read canWrap write setCanWrap
;
175 property flLineStart
: Boolean read isLineStart write setLineStart
;
176 property flAlign
: Integer read getAlign write setAlign
;
177 property flExpand
: Boolean read getExpand write setExpand
;
178 property flHGroup
: AnsiString read getHGroup write setHGroup
;
179 property flVGroup
: AnsiString read getVGroup write setVGroup
;
180 property fullSize
: TLaySize read mFullSize
;
183 function parsePos (par
: TTextParser
): TLayPos
;
184 function parseSize (par
: TTextParser
): TLaySize
;
185 function parseBool (par
: TTextParser
): Boolean;
186 function parseAnyAlign (par
: TTextParser
): Integer;
187 function parseHAlign (par
: TTextParser
): Integer;
188 function parseVAlign (par
: TTextParser
): Integer;
189 function parseOrientation (const prname
: AnsiString; par
: TTextParser
): Boolean;
190 procedure parseTextAlign (par
: TTextParser
; var h
, v
: Integer);
191 procedure parseChildren (par
: TTextParser
); // par should be on '{'; final '}' is eaten
194 // par is on property data
195 // there may be more data in text stream, don't eat it!
196 // return `true` if property name is valid and value was parsed
197 // return `false` if property name is invalid; don't advance parser in this case
198 // throw on property data errors
199 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; virtual;
201 // par should be on '{'; final '}' is eaten
202 procedure parseProperties (par
: TTextParser
);
205 constructor Create ();
206 constructor Create (ax
, ay
, aw
, ah
: Integer);
207 destructor Destroy (); override;
209 // `sx` and `sy` are screen coordinates
210 procedure drawControl (gx
, gy
: Integer); virtual;
212 // called after all children drawn
213 procedure drawControlPost (gx
, gy
: Integer); virtual;
215 procedure draw (); virtual;
217 function topLevel (): TUIControl
; inline;
219 // returns `true` if global coords are inside this control
220 function toLocal (var x
, y
: Integer): Boolean;
221 function toLocal (gx
, gy
: Integer; out x
, y
: Integer): Boolean; inline;
222 procedure toGlobal (var x
, y
: Integer);
223 procedure toGlobal (lx
, ly
: Integer; out x
, y
: Integer); inline;
225 procedure getDrawRect (out gx
, gy
, wdt
, hgt
: Integer);
227 // x and y are global coords
228 function controlAtXY (x
, y
: Integer; allowDisabled
: Boolean=false): TUIControl
;
230 function parentScrollX (): Integer; inline;
231 function parentScrollY (): Integer; inline;
233 procedure doAction (); virtual; // so user controls can override it
235 procedure mouseEvent (var ev
: THMouseEvent
); virtual; // returns `true` if event was eaten
236 procedure keyEvent (var ev
: THKeyEvent
); virtual; // returns `true` if event was eaten
237 procedure keyEventPre (var ev
: THKeyEvent
); virtual; // will be called before dispatching the event
238 procedure keyEventPost (var ev
: THKeyEvent
); virtual; // will be called after if nobody processed the event
240 function prevSibling (): TUIControl
;
241 function nextSibling (): TUIControl
;
242 function firstChild (): TUIControl
; inline;
243 function lastChild (): TUIControl
; inline;
245 procedure appendChild (ctl
: TUIControl
); virtual;
247 function setActionCBFor (const aid
: AnsiString; cb
: TActionCB
): TActionCB
; // returns previous cb
249 function forEachChildren (cb
: TCtlEnumCB
): TUIControl
; // doesn't recurse
250 function forEachControl (cb
: TCtlEnumCB
; includeSelf
: Boolean=true): TUIControl
;
252 procedure close (); // this closes *top-level* control
255 property id
: AnsiString read mId
;
256 property styleId
: AnsiString read mStyleId
;
257 property scrollX
: Integer read mScrollX write mScrollX
;
258 property scrollY
: Integer read mScrollY write mScrollY
;
259 property x0
: Integer read mX
;
260 property y0
: Integer read mY
;
261 property height
: Integer read mHeight
;
262 property width
: Integer read mWidth
;
263 property enabled
: Boolean read getEnabled write setEnabled
;
264 property parent
: TUIControl read mParent
;
265 property focused
: Boolean read getFocused write setFocused
;
266 property active
: Boolean read getActive
;
267 property escClose
: Boolean read mEscClose write mEscClose
;
268 property cancel
: Boolean read mCancel write mCancel
;
269 property defctl
: Boolean read mDefault write mDefault
;
270 property canFocus
: Boolean read getCanFocus write mCanFocus
;
271 property ctlById
[const aid
: AnsiString]: TUIControl read findControlById
; default
;
275 TUITopWindow
= class(TUIControl
)
277 type TXMode
= (None
, Drag
, Scroll
);
282 mDragStartX
, mDragStartY
: Integer;
283 mWaitingClose
: Boolean;
285 mFreeOnClose
: Boolean; // default: false
286 mDoCenter
: Boolean; // after layouting
289 procedure cacheStyle (root
: TUIStyle
); override;
292 procedure activated (); override;
293 procedure blurred (); override;
296 closeCB
: TActionCB
; // called after window was removed from ui window list
299 constructor Create (const atitle
: AnsiString; ax
, ay
: Integer; aw
: Integer=-1; ah
: Integer=-1);
301 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
303 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
305 procedure centerInScreen ();
307 // `sx` and `sy` are screen coordinates
308 procedure drawControl (gx
, gy
: Integer); override;
309 procedure drawControlPost (gx
, gy
: Integer); override;
311 procedure keyEvent (var ev
: THKeyEvent
); override; // returns `true` if event was eaten
312 procedure mouseEvent (var ev
: THMouseEvent
); override; // returns `true` if event was eaten
315 property freeOnClose
: Boolean read mFreeOnClose write mFreeOnClose
;
318 // ////////////////////////////////////////////////////////////////////// //
319 TUISimpleText
= class(TUIControl
)
330 mItems
: array of TItem
;
333 constructor Create (ax
, ay
: Integer);
334 destructor Destroy (); override;
336 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
338 procedure appendItem (const atext
: AnsiString; acentered
: Boolean=false; ahline
: Boolean=false);
340 procedure drawControl (gx
, gy
: Integer); override;
342 procedure mouseEvent (var ev
: THMouseEvent
); override;
345 TUICBListBox
= class(TUIControl
)
356 mItems
: array of TItem
;
358 mCurItemBack
: array[0..ClrIdxMax
] of TGxRGBA
;
361 procedure cacheStyle (root
: TUIStyle
); override;
364 constructor Create (ax
, ay
: Integer);
365 destructor Destroy (); override;
367 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
369 procedure appendItem (const atext
: AnsiString; bv
: PBoolean; aaction
: TActionCB
=nil);
371 procedure drawControl (gx
, gy
: Integer); override;
373 procedure mouseEvent (var ev
: THMouseEvent
); override;
374 procedure keyEvent (var ev
: THKeyEvent
); override;
377 // ////////////////////////////////////////////////////////////////////// //
378 TUIBox
= class(TUIControl
)
381 mCaption
: AnsiString;
384 constructor Create (ahoriz
: Boolean);
386 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
388 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
390 procedure drawControl (gx
, gy
: Integer); override;
392 procedure mouseEvent (var ev
: THMouseEvent
); override;
393 procedure keyEvent (var ev
: THKeyEvent
); override;
396 property caption
: AnsiString read mCaption write mCaption
;
397 property hasFrame
: Boolean read mHasFrame write mHasFrame
;
400 TUIHBox
= class(TUIBox
)
402 constructor Create ();
404 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
407 TUIVBox
= class(TUIBox
)
409 constructor Create ();
411 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
414 // ////////////////////////////////////////////////////////////////////// //
415 TUISpan
= class(TUIControl
)
417 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
419 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
421 procedure drawControl (gx
, gy
: Integer); override;
424 // ////////////////////////////////////////////////////////////////////// //
425 TUILine
= class(TUIControl
)
427 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
429 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
431 procedure drawControl (gx
, gy
: Integer); override;
434 TUIHLine
= class(TUILine
)
436 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
439 TUIVLine
= class(TUILine
)
441 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
444 // ////////////////////////////////////////////////////////////////////// //
445 TUIStaticText
= class(TUIControl
)
448 mHAlign
: Integer; // -1: left; 0: center; 1: right; default: left
449 mVAlign
: Integer; // -1: top; 0: center; 1: bottom; default: center
450 mHeader
: Boolean; // true: draw with frame text color
451 mLine
: Boolean; // true: draw horizontal line
454 procedure setText (const atext
: AnsiString);
457 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
459 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
461 procedure drawControl (gx
, gy
: Integer); override;
464 property text: AnsiString read mText write setText
;
465 property halign
: Integer read mHAlign write mHAlign
;
466 property valign
: Integer read mVAlign write mVAlign
;
467 property header
: Boolean read mHeader write mHeader
;
468 property line
: Boolean read mLine write mLine
;
471 // ////////////////////////////////////////////////////////////////////// //
472 TUITextLabel
= class(TUIControl
)
475 mHAlign
: Integer; // -1: left; 0: center; 1: right; default: left
476 mVAlign
: Integer; // -1: top; 0: center; 1: bottom; default: center
478 mHotOfs
: Integer; // from text start, in pixels
479 mHotColor
: array[0..ClrIdxMax
] of TGxRGBA
;
480 mLinkId
: AnsiString; // linked control
483 procedure cacheStyle (root
: TUIStyle
); override;
485 procedure setText (const s
: AnsiString);
488 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
490 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
492 procedure drawControl (gx
, gy
: Integer); override;
494 procedure mouseEvent (var ev
: THMouseEvent
); override;
495 procedure keyEventPost (var ev
: THKeyEvent
); override;
498 property text: AnsiString read mText write setText
;
499 property halign
: Integer read mHAlign write mHAlign
;
500 property valign
: Integer read mVAlign write mVAlign
;
503 // ////////////////////////////////////////////////////////////////////// //
504 TUIButton
= class(TUITextLabel
)
506 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
508 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
510 procedure drawControl (gx
, gy
: Integer); override;
512 procedure mouseEvent (var ev
: THMouseEvent
); override;
513 procedure keyEvent (var ev
: THKeyEvent
); override;
514 procedure keyEventPost (var ev
: THKeyEvent
); override;
518 // ////////////////////////////////////////////////////////////////////////// //
519 procedure uiMouseEvent (var evt
: THMouseEvent
);
520 procedure uiKeyEvent (var evt
: THKeyEvent
);
524 // ////////////////////////////////////////////////////////////////////////// //
525 procedure uiAddWindow (ctl
: TUIControl
);
526 procedure uiRemoveWindow (ctl
: TUIControl
); // will free window if `mFreeOnClose` is `true`
527 function uiVisibleWindow (ctl
: TUIControl
): Boolean;
529 procedure uiUpdateStyles ();
532 // ////////////////////////////////////////////////////////////////////////// //
534 procedure uiLayoutCtl (ctl
: TUIControl
);
537 // ////////////////////////////////////////////////////////////////////////// //
539 gh_ui_scale
: Single = 1.0;
549 // ////////////////////////////////////////////////////////////////////////// //
551 ctlsToKill
: array of TUIControl
= nil;
554 procedure scheduleKill (ctl
: TUIControl
);
558 if (ctl
= nil) then exit
;
560 for f
:= 0 to High(ctlsToKill
) do
562 if (ctlsToKill
[f
] = ctl
) then exit
;
563 if (ctlsToKill
[f
] = nil) then begin ctlsToKill
[f
] := ctl
; exit
; end;
565 SetLength(ctlsToKill
, Length(ctlsToKill
)+1);
566 ctlsToKill
[High(ctlsToKill
)] := ctl
;
570 procedure processKills ();
575 for f
:= 0 to High(ctlsToKill
) do
577 ctl
:= ctlsToKill
[f
];
578 if (ctl
= nil) then break
;
579 ctlsToKill
[f
] := nil;
582 if (Length(ctlsToKill
) > 0) then ctlsToKill
[0] := nil; // just in case
586 // ////////////////////////////////////////////////////////////////////////// //
588 knownCtlClasses
: array of record
589 klass
: TUIControlClass
;
594 procedure registerCtlClass (aklass
: TUIControlClass
; const aname
: AnsiString);
596 assert(aklass
<> nil);
597 assert(Length(aname
) > 0);
598 SetLength(knownCtlClasses
, Length(knownCtlClasses
)+1);
599 knownCtlClasses
[High(knownCtlClasses
)].klass
:= aklass
;
600 knownCtlClasses
[High(knownCtlClasses
)].name
:= aname
;
604 function findCtlClass (const aname
: AnsiString): TUIControlClass
;
608 for f
:= 0 to High(knownCtlClasses
) do
610 if (strEquCI1251(aname
, knownCtlClasses
[f
].name
)) then
612 result
:= knownCtlClasses
[f
].klass
;
620 // ////////////////////////////////////////////////////////////////////////// //
622 TFlexLayouter
= specialize TFlexLayouterBase
<TUIControl
>;
624 procedure uiLayoutCtl (ctl
: TUIControl
);
628 if (ctl
= nil) then exit
;
629 lay
:= TFlexLayouter
.Create();
634 //writeln('============================'); lay.dumpFlat();
636 //writeln('=== initial ==='); lay.dump();
638 //lay.calcMaxSizeInternal(0);
641 writeln('=== after first pass ===');
645 writeln('=== after second pass ===');
650 //writeln('=== final ==='); lay.dump();
652 if (ctl
.mParent
= nil) and (ctl
is TUITopWindow
) and (TUITopWindow(ctl
).mDoCenter
) then
654 TUITopWindow(ctl
).centerInScreen();
657 // calculate full size
658 ctl
.calcFullClientSize();
666 // ////////////////////////////////////////////////////////////////////////// //
668 uiTopList
: array of TUIControl
= nil;
669 uiGrabCtl
: TUIControl
= nil;
672 procedure uiUpdateStyles ();
676 for ctl
in uiTopList
do ctl
.updateStyle();
680 procedure uiMouseEvent (var evt
: THMouseEvent
);
688 if (evt
.eaten
) or (evt
.cancelled
) then exit
;
690 ev
.x
:= trunc(ev
.x
/gh_ui_scale
);
691 ev
.y
:= trunc(ev
.y
/gh_ui_scale
);
692 ev
.dx
:= trunc(ev
.dx
/gh_ui_scale
); //FIXME
693 ev
.dy
:= trunc(ev
.dy
/gh_ui_scale
); //FIXME
695 if (uiGrabCtl
<> nil) then
697 uiGrabCtl
.mouseEvent(ev
);
698 if (ev
.release
) and ((ev
.bstate
and (not ev
.but
)) = 0) then uiGrabCtl
:= nil;
702 if (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)].mEnabled
) then uiTopList
[High(uiTopList
)].mouseEvent(ev
);
703 if (not ev
.eaten
) and (not ev
.cancelled
) and (ev
.press
) then
705 for f
:= High(uiTopList
) downto 0 do
707 if uiTopList
[f
].toLocal(ev
.x
, ev
.y
, lx
, ly
) then
709 if (uiTopList
[f
].mEnabled
) and (f
<> High(uiTopList
)) then
711 uiTopList
[High(uiTopList
)].blurred();
712 ctmp
:= uiTopList
[f
];
714 for c
:= f
+1 to High(uiTopList
) do uiTopList
[c
-1] := uiTopList
[c
];
715 uiTopList
[High(uiTopList
)] := ctmp
;
725 if (ev
.eaten
) then evt
.eat();
726 if (ev
.cancelled
) then evt
.cancel();
731 procedure uiKeyEvent (var evt
: THKeyEvent
);
736 if (evt
.eaten
) or (evt
.cancelled
) then exit
;
738 ev
.x
:= trunc(ev
.x
/gh_ui_scale
);
739 ev
.y
:= trunc(ev
.y
/gh_ui_scale
);
741 if (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)].mEnabled
) then uiTopList
[High(uiTopList
)].keyEvent(ev
);
742 //if (ev.release) then begin ev.eat(); exit; end;
744 if (ev
.eaten
) then evt
.eat();
745 if (ev
.cancelled
) then evt
.cancel();
756 gxBeginUIDraw(gh_ui_scale
);
758 for f
:= 0 to High(uiTopList
) do
762 cidx
:= ctl
.getColorIndex
;
763 //if (f <> High(uiTopList)) then darkenRect(ctl.x0, ctl.y0, ctl.width, ctl.height, 128);
764 if (ctl
.mDarken
[cidx
] > 0) then darkenRect(ctl
.x0
, ctl
.y0
, ctl
.width
, ctl
.height
, ctl
.mDarken
[cidx
]);
772 procedure uiAddWindow (ctl
: TUIControl
);
776 if (ctl
= nil) then exit
;
778 if not (ctl
is TUITopWindow
) then exit
; // alas
779 for f
:= 0 to High(uiTopList
) do
781 if (uiTopList
[f
] = ctl
) then
783 if (f
<> High(uiTopList
)) then
785 uiTopList
[High(uiTopList
)].blurred();
786 for c
:= f
+1 to High(uiTopList
) do uiTopList
[c
-1] := uiTopList
[c
];
787 uiTopList
[High(uiTopList
)] := ctl
;
793 if (Length(uiTopList
) > 0) then uiTopList
[High(uiTopList
)].blurred();
794 SetLength(uiTopList
, Length(uiTopList
)+1);
795 uiTopList
[High(uiTopList
)] := ctl
;
801 procedure uiRemoveWindow (ctl
: TUIControl
);
805 if (ctl
= nil) then exit
;
807 if not (ctl
is TUITopWindow
) then exit
; // alas
808 for f
:= 0 to High(uiTopList
) do
810 if (uiTopList
[f
] = ctl
) then
813 for c
:= f
+1 to High(uiTopList
) do uiTopList
[c
-1] := uiTopList
[c
];
814 SetLength(uiTopList
, Length(uiTopList
)-1);
815 if (ctl
is TUITopWindow
) then
818 if assigned(TUITopWindow(ctl
).closeCB
) then TUITopWindow(ctl
).closeCB(ctl
, 0);
820 if (TUITopWindow(ctl
).mFreeOnClose
) then scheduleKill(ctl
);
829 function uiVisibleWindow (ctl
: TUIControl
): Boolean;
834 if (ctl
= nil) then exit
;
836 if not (ctl
is TUITopWindow
) then exit
; // alas
837 for f
:= 0 to High(uiTopList
) do
839 if (uiTopList
[f
] = ctl
) then begin result
:= true; exit
; end;
844 // ////////////////////////////////////////////////////////////////////////// //
845 constructor TUIControl
.Create ();
861 mDrawShadow
:= false;
863 // layouter interface
864 //mDefSize := TLaySize.Create(64, 8); // default size
865 mDefSize
:= TLaySize
.Create(0, 0); // default size
866 mMaxSize
:= TLaySize
.Create(-1, -1); // maximum size
875 mAlign
:= -1; // left/top
880 constructor TUIControl
.Create (ax
, ay
, aw
, ah
: Integer);
890 destructor TUIControl
.Destroy ();
894 if (mParent
<> nil) then
897 for f
:= 0 to High(mParent
.mChildren
) do
899 if (mParent
.mChildren
[f
] = self
) then
901 for c
:= f
+1 to High(mParent
.mChildren
) do mParent
.mChildren
[c
-1] := mParent
.mChildren
[c
];
902 SetLength(mParent
.mChildren
, Length(mParent
.mChildren
)-1);
906 for f
:= 0 to High(mChildren
) do
908 mChildren
[f
].mParent
:= nil;
915 function TUIControl
.getColorIndex (): Integer; inline;
917 if (not mEnabled
) then begin result
:= ClrIdxDisabled
; exit
; end;
918 // if control cannot be focused, take "active" color scheme for it (it is easier this way)
919 if (not canFocus
) or (getActive
) then begin result
:= ClrIdxActive
; exit
; end;
920 result
:= ClrIdxInactive
;
923 procedure TUIControl
.updateStyle ();
929 while (ctl
<> nil) do
931 if (Length(ctl
.mStyleId
) <> 0) then begin stl
:= uiFindStyle(ctl
.mStyleId
); break
; end;
934 if (stl
= nil) then stl
:= uiFindStyle(''); // default
936 for ctl
in mChildren
do ctl
.updateStyle();
939 procedure TUIControl
.cacheStyle (root
: TUIStyle
);
943 //writeln('caching style for <', className, '> (', mCtl4Style, ')...');
946 mBackColor
[ClrIdxActive
] := root
.get('back-color', 'active', cst
).asRGBADef(TGxRGBA
.Create(0, 0, 128));
947 mTextColor
[ClrIdxActive
] := root
.get('text-color', 'active', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
948 mFrameColor
[ClrIdxActive
] := root
.get('frame-color', 'active', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
949 mFrameTextColor
[ClrIdxActive
] := root
.get('frame-text-color', 'active', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
950 mFrameIconColor
[ClrIdxActive
] := root
.get('frame-icon-color', 'active', cst
).asRGBADef(TGxRGBA
.Create(0, 255, 0));
951 mDarken
[ClrIdxActive
] := root
.get('darken', 'active', cst
).asInt(-1);
953 mBackColor
[ClrIdxDisabled
] := root
.get('back-color', 'disabled', cst
).asRGBADef(TGxRGBA
.Create(0, 0, 128));
954 mTextColor
[ClrIdxDisabled
] := root
.get('text-color', 'disabled', cst
).asRGBADef(TGxRGBA
.Create(127, 127, 127));
955 mFrameColor
[ClrIdxDisabled
] := root
.get('frame-color', 'disabled', cst
).asRGBADef(TGxRGBA
.Create(127, 127, 127));
956 mFrameTextColor
[ClrIdxDisabled
] := root
.get('frame-text-color', 'disabled', cst
).asRGBADef(TGxRGBA
.Create(127, 127, 127));
957 mFrameIconColor
[ClrIdxDisabled
] := root
.get('frame-icon-color', 'disabled', cst
).asRGBADef(TGxRGBA
.Create(0, 127, 0));
958 mDarken
[ClrIdxDisabled
] := root
.get('darken', 'disabled', cst
).asInt(-1);
960 mBackColor
[ClrIdxInactive
] := root
.get('back-color', 'inactive', cst
).asRGBADef(TGxRGBA
.Create(0, 0, 128));
961 mTextColor
[ClrIdxInactive
] := root
.get('text-color', 'inactive', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
962 mFrameColor
[ClrIdxInactive
] := root
.get('frame-color', 'inactive', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
963 mFrameTextColor
[ClrIdxInactive
] := root
.get('frame-text-color', 'inactive', cst
).asRGBADef(TGxRGBA
.Create(255, 255, 255));
964 mFrameIconColor
[ClrIdxInactive
] := root
.get('frame-icon-color', 'inactive', cst
).asRGBADef(TGxRGBA
.Create(0, 255, 0));
965 mDarken
[ClrIdxInactive
] := root
.get('darken', 'inactive', cst
).asInt(-1);
969 // ////////////////////////////////////////////////////////////////////////// //
970 function TUIControl
.getDefSize (): TLaySize
; inline; begin result
:= mLayDefSize
; end;
971 function TUIControl
.getMaxSize (): TLaySize
; inline; begin result
:= mLayMaxSize
; end;
972 function TUIControl
.getFlex (): Integer; inline; begin result
:= mFlex
; end;
973 function TUIControl
.isHorizBox (): Boolean; inline; begin result
:= mHoriz
; end;
974 procedure TUIControl
.setHorizBox (v
: Boolean); inline; begin mHoriz
:= v
; end;
975 function TUIControl
.canWrap (): Boolean; inline; begin result
:= mCanWrap
; end;
976 procedure TUIControl
.setCanWrap (v
: Boolean); inline; begin mCanWrap
:= v
; end;
977 function TUIControl
.isLineStart (): Boolean; inline; begin result
:= mLineStart
; end;
978 procedure TUIControl
.setLineStart (v
: Boolean); inline; begin mLineStart
:= v
; end;
979 function TUIControl
.getAlign (): Integer; inline; begin result
:= mAlign
; end;
980 procedure TUIControl
.setAlign (v
: Integer); inline; begin mAlign
:= v
; end;
981 function TUIControl
.getExpand (): Boolean; inline; begin result
:= mExpand
; end;
982 procedure TUIControl
.setExpand (v
: Boolean); inline; begin mExpand
:= v
; end;
983 function TUIControl
.getHGroup (): AnsiString; inline; begin result
:= mHGroup
; end;
984 procedure TUIControl
.setHGroup (const v
: AnsiString); inline; begin mHGroup
:= v
; end;
985 function TUIControl
.getVGroup (): AnsiString; inline; begin result
:= mVGroup
; end;
986 procedure TUIControl
.setVGroup (const v
: AnsiString); inline; begin mVGroup
:= v
; end;
988 function TUIControl
.getMargins (): TLayMargins
; inline;
990 result
:= TLayMargins
.Create(mFrameHeight
, mFrameWidth
, mFrameHeight
, mFrameWidth
);
993 procedure TUIControl
.setActualSizePos (constref apos
: TLayPos
; constref asize
: TLaySize
); inline;
995 //writeln(self.className, '; pos=', apos.toString, '; size=', asize.toString);
996 if (mParent
<> nil) then
1005 procedure TUIControl
.layPrepare ();
1007 mLayDefSize
:= mDefSize
;
1008 mLayMaxSize
:= mMaxSize
;
1009 if (mLayMaxSize
.w
>= 0) then mLayMaxSize
.w
+= mFrameWidth
*2;
1010 if (mLayMaxSize
.h
>= 0) then mLayMaxSize
.h
+= mFrameHeight
*2;
1014 // ////////////////////////////////////////////////////////////////////////// //
1015 function TUIControl
.parsePos (par
: TTextParser
): TLayPos
;
1017 ech
: AnsiChar = ')';
1019 if (par
.eatDelim('[')) then ech
:= ']' else par
.expectDelim('(');
1020 result
.x
:= par
.expectInt();
1021 par
.eatDelim(','); // optional comma
1022 result
.y
:= par
.expectInt();
1023 par
.eatDelim(','); // optional comma
1024 par
.expectDelim(ech
);
1027 function TUIControl
.parseSize (par
: TTextParser
): TLaySize
;
1029 ech
: AnsiChar = ')';
1031 if (par
.eatDelim('[')) then ech
:= ']' else par
.expectDelim('(');
1032 result
.w
:= par
.expectInt();
1033 par
.eatDelim(','); // optional comma
1034 result
.h
:= par
.expectInt();
1035 par
.eatDelim(','); // optional comma
1036 par
.expectDelim(ech
);
1039 function TUIControl
.parseBool (par
: TTextParser
): Boolean;
1042 par
.eatIdOrStrCI('true') or
1043 par
.eatIdOrStrCI('yes') or
1044 par
.eatIdOrStrCI('tan');
1047 if (not par
.eatIdOrStrCI('false')) and (not par
.eatIdOrStrCI('no')) and (not par
.eatIdOrStrCI('ona')) then
1049 par
.error('boolean value expected');
1054 function TUIControl
.parseAnyAlign (par
: TTextParser
): Integer;
1056 if (par
.eatIdOrStrCI('left')) or (par
.eatIdOrStrCI('top')) then result
:= -1
1057 else if (par
.eatIdOrStrCI('right')) or (par
.eatIdOrStrCI('bottom')) then result
:= 1
1058 else if (par
.eatIdOrStrCI('center')) then result
:= 0
1059 else par
.error('invalid align value');
1062 function TUIControl
.parseHAlign (par
: TTextParser
): Integer;
1064 if (par
.eatIdOrStrCI('left')) then result
:= -1
1065 else if (par
.eatIdOrStrCI('right')) then result
:= 1
1066 else if (par
.eatIdOrStrCI('center')) then result
:= 0
1067 else par
.error('invalid horizontal align value');
1070 function TUIControl
.parseVAlign (par
: TTextParser
): Integer;
1072 if (par
.eatIdOrStrCI('top')) then result
:= -1
1073 else if (par
.eatIdOrStrCI('bottom')) then result
:= 1
1074 else if (par
.eatIdOrStrCI('center')) then result
:= 0
1075 else par
.error('invalid vertical align value');
1078 procedure TUIControl
.parseTextAlign (par
: TTextParser
; var h
, v
: Integer);
1080 wasH
: Boolean = false;
1081 wasV
: Boolean = false;
1085 if (par
.eatIdOrStrCI('left')) then
1087 if wasH
then par
.error('too many align directives');
1092 if (par
.eatIdOrStrCI('right')) then
1094 if wasH
then par
.error('too many align directives');
1099 if (par
.eatIdOrStrCI('hcenter')) then
1101 if wasH
then par
.error('too many align directives');
1106 if (par
.eatIdOrStrCI('top')) then
1108 if wasV
then par
.error('too many align directives');
1113 if (par
.eatIdOrStrCI('bottom')) then
1115 if wasV
then par
.error('too many align directives');
1120 if (par
.eatIdOrStrCI('vcenter')) then
1122 if wasV
then par
.error('too many align directives');
1127 if (par
.eatIdOrStrCI('center')) then
1129 if wasV
or wasH
then par
.error('too many align directives');
1138 if not wasV
and not wasH
then par
.error('invalid align value');
1141 function TUIControl
.parseOrientation (const prname
: AnsiString; par
: TTextParser
): Boolean;
1143 if (strEquCI1251(prname
, 'orientation')) or (strEquCI1251(prname
, 'orient')) then
1145 if (par
.eatIdOrStrCI('horizontal')) or (par
.eatIdOrStrCI('horiz')) then mHoriz
:= true
1146 else if (par
.eatIdOrStrCI('vertical')) or (par
.eatIdOrStrCI('vert')) then mHoriz
:= false
1147 else par
.error('`horizontal` or `vertical` expected');
1156 // par should be on '{'; final '}' is eaten
1157 procedure TUIControl
.parseProperties (par
: TTextParser
);
1161 if (not par
.eatDelim('{')) then exit
;
1162 while (not par
.eatDelim('}')) do
1164 if (not par
.isIdOrStr
) then par
.error('property name expected');
1167 par
.eatDelim(':'); // optional
1168 if not parseProperty(pn
, par
) then par
.errorfmt('invalid property name ''%s''', [pn
]);
1169 par
.eatDelim(','); // optional
1173 // par should be on '{'
1174 procedure TUIControl
.parseChildren (par
: TTextParser
);
1176 cc
: TUIControlClass
;
1179 par
.expectDelim('{');
1180 while (not par
.eatDelim('}')) do
1182 if (not par
.isIdOrStr
) then par
.error('control name expected');
1183 cc
:= findCtlClass(par
.tokStr
);
1184 if (cc
= nil) then par
.errorfmt('unknown control name: ''%s''', [par
.tokStr
]);
1185 //writeln('children for <', par.tokStr, '>: <', cc.className, '>');
1187 par
.eatDelim(':'); // optional
1189 //writeln(' mHoriz=', ctl.mHoriz);
1191 ctl
.parseProperties(par
);
1196 //writeln(': ', ctl.mDefSize.toString);
1198 par
.eatDelim(','); // optional
1203 function TUIControl
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
1206 if (strEquCI1251(prname
, 'id')) then begin mId
:= par
.expectIdOrStr(true); exit
; end; // allow empty strings
1207 if (strEquCI1251(prname
, 'style')) then begin mStyleId
:= par
.expectIdOrStr(); exit
; end; // no empty strings
1208 if (strEquCI1251(prname
, 'flex')) then begin flex
:= par
.expectInt(); exit
; end;
1210 if (strEquCI1251(prname
, 'defsize')) or (strEquCI1251(prname
, 'size')) then begin mDefSize
:= parseSize(par
); exit
; end;
1211 if (strEquCI1251(prname
, 'maxsize')) then begin mMaxSize
:= parseSize(par
); exit
; end;
1212 if (strEquCI1251(prname
, 'defwidth')) or (strEquCI1251(prname
, 'width')) then begin mDefSize
.w
:= par
.expectInt(); exit
; end;
1213 if (strEquCI1251(prname
, 'defheight')) or (strEquCI1251(prname
, 'height')) then begin mDefSize
.h
:= par
.expectInt(); exit
; end;
1214 if (strEquCI1251(prname
, 'maxwidth')) then begin mMaxSize
.w
:= par
.expectInt(); exit
; end;
1215 if (strEquCI1251(prname
, 'maxheight')) then begin mMaxSize
.h
:= par
.expectInt(); exit
; end;
1217 if (strEquCI1251(prname
, 'wrap')) then begin mCanWrap
:= parseBool(par
); exit
; end;
1218 if (strEquCI1251(prname
, 'linestart')) then begin mLineStart
:= parseBool(par
); exit
; end;
1219 if (strEquCI1251(prname
, 'expand')) then begin mExpand
:= parseBool(par
); exit
; end;
1221 if (strEquCI1251(prname
, 'align')) then begin mAlign
:= parseAnyAlign(par
); exit
; end;
1222 if (strEquCI1251(prname
, 'hgroup')) then begin mHGroup
:= par
.expectIdOrStr(true); exit
; end; // allow empty strings
1223 if (strEquCI1251(prname
, 'vgroup')) then begin mVGroup
:= par
.expectIdOrStr(true); exit
; end; // allow empty strings
1225 if (strEquCI1251(prname
, 'canfocus')) then begin mCanFocus
:= true; exit
; end;
1226 if (strEquCI1251(prname
, 'nofocus')) then begin mCanFocus
:= false; exit
; end;
1227 if (strEquCI1251(prname
, 'disabled')) then begin mEnabled
:= false; exit
; end;
1228 if (strEquCI1251(prname
, 'enabled')) then begin mEnabled
:= true; exit
; end;
1229 if (strEquCI1251(prname
, 'escclose')) then begin mEscClose
:= not parseBool(par
); exit
; end;
1230 if (strEquCI1251(prname
, 'default')) then begin mDefault
:= true; exit
; end;
1231 if (strEquCI1251(prname
, 'cancel')) then begin mCancel
:= true; exit
; end;
1236 // ////////////////////////////////////////////////////////////////////////// //
1237 procedure TUIControl
.activated ();
1242 procedure TUIControl
.blurred ();
1244 if (uiGrabCtl
= self
) then uiGrabCtl
:= nil;
1248 procedure TUIControl
.calcFullClientSize ();
1252 mFullSize
:= TLaySize
.Create(0, 0);
1253 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1254 for ctl
in mChildren
do
1256 ctl
.calcFullClientSize();
1257 mFullSize
.w
:= nmax(mFullSize
.w
, ctl
.mX
-mFrameWidth
+ctl
.mFullSize
.w
);
1258 mFullSize
.h
:= nmax(mFullSize
.h
, ctl
.mY
-mFrameHeight
+ctl
.mFullSize
.h
);
1260 mFullSize
.w
:= nmax(mFullSize
.w
, mWidth
-mFrameWidth
*2);
1261 mFullSize
.h
:= nmax(mFullSize
.h
, mHeight
-mFrameHeight
*2);
1265 function TUIControl
.topLevel (): TUIControl
; inline;
1268 while (result
.mParent
<> nil) do result
:= result
.mParent
;
1272 function TUIControl
.getEnabled (): Boolean;
1277 if (not mEnabled
) then exit
;
1279 while (ctl
<> nil) do
1281 if (not ctl
.mEnabled
) then exit
;
1288 procedure TUIControl
.setEnabled (v
: Boolean); inline;
1290 if (mEnabled
= v
) then exit
;
1292 if (not v
) and focused
then setFocused(false);
1296 function TUIControl
.getFocused (): Boolean; inline;
1298 if (mParent
= nil) then
1300 result
:= (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)] = self
);
1304 result
:= (topLevel
.mFocused
= self
);
1305 if (result
) then result
:= (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)] = topLevel
);
1310 function TUIControl
.getActive (): Boolean; inline;
1314 if (mParent
= nil) then
1316 result
:= (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)] = self
);
1320 ctl
:= topLevel
.mFocused
;
1321 while (ctl
<> nil) and (ctl
<> self
) do ctl
:= ctl
.mParent
;
1322 result
:= (ctl
= self
);
1323 if (result
) then result
:= (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)] = topLevel
);
1328 procedure TUIControl
.setFocused (v
: Boolean); inline;
1335 if (tl
.mFocused
= self
) then
1338 tl
.mFocused
:= tl
.findNextFocus(self
);
1339 if (tl
.mFocused
= self
) then tl
.mFocused
:= nil;
1343 if (not mEnabled
) or (not canFocus
) then exit
;
1344 if (tl
.mFocused
<> self
) then
1346 if (tl
.mFocused
<> nil) and (tl
.mFocused
<> nil) then tl
.mFocused
.blurred();
1347 tl
.mFocused
:= self
;
1348 if (uiGrabCtl
<> self
) then uiGrabCtl
:= nil;
1354 function TUIControl
.getCanFocus (): Boolean; inline;
1356 result
:= (mCanFocus
) and (mWidth
> 0) and (mHeight
> 0);
1360 function TUIControl
.isMyChild (ctl
: TUIControl
): Boolean;
1363 while (ctl
<> nil) do
1365 if (ctl
.mParent
= self
) then exit
;
1372 // returns `true` if global coords are inside this control
1373 function TUIControl
.toLocal (var x
, y
: Integer): Boolean;
1375 if (mParent
= nil) then
1379 result
:= (x
>= 0) and (y
>= 0) and (x
< mWidth
) and (y
< mHeight
);
1383 result
:= mParent
.toLocal(x
, y
);
1386 Inc(x
, mParent
.mScrollX
);
1387 Inc(y
, mParent
.mScrollY
);
1388 result
:= (x
>= 0) and (y
>= 0) and (x
< mParent
.mWidth
) and (y
< mParent
.mHeight
);
1394 Inc(x
, mParent
.mScrollX
);
1395 Inc(y
, mParent
.mScrollY
);
1402 function TUIControl
.toLocal (gx
, gy
: Integer; out x
, y
: Integer): Boolean; inline;
1406 result
:= toLocal(x
, y
);
1410 procedure TUIControl
.toGlobal (var x
, y
: Integer);
1414 if (mParent
<> nil) then
1416 Dec(x
, mParent
.mScrollX
);
1417 Dec(y
, mParent
.mScrollY
);
1418 mParent
.toGlobal(x
, y
);
1422 procedure TUIControl
.toGlobal (lx
, ly
: Integer; out x
, y
: Integer); inline;
1429 procedure TUIControl
.getDrawRect (out gx
, gy
, wdt
, hgt
: Integer);
1433 if (mParent
= nil) then
1442 toGlobal(0, 0, cgx
, cgy
);
1443 mParent
.getDrawRect(gx
, gy
, wdt
, hgt
);
1444 if (wdt
> 0) and (hgt
> 0) then
1446 if not intersectRect(gx
, gy
, wdt
, hgt
, cgx
, cgy
, mWidth
, mHeight
) then
1456 // x and y are global coords
1457 function TUIControl
.controlAtXY (x
, y
: Integer; allowDisabled
: Boolean=false): TUIControl
;
1463 if (not allowDisabled
) and (not mEnabled
) then exit
;
1464 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1465 if not toLocal(x
, y
, lx
, ly
) then exit
;
1466 for f
:= High(mChildren
) downto 0 do
1468 result
:= mChildren
[f
].controlAtXY(x
, y
, allowDisabled
);
1469 if (result
<> nil) then exit
;
1475 function TUIControl
.parentScrollX (): Integer; inline; begin if (mParent
<> nil) then result
:= mParent
.mScrollX
else result
:= 0; end;
1476 function TUIControl
.parentScrollY (): Integer; inline; begin if (mParent
<> nil) then result
:= mParent
.mScrollY
else result
:= 0; end;
1479 // ////////////////////////////////////////////////////////////////////////// //
1480 function TUIControl
.prevSibling (): TUIControl
;
1484 if (mParent
<> nil) then
1486 for f
:= 1 to High(mParent
.mChildren
) do
1488 if (mParent
.mChildren
[f
] = self
) then begin result
:= mParent
.mChildren
[f
-1]; exit
; end;
1494 function TUIControl
.nextSibling (): TUIControl
;
1498 if (mParent
<> nil) then
1500 for f
:= 0 to High(mParent
.mChildren
)-1 do
1502 if (mParent
.mChildren
[f
] = self
) then begin result
:= mParent
.mChildren
[f
+1]; exit
; end;
1508 function TUIControl
.firstChild (): TUIControl
; inline;
1510 if (Length(mChildren
) <> 0) then result
:= mChildren
[0] else result
:= nil;
1513 function TUIControl
.lastChild (): TUIControl
; inline;
1515 if (Length(mChildren
) <> 0) then result
:= mChildren
[High(mChildren
)] else result
:= nil;
1519 function TUIControl
.findFirstFocus (): TUIControl
;
1526 for f
:= 0 to High(mChildren
) do
1528 result
:= mChildren
[f
].findFirstFocus();
1529 if (result
<> nil) then exit
;
1531 if canFocus
then result
:= self
;
1536 function TUIControl
.findLastFocus (): TUIControl
;
1543 for f
:= High(mChildren
) downto 0 do
1545 result
:= mChildren
[f
].findLastFocus();
1546 if (result
<> nil) then exit
;
1548 if canFocus
then result
:= self
;
1553 function TUIControl
.findNextFocus (cur
: TUIControl
): TUIControl
;
1558 if not isMyChild(cur
) then cur
:= nil;
1559 if (cur
= nil) then begin result
:= findFirstFocus(); exit
; end;
1560 result
:= cur
.findFirstFocus();
1561 if (result
<> nil) and (result
<> cur
) then exit
;
1564 cur
:= cur
.nextSibling
;
1565 if (cur
= nil) then break
;
1566 result
:= cur
.findFirstFocus();
1567 if (result
<> nil) then exit
;
1569 result
:= findFirstFocus();
1574 function TUIControl
.findPrevFocus (cur
: TUIControl
): TUIControl
;
1579 if not isMyChild(cur
) then cur
:= nil;
1580 if (cur
= nil) then begin result
:= findLastFocus(); exit
; end;
1582 result
:= cur
.findLastFocus();
1583 if (result
<> nil) and (result
<> cur
) then exit
;
1586 cur
:= cur
.prevSibling
;
1587 if (cur
= nil) then break
;
1588 result
:= cur
.findLastFocus();
1589 if (result
<> nil) then exit
;
1591 result
:= findLastFocus();
1596 function TUIControl
.findDefaulControl (): TUIControl
;
1602 if (mDefault
) then begin result
:= self
; exit
; end;
1603 for ctl
in mChildren
do
1605 result
:= ctl
.findDefaulControl();
1606 if (result
<> nil) then exit
;
1612 function TUIControl
.findCancelControl (): TUIControl
;
1618 if (mCancel
) then begin result
:= self
; exit
; end;
1619 for ctl
in mChildren
do
1621 result
:= ctl
.findCancelControl();
1622 if (result
<> nil) then exit
;
1629 function TUIControl
.findControlById (const aid
: AnsiString): TUIControl
;
1633 if (strEquCI1251(aid
, mId
)) then begin result
:= self
; exit
; end;
1634 for ctl
in mChildren
do
1636 result
:= ctl
.findControlById(aid
);
1637 if (result
<> nil) then exit
;
1643 procedure TUIControl
.appendChild (ctl
: TUIControl
);
1645 if (ctl
= nil) then exit
;
1646 if (ctl
.mParent
<> nil) then exit
;
1647 SetLength(mChildren
, Length(mChildren
)+1);
1648 mChildren
[High(mChildren
)] := ctl
;
1649 ctl
.mParent
:= self
;
1650 Inc(ctl
.mX
, mFrameWidth
);
1651 Inc(ctl
.mY
, mFrameHeight
);
1652 if (ctl
.mWidth
> 0) and (ctl
.mHeight
> 0) and
1653 (ctl
.mX
+ctl
.mWidth
> mFrameWidth
) and (ctl
.mY
+ctl
.mHeight
> mFrameHeight
) then
1655 if (mWidth
+mFrameWidth
< ctl
.mX
+ctl
.mWidth
) then mWidth
:= ctl
.mX
+ctl
.mWidth
+mFrameWidth
;
1656 if (mHeight
+mFrameHeight
< ctl
.mY
+ctl
.mHeight
) then mHeight
:= ctl
.mY
+ctl
.mHeight
+mFrameHeight
;
1661 function TUIControl
.setActionCBFor (const aid
: AnsiString; cb
: TActionCB
): TActionCB
;
1666 if (ctl
<> nil) then
1668 result
:= ctl
.actionCB
;
1678 function TUIControl
.forEachChildren (cb
: TCtlEnumCB
): TUIControl
;
1683 if (not assigned(cb
)) then exit
;
1684 for ctl
in mChildren
do
1686 if cb(ctl
) then begin result
:= ctl
; exit
; end;
1691 function TUIControl
.forEachControl (cb
: TCtlEnumCB
; includeSelf
: Boolean=true): TUIControl
;
1693 function forChildren (p
: TUIControl
; incSelf
: Boolean): TUIControl
;
1698 if (p
= nil) then exit
;
1699 if (incSelf
) and (cb(p
)) then begin result
:= p
; exit
; end;
1700 for ctl
in p
.mChildren
do
1702 result
:= forChildren(ctl
, true);
1703 if (result
<> nil) then break
;
1709 if (not assigned(cb
)) then exit
;
1710 result
:= forChildren(self
, includeSelf
);
1714 procedure TUIControl
.close (); // this closes *top-level* control
1719 uiRemoveWindow(ctl
);
1720 if (ctl
is TUITopWindow
) and (TUITopWindow(ctl
).mFreeOnClose
) then scheduleKill(ctl
); // just in case
1724 procedure TUIControl
.doAction ();
1726 if assigned(actionCB
) then actionCB(self
, 0);
1730 // ////////////////////////////////////////////////////////////////////////// //
1731 procedure TUIControl
.setScissorGLInternal (x
, y
, w
, h
: Integer);
1733 if not scallowed
then exit
;
1734 x
:= trunc(x
*gh_ui_scale
);
1735 y
:= trunc(y
*gh_ui_scale
);
1736 w
:= trunc(w
*gh_ui_scale
);
1737 h
:= trunc(h
*gh_ui_scale
);
1738 scis
.combineRect(x
, y
, w
, h
);
1741 procedure TUIControl
.setScissor (lx
, ly
, lw
, lh
: Integer);
1743 gx
, gy
, wdt
, hgt
, cgx
, cgy
: Integer;
1745 if not scallowed
then exit
;
1747 if not intersectRect(lx
, ly
, lw
, lh
, 0, 0, mWidth
, mHeight
) then
1749 scis
.combineRect(0, 0, 0, 0);
1753 getDrawRect(gx
, gy
, wdt
, hgt
);
1754 toGlobal(lx
, ly
, cgx
, cgy
);
1755 if not intersectRect(gx
, gy
, wdt
, hgt
, cgx
, cgy
, lw
, lh
) then
1757 scis
.combineRect(0, 0, 0, 0);
1761 setScissorGLInternal(gx
, gy
, wdt
, hgt
);
1764 procedure TUIControl
.resetScissor (fullArea
: Boolean); inline;
1766 if not scallowed
then exit
;
1769 setScissor(0, 0, mWidth
, mHeight
);
1773 setScissor(mFrameWidth
, mFrameHeight
, mWidth
-mFrameWidth
*2, mHeight
-mFrameHeight
*2);
1778 // ////////////////////////////////////////////////////////////////////////// //
1779 procedure TUIControl
.draw ();
1784 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1785 toGlobal(0, 0, gx
, gy
);
1787 scis
.save(true); // scissoring enabled
1790 resetScissor(true); // full area
1791 drawControl(gx
, gy
);
1792 resetScissor(false); // client area
1793 for f
:= 0 to High(mChildren
) do mChildren
[f
].draw();
1794 resetScissor(true); // full area
1795 drawControlPost(gx
, gy
);
1802 procedure TUIControl
.drawControl (gx
, gy
: Integer);
1804 //if (mParent = nil) then darkenRect(gx, gy, mWidth, mHeight, 64);
1807 procedure TUIControl
.drawControlPost (gx
, gy
: Integer);
1810 if mDrawShadow
and (mWidth
> 0) and (mHeight
> 0) then
1812 setScissorGLInternal(gx
+8, gy
+8, mWidth
, mHeight
);
1813 darkenRect(gx
+mWidth
, gy
+8, 8, mHeight
, 128);
1814 darkenRect(gx
+8, gy
+mHeight
, mWidth
-8, 8, 128);
1819 // ////////////////////////////////////////////////////////////////////////// //
1820 procedure TUIControl
.mouseEvent (var ev
: THMouseEvent
);
1824 if (not mEnabled
) then exit
;
1825 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1826 ctl
:= controlAtXY(ev
.x
, ev
.y
);
1827 if (ctl
= nil) then exit
;
1828 if (ctl
.canFocus
) and (ev
.press
) then
1830 if (ctl
<> topLevel
.mFocused
) then ctl
.setFocused(true);
1833 if (ctl
<> self
) then ctl
.mouseEvent(ev
);
1838 procedure TUIControl
.keyEvent (var ev
: THKeyEvent
);
1840 function doPreKey (ctl
: TUIControl
): Boolean;
1842 if (not ctl
.mEnabled
) then begin result
:= false; exit
; end;
1843 ctl
.keyEventPre(ev
);
1844 result
:= (ev
.eaten
) or (ev
.cancelled
); // stop if event was consumed
1847 function doPostKey (ctl
: TUIControl
): Boolean;
1849 if (not ctl
.mEnabled
) then begin result
:= false; exit
; end;
1850 ctl
.keyEventPost(ev
);
1851 result
:= (ev
.eaten
) or (ev
.cancelled
); // stop if event was consumed
1857 if (not mEnabled
) then exit
;
1858 if (ev
.eaten
) or (ev
.cancelled
) then exit
;
1860 if (mParent
= nil) then
1862 forEachControl(doPreKey
);
1863 if (ev
.eaten
) or (ev
.cancelled
) then exit
;
1865 // focused control should process keyboard first
1866 if (topLevel
.mFocused
<> self
) and isMyChild(topLevel
.mFocused
) and (topLevel
.mFocused
.mEnabled
) then
1868 ctl
:= topLevel
.mFocused
;
1869 while (ctl
<> nil) and (ctl
<> self
) do
1872 if (ev
.eaten
) or (ev
.cancelled
) then exit
;
1876 // for top-level controls
1877 if (mParent
= nil) then
1879 if (ev
= 'S-Tab') then
1881 ctl
:= findPrevFocus(mFocused
);
1882 if (ctl
<> mFocused
) then ctl
.setFocused(true);
1886 if (ev
= 'Tab') then
1888 ctl
:= findNextFocus(mFocused
);
1889 if (ctl
<> mFocused
) then ctl
.setFocused(true);
1893 if (ev
= 'Enter') or (ev
= 'C-Enter') then
1895 ctl
:= findDefaulControl();
1896 if (ctl
<> nil) then
1903 if (ev
= 'Escape') then
1905 ctl
:= findCancelControl();
1906 if (ctl
<> nil) then
1913 if mEscClose
and (ev
= 'Escape') then
1915 if (not assigned(closeRequestCB
)) or (closeRequestCB(self
)) then
1917 uiRemoveWindow(self
);
1923 if (ev
.eaten
) or (ev
.cancelled
) then exit
;
1924 forEachControl(doPostKey
);
1929 procedure TUIControl
.keyEventPre (var ev
: THKeyEvent
);
1934 procedure TUIControl
.keyEventPost (var ev
: THKeyEvent
);
1939 // ////////////////////////////////////////////////////////////////////////// //
1940 constructor TUITopWindow
.Create (const atitle
: AnsiString; ax
, ay
: Integer; aw
: Integer=-1; ah
: Integer=-1);
1942 inherited Create(ax
, ay
, aw
, ah
);
1949 procedure TUITopWindow
.AfterConstruction ();
1951 inherited AfterConstruction();
1952 if (mWidth
< mFrameWidth
*2+3*8) then mWidth
:= mFrameWidth
*2+3*8;
1953 if (mHeight
< mFrameHeight
*2) then mHeight
:= mFrameHeight
*2;
1954 if (Length(mTitle
) > 0) then
1956 if (mWidth
< Length(mTitle
)*8+mFrameWidth
*2+3*8) then mWidth
:= Length(mTitle
)*8+mFrameWidth
*2+3*8;
1958 mDragScroll
:= TXMode
.None
;
1959 mDrawShadow
:= true;
1960 mWaitingClose
:= false;
1963 mCtl4Style
:= 'window';
1967 function TUITopWindow
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
1969 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) then
1971 mTitle
:= par
.expectIdOrStr(true);
1975 if (strEquCI1251(prname
, 'children')) then
1981 if (strEquCI1251(prname
, 'position')) then
1983 if (par
.eatIdOrStrCI('default')) then mDoCenter
:= false
1984 else if (par
.eatIdOrStrCI('center')) then mDoCenter
:= true
1985 else par
.error('`center` or `default` expected');
1989 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
1990 result
:= inherited parseProperty(prname
, par
);
1994 procedure TUITopWindow
.cacheStyle (root
: TUIStyle
);
1996 inherited cacheStyle(root
);
2000 procedure TUITopWindow
.centerInScreen ();
2002 if (mWidth
> 0) and (mHeight
> 0) then
2004 mX
:= trunc((gScrWidth
/gh_ui_scale
-mWidth
)/2);
2005 mY
:= trunc((gScrHeight
/gh_ui_scale
-mHeight
)/2);
2010 procedure TUITopWindow
.drawControl (gx
, gy
: Integer);
2012 fillRect(gx
, gy
, mWidth
, mHeight
, mBackColor
[getColorIndex
]);
2016 procedure TUITopWindow
.drawControlPost (gx
, gy
: Integer);
2019 tx
, hgt
, sbhgt
: Integer;
2021 cidx
:= getColorIndex
;
2022 if (mDragScroll
= TXMode
.Drag
) then
2024 drawRectUI(gx
+4, gy
+4, mWidth
-8, mHeight
-8, mFrameColor
[cidx
]);
2028 drawRectUI(gx
+3, gy
+3, mWidth
-6, mHeight
-6, mFrameColor
[cidx
]);
2029 drawRectUI(gx
+5, gy
+5, mWidth
-10, mHeight
-10, mFrameColor
[cidx
]);
2030 // vertical scroll bar
2031 hgt
:= mHeight
-mFrameHeight
*2;
2032 if (hgt
> 0) and (mFullSize
.h
> hgt
) then
2034 //writeln(mTitle, ': height=', mHeight-mFrameHeight*2, '; fullsize=', mFullSize.toString);
2035 sbhgt
:= mHeight
-mFrameHeight
*2+2;
2036 fillRect(gx
+mWidth
-mFrameWidth
+1, gy
+7, mFrameWidth
-3, sbhgt
, mFrameColor
[cidx
]);
2038 if (hgt
> mFullSize
.h
) then hgt
:= mFullSize
.h
;
2039 hgt
:= sbhgt
*hgt
div mFullSize
.h
;
2042 setScissor(mWidth
-mFrameWidth
+1, 7, mFrameWidth
-3, sbhgt
);
2043 darkenRect(gx
+mWidth
-mFrameWidth
+1, gy
+7+hgt
, mFrameWidth
-3, sbhgt
, 128);
2047 setScissor(mFrameWidth
, 0, 3*8, 8);
2048 fillRect(gx
+mFrameWidth
, gy
, 3*8, 8, mBackColor
[cidx
]);
2049 drawText8(gx
+mFrameWidth
, gy
, '[ ]', mFrameColor
[cidx
]);
2050 if mInClose
then drawText8(gx
+mFrameWidth
+7, gy
, '#', mFrameIconColor
[cidx
])
2051 else drawText8(gx
+mFrameWidth
+7, gy
, '*', mFrameIconColor
[cidx
]);
2054 if (Length(mTitle
) > 0) then
2056 setScissor(mFrameWidth
+3*8, 0, mWidth
-mFrameWidth
*2-3*8, 8);
2057 tx
:= (gx
+3*8)+((mWidth
-3*8)-Length(mTitle
)*8) div 2;
2058 fillRect(tx
-3, gy
, Length(mTitle
)*8+3+2, 8, mBackColor
[cidx
]);
2059 drawText8(tx
, gy
, mTitle
, mFrameTextColor
[cidx
]);
2062 inherited drawControlPost(gx
, gy
);
2066 procedure TUITopWindow
.activated ();
2068 if (mFocused
= nil) or (mFocused
= self
) then
2070 mFocused
:= findFirstFocus();
2071 if (mFocused
<> nil) and (mFocused
<> self
) then mFocused
.activated();
2077 procedure TUITopWindow
.blurred ();
2079 mDragScroll
:= TXMode
.None
;
2080 mWaitingClose
:= false;
2086 procedure TUITopWindow
.keyEvent (var ev
: THKeyEvent
);
2088 inherited keyEvent(ev
);
2089 if (ev
.eaten
) or (ev
.cancelled
) or (not mEnabled
) {or (not getFocused)} then exit
;
2090 if (ev
= 'M-F3') then
2092 if (not assigned(closeRequestCB
)) or (closeRequestCB(self
)) then
2094 uiRemoveWindow(self
);
2102 procedure TUITopWindow
.mouseEvent (var ev
: THMouseEvent
);
2105 hgt
, sbhgt
: Integer;
2107 if (not mEnabled
) then exit
;
2108 if (mWidth
< 1) or (mHeight
< 1) then exit
;
2110 if (mDragScroll
= TXMode
.Drag
) then
2112 mX
+= ev
.x
-mDragStartX
;
2113 mY
+= ev
.y
-mDragStartY
;
2114 mDragStartX
:= ev
.x
;
2115 mDragStartY
:= ev
.y
;
2116 if (ev
.release
) and (ev
.but
= ev
.Left
) then mDragScroll
:= TXMode
.None
;
2121 if (mDragScroll
= TXMode
.Scroll
) then
2123 // check for vertical scrollbar
2131 sbhgt
:= mHeight
-mFrameHeight
*2+2;
2132 hgt
:= mHeight
-mFrameHeight
*2;
2133 if (hgt
> 0) and (mFullSize
.h
> hgt
) then
2135 hgt
:= (mFullSize
.h
*(ly
-7) div (sbhgt
-1))-(mHeight
-mFrameHeight
*2);
2136 mScrollY
:= nmax(0, hgt
);
2137 hgt
:= mHeight
-mFrameHeight
*2;
2138 if (mScrollY
+hgt
> mFullSize
.h
) then mScrollY
:= nmax(0, mFullSize
.h
-hgt
);
2141 if (ev
.release
) and (ev
.but
= ev
.Left
) then mDragScroll
:= TXMode
.None
;
2146 if toLocal(ev
.x
, ev
.y
, lx
, ly
) then
2153 if (lx
>= mFrameWidth
) and (lx
< mFrameWidth
+3*8) then
2155 //uiRemoveWindow(self);
2156 mWaitingClose
:= true;
2161 mDragScroll
:= TXMode
.Drag
;
2162 mDragStartX
:= ev
.x
;
2163 mDragStartY
:= ev
.y
;
2168 // check for vertical scrollbar
2169 if (lx
>= mWidth
-mFrameWidth
+1) and (ly
>= 7) and (ly
< mHeight
-mFrameHeight
+1) then
2171 sbhgt
:= mHeight
-mFrameHeight
*2+2;
2172 hgt
:= mHeight
-mFrameHeight
*2;
2173 if (hgt
> 0) and (mFullSize
.h
> hgt
) then
2175 hgt
:= (mFullSize
.h
*(ly
-7) div (sbhgt
-1))-(mHeight
-mFrameHeight
*2);
2176 mScrollY
:= nmax(0, hgt
);
2178 mDragScroll
:= TXMode
.Scroll
;
2184 if (lx
< mFrameWidth
) or (lx
>= mWidth
-mFrameWidth
) or (ly
>= mHeight
-mFrameHeight
) then
2187 mDragScroll
:= TXMode
.Drag
;
2188 mDragStartX
:= ev
.x
;
2189 mDragStartY
:= ev
.y
;
2195 if (ev
.release
) then
2197 if mWaitingClose
then
2199 if (lx
>= mFrameWidth
) and (lx
< mFrameWidth
+3*8) then
2201 if (not assigned(closeRequestCB
)) or (closeRequestCB(self
)) then
2203 uiRemoveWindow(self
);
2206 mWaitingClose
:= false;
2215 if mWaitingClose
then
2217 mInClose
:= (lx
>= mFrameWidth
) and (lx
< mFrameWidth
+3*8);
2223 inherited mouseEvent(ev
);
2228 if (not ev
.motion
) and (mWaitingClose
) then begin ev
.eat(); mWaitingClose
:= false; exit
; end;
2233 // ////////////////////////////////////////////////////////////////////////// //
2234 constructor TUISimpleText
.Create (ax
, ay
: Integer);
2237 inherited Create(ax
, ay
, 4, 4);
2238 mDefSize
:= TLaySize
.Create(mWidth
, mHeight
);
2242 destructor TUISimpleText
.Destroy ();
2249 procedure TUISimpleText
.AfterConstruction ();
2253 mCtl4Style
:= 'simple_text';
2257 procedure TUISimpleText
.appendItem (const atext
: AnsiString; acentered
: Boolean=false; ahline
: Boolean=false);
2261 if (Length(atext
)*8+3*8+2 > mWidth
) then mWidth
:= Length(atext
)*8+3*8+2;
2262 SetLength(mItems
, Length(mItems
)+1);
2263 it
:= @mItems
[High(mItems
)];
2265 it
.centered
:= acentered
;
2267 if (Length(mItems
)*8 > mHeight
) then mHeight
:= Length(mItems
)*8;
2268 mDefSize
:= TLaySize
.Create(mWidth
, mHeight
);
2272 procedure TUISimpleText
.drawControl (gx
, gy
: Integer);
2278 cidx
:= getColorIndex
;
2279 for f
:= 0 to High(mItems
) do
2283 if it
.centered
then begin xofs
:= (mWidth
-Length(it
.title
)*8) div 2; end;
2286 if (Length(it
.title
) = 0) then
2288 drawHLine(gx
+4, gy
+3, mWidth
-8, mFrameColor
[cidx
]);
2292 drawHLine(gx
+4, gy
+3, gx
+xofs
-3-(gx
+3), mFrameColor
[cidx
]);
2293 drawHLine(gx
+xofs
+Length(it
.title
)*8, gy
+3, mWidth
-(xofs
+Length(it
.title
)*8)-4, mFrameColor
[cidx
]);
2294 drawText8(gx
+xofs
, gy
, it
.title
, mFrameTextColor
[cidx
]);
2299 drawText8(gx
+xofs
, gy
, it
.title
, mTextColor
[cidx
]);
2306 procedure TUISimpleText
.mouseEvent (var ev
: THMouseEvent
);
2310 inherited mouseEvent(ev
);
2311 if (not ev
.eaten
) and (not ev
.cancelled
) and (mEnabled
) and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
2318 // ////////////////////////////////////////////////////////////////////////// //
2319 constructor TUICBListBox
.Create (ax
, ay
: Integer);
2321 inherited Create(ax
, ay
, 4, 4);
2322 mDefSize
:= TLaySize
.Create(mWidth
, mHeight
);
2326 destructor TUICBListBox
.Destroy ();
2333 procedure TUICBListBox
.AfterConstruction ();
2338 mCtl4Style
:= 'cb_listbox';
2342 procedure TUICBListBox
.cacheStyle (root
: TUIStyle
);
2344 inherited cacheStyle(root
);
2346 mCurItemBack
[ClrIdxActive
] := root
.get('current-item-back-color', 'active', mCtl4Style
).asRGBADef(TGxRGBA
.Create(0, 128, 0));
2348 mCurItemBack
[ClrIdxDisabled
] := root
.get('current-item-back-color', 'disabled', mCtl4Style
).asRGBADef(TGxRGBA
.Create(0, 64, 0));
2350 mCurItemBack
[ClrIdxInactive
] := root
.get('current-item-back-color', 'inactive', mCtl4Style
).asRGBADef(TGxRGBA
.Create(0, 64, 0));
2354 procedure TUICBListBox
.appendItem (const atext
: AnsiString; bv
: PBoolean; aaction
: TActionCB
=nil);
2358 if (Length(atext
)*8+3*8+2 > mWidth
) then mWidth
:= Length(atext
)*8+3*8+2;
2359 SetLength(mItems
, Length(mItems
)+1);
2360 it
:= @mItems
[High(mItems
)];
2363 it
.actionCB
:= aaction
;
2364 if (Length(mItems
)*8 > mHeight
) then mHeight
:= Length(mItems
)*8;
2365 if (mCurIndex
< 0) then mCurIndex
:= 0;
2366 mDefSize
:= TLaySize
.Create(mWidth
, mHeight
);
2370 procedure TUICBListBox
.drawControl (gx
, gy
: Integer);
2376 cidx
:= getColorIndex
;
2377 for f
:= 0 to High(mItems
) do
2380 if (mCurIndex
= f
) then fillRect(gx
, gy
, mWidth
, 8, mCurItemBack
[cidx
]);
2381 if (it
.varp
<> nil) then
2383 if it
.varp
^ then drawText8(gx
, gy
, '[x]', mFrameTextColor
[cidx
]) else drawText8(gx
, gy
, '[ ]', mFrameTextColor
[cidx
]);
2384 drawText8(gx
+3*8+2, gy
, it
.title
, mTextColor
[cidx
]);
2386 else if (Length(it
.title
) > 0) then
2388 tx
:= gx
+(mWidth
-Length(it
.title
)*8) div 2;
2389 if (tx
-3 > gx
+4) then
2391 drawHLine(gx
+4, gy
+3, tx
-3-(gx
+3), mFrameColor
[cidx
]);
2392 drawHLine(tx
+Length(it
.title
)*8, gy
+3, mWidth
-4, mFrameColor
[cidx
]);
2394 drawText8(tx
, gy
, it
.title
, mFrameTextColor
[cidx
]);
2398 drawHLine(gx
+4, gy
+3, mWidth
-8, mFrameColor
[cidx
]);
2405 procedure TUICBListBox
.mouseEvent (var ev
: THMouseEvent
);
2410 inherited mouseEvent(ev
);
2411 if (not ev
.eaten
) and (not ev
.cancelled
) and (mEnabled
) and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
2414 if (ev
= 'lmb') then
2417 if (ly
>= 0) and (ly
< Length(mItems
)) then
2420 if (it
.varp
<> nil) then
2423 it
.varp
^ := not it
.varp
^;
2424 if assigned(it
.actionCB
) then it
.actionCB(self
, Integer(it
.varp
^));
2425 if assigned(actionCB
) then actionCB(self
, ly
);
2433 procedure TUICBListBox
.keyEvent (var ev
: THKeyEvent
);
2437 inherited keyEvent(ev
);
2438 if (ev
.eaten
) or (ev
.cancelled
) or (not mEnabled
) or (not getFocused
) then exit
;
2440 if (ev
= 'Home') or (ev
= 'PageUp') then
2445 if (ev
= 'End') or (ev
= 'PageDown') then
2448 mCurIndex
:= High(mItems
);
2453 if (Length(mItems
) > 0) then
2455 if (mCurIndex
< 0) then mCurIndex
:= Length(mItems
);
2456 while (mCurIndex
> 0) do
2459 if (mItems
[mCurIndex
].varp
<> nil) then break
;
2467 if (ev
= 'Down') then
2470 if (Length(mItems
) > 0) then
2472 if (mCurIndex
< 0) then mCurIndex
:= -1;
2473 while (mCurIndex
< High(mItems
)) do
2476 if (mItems
[mCurIndex
].varp
<> nil) then break
;
2484 if (ev
= 'Space') or (ev
= 'Enter') then
2487 if (mCurIndex
>= 0) and (mCurIndex
< Length(mItems
)) and (mItems
[mCurIndex
].varp
<> nil) then
2489 it
:= @mItems
[mCurIndex
];
2490 it
.varp
^ := not it
.varp
^;
2491 if assigned(it
.actionCB
) then it
.actionCB(self
, Integer(it
.varp
^));
2492 if assigned(actionCB
) then actionCB(self
, mCurIndex
);
2498 // ////////////////////////////////////////////////////////////////////////// //
2499 constructor TUIBox
.Create (ahoriz
: Boolean);
2506 procedure TUIBox
.AfterConstruction ();
2508 inherited AfterConstruction();
2510 mCtl4Style
:= 'box';
2514 function TUIBox
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2516 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
2517 if (strEquCI1251(prname
, 'frame')) then
2519 mHasFrame
:= parseBool(par
);
2520 if (mHasFrame
) then begin mFrameWidth
:= 8; mFrameHeight
:= 8; end else begin mFrameWidth
:= 0; mFrameHeight
:= 0; end;
2524 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) then
2526 mCaption
:= par
.expectIdOrStr(true);
2527 mDefSize
:= TLaySize
.Create(Length(mCaption
)*8+3, 8);
2531 if (strEquCI1251(prname
, 'children')) then
2537 result
:= inherited parseProperty(prname
, par
);
2541 procedure TUIBox
.drawControl (gx
, gy
: Integer);
2546 cidx
:= getColorIndex
;
2547 fillRect(gx
, gy
, mWidth
, mHeight
, mBackColor
[cidx
]);
2551 drawRectUI(gx
+3, gy
+3, mWidth
-6, mHeight
-6, mFrameColor
[cidx
]);
2554 if (Length(mCaption
) > 0) then
2556 setScissor(mFrameWidth
+1, 0, mWidth
-mFrameWidth
-2, 8);
2557 tx
:= gx
+((mWidth
-Length(mCaption
)*8) div 2);
2558 if mHasFrame
then fillRect(tx
-2, gy
, Length(mCaption
)*8+3, 8, mBackColor
[cidx
]);
2559 drawText8(tx
, gy
, mCaption
, mFrameTextColor
[cidx
]);
2564 procedure TUIBox
.mouseEvent (var ev
: THMouseEvent
);
2568 inherited mouseEvent(ev
);
2569 if (not ev
.eaten
) and (not ev
.cancelled
) and (mEnabled
) and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
2576 //TODO: navigation with arrow keys, according to box orientation
2577 procedure TUIBox
.keyEvent (var ev
: THKeyEvent
);
2580 cur
, ctl
: TUIControl
;
2582 inherited keyEvent(ev
);
2583 if (ev
.eaten
) or (ev
.cancelled
) or (not ev
.press
) or (not mEnabled
) or (not getActive
) then exit
;
2584 if (Length(mChildren
) = 0) then exit
;
2585 if (mHoriz
) and (ev
= 'Left') then dir
:= -1
2586 else if (mHoriz
) and (ev
= 'Right') then dir
:= 1
2587 else if (not mHoriz
) and (ev
= 'Up') then dir
:= -1
2588 else if (not mHoriz
) and (ev
= 'Down') then dir
:= 1;
2589 if (dir
= 0) then exit
;
2591 cur
:= topLevel
.mFocused
;
2592 while (cur
<> nil) and (cur
.mParent
<> self
) do cur
:= cur
.mParent
;
2593 //if (cur = nil) then writeln('CUR: nil') else writeln('CUR: ', cur.className, '#', cur.id);
2594 if (dir
< 0) then ctl
:= findPrevFocus(cur
) else ctl
:= findNextFocus(cur
);
2595 //if (ctl = nil) then writeln('CTL: nil') else writeln('CTL: ', ctl.className, '#', ctl.id);
2596 if (ctl
<> nil) and (ctl
<> self
) then
2598 ctl
.focused
:= true;
2603 // ////////////////////////////////////////////////////////////////////////// //
2604 constructor TUIHBox
.Create ();
2609 procedure TUIHBox
.AfterConstruction ();
2611 inherited AfterConstruction();
2616 // ////////////////////////////////////////////////////////////////////////// //
2617 constructor TUIVBox
.Create ();
2622 procedure TUIVBox
.AfterConstruction ();
2624 inherited AfterConstruction();
2629 // ////////////////////////////////////////////////////////////////////////// //
2630 procedure TUISpan
.AfterConstruction ();
2632 inherited AfterConstruction();
2635 mCtl4Style
:= 'span';
2639 function TUISpan
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2641 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
2642 result
:= inherited parseProperty(prname
, par
);
2646 procedure TUISpan
.drawControl (gx
, gy
: Integer);
2651 // ////////////////////////////////////////////////////////////////////// //
2652 procedure TUILine
.AfterConstruction ();
2654 inherited AfterConstruction();
2658 mCtl4Style
:= 'line';
2662 function TUILine
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2664 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
2665 result
:= inherited parseProperty(prname
, par
);
2669 procedure TUILine
.drawControl (gx
, gy
: Integer);
2673 cidx
:= getColorIndex
;
2676 drawHLine(gx
, gy
+(mHeight
div 2), mWidth
, mTextColor
[cidx
]);
2680 drawVLine(gx
+(mWidth
div 2), gy
, mHeight
, mTextColor
[cidx
]);
2685 // ////////////////////////////////////////////////////////////////////////// //
2686 procedure TUIHLine
.AfterConstruction ();
2688 inherited AfterConstruction();
2694 // ////////////////////////////////////////////////////////////////////////// //
2695 procedure TUIVLine
.AfterConstruction ();
2697 inherited AfterConstruction();
2703 // ////////////////////////////////////////////////////////////////////////// //
2704 procedure TUIStaticText
.AfterConstruction ();
2710 mHoriz
:= true; // nobody cares
2714 mCtl4Style
:= 'static';
2718 procedure TUIStaticText
.setText (const atext
: AnsiString);
2721 mDefSize
:= TLaySize
.Create(Length(mText
)*8, 8);
2725 function TUIStaticText
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2727 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) or (strEquCI1251(prname
, 'text')) then
2729 setText(par
.expectIdOrStr(true));
2733 if (strEquCI1251(prname
, 'textalign')) then
2735 parseTextAlign(par
, mHAlign
, mVAlign
);
2739 if (strEquCI1251(prname
, 'header')) then
2745 if (strEquCI1251(prname
, 'line')) then
2751 result
:= inherited parseProperty(prname
, par
);
2755 procedure TUIStaticText
.drawControl (gx
, gy
: Integer);
2757 xpos
, ypos
: Integer;
2761 cidx
:= getColorIndex
;
2762 fillRect(gx
, gy
, mWidth
, mHeight
, mBackColor
[cidx
]);
2764 if (mHAlign
< 0) then xpos
:= 0
2765 else if (mHAlign
> 0) then xpos
:= mWidth
-Length(mText
)*8
2766 else xpos
:= (mWidth
-Length(mText
)*8) div 2;
2768 if (Length(mText
) > 0) then
2770 if (mHeader
) then clr
:= mFrameTextColor
[cidx
] else clr
:= mTextColor
[cidx
];
2772 if (mVAlign
< 0) then ypos
:= 0
2773 else if (mVAlign
> 0) then ypos
:= mHeight
-8
2774 else ypos
:= (mHeight
-8) div 2;
2776 drawText8(gx
+xpos
, gy
+ypos
, mText
, clr
);
2781 if (mHeader
) then clr
:= mFrameColor
[cidx
] else clr
:= mTextColor
[cidx
];
2783 if (mVAlign
< 0) then ypos
:= 0
2784 else if (mVAlign
> 0) then ypos
:= mHeight
-1
2785 else ypos
:= (mHeight
div 2);
2788 if (Length(mText
) = 0) then
2790 drawHLine(gx
, ypos
, mWidth
, clr
);
2794 drawHLine(gx
, ypos
, xpos
-1, clr
);
2795 drawHLine(gx
+xpos
+Length(mText
)*8, ypos
, mWidth
, clr
);
2801 // ////////////////////////////////////////////////////////////////////////// //
2802 procedure TUITextLabel
.AfterConstruction ();
2804 inherited AfterConstruction();
2808 mDefSize
:= TLaySize
.Create(Length(mText
)*8, 8);
2809 mCtl4Style
:= 'label';
2814 procedure TUITextLabel
.cacheStyle (root
: TUIStyle
);
2816 inherited cacheStyle(root
);
2818 mHotColor
[ClrIdxActive
] := root
.get('hot-color', 'active', mCtl4Style
).asRGBADef(TGxRGBA
.Create(0, 128, 0));
2820 mHotColor
[ClrIdxDisabled
] := root
.get('hot-color', 'disabled', mCtl4Style
).asRGBADef(TGxRGBA
.Create(0, 64, 0));
2822 mHotColor
[ClrIdxInactive
] := root
.get('hot-color', 'inactive', mCtl4Style
).asRGBADef(TGxRGBA
.Create(0, 64, 0));
2826 procedure TUITextLabel
.setText (const s
: AnsiString);
2834 while (f
<= Length(s
)) do
2836 if (s
[f
] = '\\') then
2839 if (f
<= Length(s
)) then mText
+= s
[f
];
2842 else if (s
[f
] = '~') then
2845 if (f
<= Length(s
)) then
2847 if (mHotChar
= #0) then
2850 mHotOfs
:= Length(mText
)*8;
2865 function TUITextLabel
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2867 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) or (strEquCI1251(prname
, 'text')) then
2869 setText(par
.expectIdOrStr(true));
2870 mDefSize
:= TLaySize
.Create(Length(mText
)*8, 8);
2874 if (strEquCI1251(prname
, 'link')) then
2876 mLinkId
:= par
.expectIdOrStr(true);
2880 if (strEquCI1251(prname
, 'textalign')) then
2882 parseTextAlign(par
, mHAlign
, mVAlign
);
2886 result
:= inherited parseProperty(prname
, par
);
2890 procedure TUITextLabel
.drawControl (gx
, gy
: Integer);
2892 xpos
, ypos
: Integer;
2895 cidx
:= getColorIndex
;
2896 fillRect(gx
, gy
, mWidth
, mHeight
, mBackColor
[cidx
]);
2897 if (Length(mText
) > 0) then
2899 if (mHAlign
< 0) then xpos
:= 0
2900 else if (mHAlign
> 0) then xpos
:= mWidth
-Length(mText
)*8
2901 else xpos
:= (mWidth
-Length(mText
)*8) div 2;
2903 if (mVAlign
< 0) then ypos
:= 0
2904 else if (mVAlign
> 0) then ypos
:= mHeight
-8
2905 else ypos
:= (mHeight
-8) div 2;
2907 drawText8(gx
+xpos
, gy
+ypos
, mText
, mTextColor
[cidx
]);
2909 if (Length(mLinkId
) > 0) and (mHotChar
<> #0) and (mHotChar
<> ' ') then
2911 drawText8(gx
+xpos
+8+mHotOfs
, gy
+ypos
, mHotChar
, mHotColor
[cidx
]);
2917 procedure TUITextLabel
.mouseEvent (var ev
: THMouseEvent
);
2921 inherited mouseEvent(ev
);
2922 if (not ev
.eaten
) and (not ev
.cancelled
) and (mEnabled
) and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
2929 procedure TUITextLabel
.keyEventPost (var ev
: THKeyEvent
);
2933 if (not mEnabled
) then exit
;
2934 if (mHotChar
= #0) or (Length(mLinkId
) = 0) then exit
;
2935 if (ev
.eaten
) or (ev
.cancelled
) or (not ev
.press
) then exit
;
2936 if (not ev
.isHot(mHotChar
)) then exit
;
2937 ctl
:= topLevel
[mLinkId
];
2938 if (ctl
<> nil) then
2941 if (ctl
.canFocus
) then ctl
.focused
:= true;
2946 // ////////////////////////////////////////////////////////////////////////// //
2947 procedure TUIButton
.AfterConstruction ();
2949 inherited AfterConstruction();
2953 mDefSize
:= TLaySize
.Create(Length(mText
)*8+8, 10);
2954 mCtl4Style
:= 'button';
2958 function TUIButton
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2960 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) then
2962 result
:= inherited parseProperty(prname
, par
);
2963 if result
then mDefSize
:= TLaySize
.Create(Length(mText
)*8+8*2, 10);
2966 result
:= inherited parseProperty(prname
, par
);
2970 procedure TUIButton
.drawControl (gx
, gy
: Integer);
2972 xpos
, ypos
: Integer;
2975 cidx
:= getColorIndex
;
2977 if (mVAlign
< 0) then ypos
:= 0
2978 else if (mVAlign
> 0) then ypos
:= mHeight
-8
2979 else ypos
:= (mHeight
-8) div 2;
2981 fillRect(gx
+1, gy
, mWidth
-2, mHeight
, mBackColor
[cidx
]);
2982 fillRect(gx
, gy
+1, 1, mHeight
-2, mBackColor
[cidx
]);
2983 fillRect(gx
+mWidth
-1, gy
+1, 1, mHeight
-2, mBackColor
[cidx
]);
2985 if (Length(mText
) > 0) then
2987 if (mHAlign
< 0) then xpos
:= 0
2988 else if (mHAlign
> 0) then xpos
:= mWidth
-Length(mText
)*8
2989 else xpos
:= (mWidth
-Length(mText
)*8) div 2;
2991 setScissor(8, 0, mWidth
-16, mHeight
);
2992 drawText8(gx
+xpos
+8, gy
+ypos
, mText
, mTextColor
[cidx
]);
2994 if (mHotChar
<> #0) and (mHotChar
<> ' ') then
2996 drawText8(gx
+xpos
+8+mHotOfs
, gy
+ypos
, mHotChar
, mHotColor
[cidx
]);
3002 procedure TUIButton
.mouseEvent (var ev
: THMouseEvent
);
3006 inherited mouseEvent(ev
);
3007 if (uiGrabCtl
= self
) then
3010 if (ev
= '-lmb') and focused
and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
3016 if (ev
.eaten
) or (ev
.cancelled
) or (not mEnabled
) or not focused
then exit
;
3021 procedure TUIButton
.keyEvent (var ev
: THKeyEvent
);
3023 inherited keyEvent(ev
);
3024 if (not ev
.eaten
) and (not ev
.cancelled
) and (mEnabled
) then
3026 if (ev
= 'Enter') or (ev
= 'Space') then
3036 procedure TUIButton
.keyEventPost (var ev
: THKeyEvent
);
3038 if (not mEnabled
) then exit
;
3039 if (mHotChar
= #0) then exit
;
3040 if (ev
.eaten
) or (ev
.cancelled
) or (not ev
.press
) then exit
;
3041 if (not ev
.isHot(mHotChar
)) then exit
;
3042 if (not canFocus
) then exit
;
3050 registerCtlClass(TUIHBox
, 'hbox');
3051 registerCtlClass(TUIVBox
, 'vbox');
3052 registerCtlClass(TUISpan
, 'span');
3053 registerCtlClass(TUIHLine
, 'hline');
3054 registerCtlClass(TUIVLine
, 'vline');
3055 registerCtlClass(TUITextLabel
, 'label');
3056 registerCtlClass(TUIStaticText
, 'static');
3057 registerCtlClass(TUIButton
, 'button');