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);
41 const ClrIdxActive
= 0;
42 const ClrIdxDisabled
= 1;
43 const ClrIdxInactive
= 2;
51 mWidth
, mHeight
: Integer;
52 mFrameWidth
, mFrameHeight
: Integer;
55 mChildren
: array of TUIControl
;
56 mFocused
: TUIControl
; // valid only for top-level controls
57 mGrab
: TUIControl
; // valid only for top-level controls
58 mEscClose
: Boolean; // valid only for top-level controls
62 mCtl4Style
: AnsiString;
63 mBackColor
: array[0..ClrIdxMax
] of TGxRGBA
;
64 mTextColor
: array[0..ClrIdxMax
] of TGxRGBA
;
65 mFrameColor
: array[0..ClrIdxMax
] of TGxRGBA
;
66 mFrameTextColor
: array[0..ClrIdxMax
] of TGxRGBA
;
67 mFrameIconColor
: array[0..ClrIdxMax
] of TGxRGBA
;
68 mDarken
: array[0..ClrIdxMax
] of Integer; // -1: none
75 procedure updateStyle (); virtual;
76 procedure cacheStyle (root
: TUIStyle
); virtual;
77 function getColorIndex (): Integer; inline;
80 function getEnabled (): Boolean;
81 procedure setEnabled (v
: Boolean); inline;
83 function getFocused (): Boolean; inline;
84 procedure setFocused (v
: Boolean); inline;
86 function isMyChild (ctl
: TUIControl
): Boolean;
88 function findFirstFocus (): TUIControl
;
89 function findLastFocus (): TUIControl
;
91 function findNextFocus (cur
: TUIControl
): TUIControl
;
92 function findPrevFocus (cur
: TUIControl
): TUIControl
;
94 procedure activated (); virtual;
95 procedure blurred (); virtual;
97 //WARNING! do not call scissor functions outside `.draw*()` API!
98 // set scissor to this rect (in local coords)
99 procedure setScissor (lx
, ly
, lw
, lh
: Integer);
100 // reset scissor to whole control
101 procedure resetScissor (fullArea
: Boolean); inline; // "full area" means "with frame"
104 // set scissor to this rect (in global coords)
105 procedure setScissorGLInternal (x
, y
, w
, h
: Integer);
111 mDefSize
: TLaySize
; // default size
112 mMaxSize
: TLaySize
; // maximum size
121 mLayDefSize
: TLaySize
;
122 mLayMaxSize
: TLaySize
;
125 // layouter interface
126 function getDefSize (): TLaySize
; inline; // default size; <0: use max size
127 //procedure setDefSize (const sz: TLaySize); inline; // default size; <0: use max size
128 function getMargins (): TLayMargins
; inline;
129 function getMaxSize (): TLaySize
; inline; // max size; <0: set to some huge value
130 //procedure setMaxSize (const sz: TLaySize); inline; // max size; <0: set to some huge value
131 function getFlex (): Integer; inline; // <=0: not flexible
132 function isHorizBox (): Boolean; inline; // horizontal layout for children?
133 procedure setHorizBox (v
: Boolean); inline; // horizontal layout for children?
134 function canWrap (): Boolean; inline; // for horizontal boxes: can wrap children? for child: `false` means 'nonbreakable at *next* ctl'
135 procedure setCanWrap (v
: Boolean); inline; // for horizontal boxes: can wrap children? for child: `false` means 'nonbreakable at *next* ctl'
136 function isLineStart (): Boolean; inline; // `true` if this ctl should start a new line; ignored for vertical boxes
137 procedure setLineStart (v
: Boolean); inline; // `true` if this ctl should start a new line; ignored for vertical boxes
138 function getAlign (): Integer; inline; // aligning in non-main direction: <0: left/up; 0: center; >0: right/down
139 procedure setAlign (v
: Integer); inline; // aligning in non-main direction: <0: left/up; 0: center; >0: right/down
140 function getExpand (): Boolean; inline; // expanding in non-main direction: `true` will ignore align and eat all available space
141 procedure setExpand (v
: Boolean); inline; // expanding in non-main direction: `true` will ignore align and eat all available space
142 function getHGroup (): AnsiString; inline; // empty: not grouped
143 procedure setHGroup (const v
: AnsiString); inline; // empty: not grouped
144 function getVGroup (): AnsiString; inline; // empty: not grouped
145 procedure setVGroup (const v
: AnsiString); inline; // empty: not grouped
147 procedure setActualSizePos (constref apos
: TLayPos
; constref asize
: TLaySize
); inline;
149 procedure layPrepare (); virtual; // called before registering control in layouter
152 property flex
: Integer read mFlex write mFlex
;
153 property flDefaultSize
: TLaySize read mDefSize write mDefSize
;
154 property flMaxSize
: TLaySize read mMaxSize write mMaxSize
;
155 property flHoriz
: Boolean read isHorizBox write setHorizBox
;
156 property flCanWrap
: Boolean read canWrap write setCanWrap
;
157 property flLineStart
: Boolean read isLineStart write setLineStart
;
158 property flAlign
: Integer read getAlign write setAlign
;
159 property flExpand
: Boolean read getExpand write setExpand
;
160 property flHGroup
: AnsiString read getHGroup write setHGroup
;
161 property flVGroup
: AnsiString read getVGroup write setVGroup
;
164 function parsePos (par
: TTextParser
): TLayPos
;
165 function parseSize (par
: TTextParser
): TLaySize
;
166 function parseBool (par
: TTextParser
): Boolean;
167 function parseAnyAlign (par
: TTextParser
): Integer;
168 function parseHAlign (par
: TTextParser
): Integer;
169 function parseVAlign (par
: TTextParser
): Integer;
170 function parseOrientation (const prname
: AnsiString; par
: TTextParser
): Boolean;
171 procedure parseTextAlign (par
: TTextParser
; var h
, v
: Integer);
172 procedure parseChildren (par
: TTextParser
); // par should be on '{'; final '}' is eaten
175 // par is on property data
176 // there may be more data in text stream, don't eat it!
177 // return `true` if property name is valid and value was parsed
178 // return `false` if property name is invalid; don't advance parser in this case
179 // throw on property data errors
180 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; virtual;
182 // par should be on '{'; final '}' is eaten
183 procedure parseProperties (par
: TTextParser
);
186 constructor Create ();
187 constructor Create (ax
, ay
, aw
, ah
: Integer);
188 destructor Destroy (); override;
190 // `sx` and `sy` are screen coordinates
191 procedure drawControl (gx
, gy
: Integer); virtual;
193 // called after all children drawn
194 procedure drawControlPost (gx
, gy
: Integer); virtual;
196 procedure draw (); virtual;
198 function topLevel (): TUIControl
; inline;
200 // returns `true` if global coords are inside this control
201 function toLocal (var x
, y
: Integer): Boolean;
202 function toLocal (gx
, gy
: Integer; out x
, y
: Integer): Boolean; inline;
203 procedure toGlobal (var x
, y
: Integer);
204 procedure toGlobal (lx
, ly
: Integer; out x
, y
: Integer); inline;
206 // x and y are global coords
207 function controlAtXY (x
, y
: Integer): TUIControl
;
209 function mouseEvent (var ev
: THMouseEvent
): Boolean; virtual; // returns `true` if event was eaten
210 function keyEvent (var ev
: THKeyEvent
): Boolean; virtual; // returns `true` if event was eaten
212 function prevSibling (): TUIControl
;
213 function nextSibling (): TUIControl
;
214 function firstChild (): TUIControl
; inline;
215 function lastChild (): TUIControl
; inline;
217 procedure appendChild (ctl
: TUIControl
); virtual;
220 property id
: AnsiString read mId
;
221 property styleId
: AnsiString read mStyleId
;
222 property x0
: Integer read mX
;
223 property y0
: Integer read mY
;
224 property height
: Integer read mHeight
;
225 property width
: Integer read mWidth
;
226 property enabled
: Boolean read getEnabled write setEnabled
;
227 property parent
: TUIControl read mParent
;
228 property focused
: Boolean read getFocused write setFocused
;
229 property escClose
: Boolean read mEscClose write mEscClose
;
230 property eatKeys
: Boolean read mEatKeys write mEatKeys
;
234 TUITopWindow
= class(TUIControl
)
238 mDragStartX
, mDragStartY
: Integer;
239 mWaitingClose
: Boolean;
241 mFreeOnClose
: Boolean; // default: false
242 mDoCenter
: Boolean; // after layouting
245 procedure cacheStyle (root
: TUIStyle
); override;
248 procedure activated (); override;
249 procedure blurred (); override;
252 closeCB
: TActionCB
; // called after window was removed from ui window list
255 constructor Create (const atitle
: AnsiString; ax
, ay
: Integer; aw
: Integer=-1; ah
: Integer=-1);
257 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
259 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
261 procedure centerInScreen ();
263 // `sx` and `sy` are screen coordinates
264 procedure drawControl (gx
, gy
: Integer); override;
265 procedure drawControlPost (gx
, gy
: Integer); override;
267 function keyEvent (var ev
: THKeyEvent
): Boolean; override; // returns `true` if event was eaten
268 function mouseEvent (var ev
: THMouseEvent
): Boolean; override; // returns `true` if event was eaten
271 property freeOnClose
: Boolean read mFreeOnClose write mFreeOnClose
;
275 TUISimpleText
= class(TUIControl
)
285 mItems
: array of TItem
;
288 constructor Create (ax
, ay
: Integer);
289 destructor Destroy (); override;
291 procedure appendItem (const atext
: AnsiString; acentered
: Boolean=false; ahline
: Boolean=false);
293 procedure drawControl (gx
, gy
: Integer); override;
295 function mouseEvent (var ev
: THMouseEvent
): Boolean; override;
296 function keyEvent (var ev
: THKeyEvent
): Boolean; override;
300 TUICBListBox
= class(TUIControl
)
310 mItems
: array of TItem
;
314 constructor Create (ax
, ay
: Integer);
315 destructor Destroy (); override;
317 procedure appendItem (const atext
: AnsiString; bv
: PBoolean; aaction
: TActionCB
=nil);
319 procedure drawControl (gx
, gy
: Integer); override;
321 function mouseEvent (var ev
: THMouseEvent
): Boolean; override;
322 function keyEvent (var ev
: THKeyEvent
): Boolean; override;
325 // ////////////////////////////////////////////////////////////////////// //
326 TUIBox
= class(TUIControl
)
329 mCaption
: AnsiString;
332 constructor Create (ahoriz
: Boolean);
334 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
336 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
338 procedure drawControl (gx
, gy
: Integer); override;
340 function mouseEvent (var ev
: THMouseEvent
): Boolean; override;
341 function keyEvent (var ev
: THKeyEvent
): Boolean; override;
344 TUIHBox
= class(TUIBox
)
346 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
349 TUIVBox
= class(TUIBox
)
351 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
354 // ////////////////////////////////////////////////////////////////////// //
355 TUISpan
= class(TUIControl
)
357 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
359 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
361 procedure drawControl (gx
, gy
: Integer); override;
364 // ////////////////////////////////////////////////////////////////////// //
365 TUILine
= class(TUIControl
)
367 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
369 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
371 procedure drawControl (gx
, gy
: Integer); override;
374 TUIHLine
= class(TUILine
)
376 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
379 TUIVLine
= class(TUILine
)
381 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
384 // ////////////////////////////////////////////////////////////////////// //
385 TUITextLabel
= class(TUIControl
)
388 mHAlign
: Integer; // -1: left; 0: center; 1: right; default: left
389 mVAlign
: Integer; // -1: top; 0: center; 1: bottom; default: center
392 constructor Create (const atext
: AnsiString);
394 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
396 function parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean; override;
398 procedure drawControl (gx
, gy
: Integer); override;
400 function mouseEvent (var ev
: THMouseEvent
): Boolean; override;
401 function keyEvent (var ev
: THKeyEvent
): Boolean; override;
405 // ////////////////////////////////////////////////////////////////////////// //
406 function uiMouseEvent (ev
: THMouseEvent
): Boolean;
407 function uiKeyEvent (ev
: THKeyEvent
): Boolean;
411 // ////////////////////////////////////////////////////////////////////////// //
412 procedure uiAddWindow (ctl
: TUIControl
);
413 procedure uiRemoveWindow (ctl
: TUIControl
); // will free window if `mFreeOnClose` is `true`
414 function uiVisibleWindow (ctl
: TUIControl
): Boolean;
416 procedure uiUpdateStyles ();
419 // ////////////////////////////////////////////////////////////////////////// //
421 procedure uiLayoutCtl (ctl
: TUIControl
);
424 // ////////////////////////////////////////////////////////////////////////// //
426 gh_ui_scale
: Single = 1.0;
436 // ////////////////////////////////////////////////////////////////////////// //
438 knownCtlClasses
: array of record
439 klass
: TUIControlClass
;
444 procedure registerCtlClass (aklass
: TUIControlClass
; const aname
: AnsiString);
446 assert(aklass
<> nil);
447 assert(Length(aname
) > 0);
448 SetLength(knownCtlClasses
, Length(knownCtlClasses
)+1);
449 knownCtlClasses
[High(knownCtlClasses
)].klass
:= aklass
;
450 knownCtlClasses
[High(knownCtlClasses
)].name
:= aname
;
454 function findCtlClass (const aname
: AnsiString): TUIControlClass
;
458 for f
:= 0 to High(knownCtlClasses
) do
460 if (strEquCI1251(aname
, knownCtlClasses
[f
].name
)) then
462 result
:= knownCtlClasses
[f
].klass
;
470 // ////////////////////////////////////////////////////////////////////////// //
472 TFlexLayouter
= specialize TFlexLayouterBase
<TUIControl
>;
474 procedure uiLayoutCtl (ctl
: TUIControl
);
478 if (ctl
= nil) then exit
;
479 lay
:= TFlexLayouter
.Create();
484 //writeln('============================'); lay.dumpFlat();
486 //writeln('=== initial ==='); lay.dump();
488 //lay.calcMaxSizeInternal(0);
491 writeln('=== after first pass ===');
495 writeln('=== after second pass ===');
500 //writeln('=== final ==='); lay.dump();
502 if (ctl
.mParent
= nil) and (ctl
is TUITopWindow
) and (TUITopWindow(ctl
).mDoCenter
) then
504 TUITopWindow(ctl
).centerInScreen();
513 // ////////////////////////////////////////////////////////////////////////// //
515 uiTopList
: array of TUIControl
= nil;
518 procedure uiUpdateStyles ();
522 for ctl
in uiTopList
do ctl
.updateStyle();
526 function uiMouseEvent (ev
: THMouseEvent
): Boolean;
532 ev
.x
:= trunc(ev
.x
/gh_ui_scale
);
533 ev
.y
:= trunc(ev
.y
/gh_ui_scale
);
534 ev
.dx
:= trunc(ev
.dx
/gh_ui_scale
); //FIXME
535 ev
.dy
:= trunc(ev
.dy
/gh_ui_scale
); //FIXME
536 if (Length(uiTopList
) = 0) then result
:= false else result
:= uiTopList
[High(uiTopList
)].mouseEvent(ev
);
537 if not result
and (ev
.press
) then
539 for f
:= High(uiTopList
) downto 0 do
541 if uiTopList
[f
].toLocal(ev
.x
, ev
.y
, lx
, ly
) then
544 if uiTopList
[f
].mEnabled
and (f
<> High(uiTopList
)) then
546 uiTopList
[High(uiTopList
)].blurred();
547 ctmp
:= uiTopList
[f
];
549 for c
:= f
+1 to High(uiTopList
) do uiTopList
[c
-1] := uiTopList
[c
];
550 uiTopList
[High(uiTopList
)] := ctmp
;
552 result
:= ctmp
.mouseEvent(ev
);
561 function uiKeyEvent (ev
: THKeyEvent
): Boolean;
563 ev
.x
:= trunc(ev
.x
/gh_ui_scale
);
564 ev
.y
:= trunc(ev
.y
/gh_ui_scale
);
565 if (Length(uiTopList
) = 0) then result
:= false else result
:= uiTopList
[High(uiTopList
)].keyEvent(ev
);
566 if (ev
.release
) then begin result
:= true; exit
; end;
575 glMatrixMode(GL_MODELVIEW
);
579 glScalef(gh_ui_scale
, gh_ui_scale
, 1);
580 for f
:= 0 to High(uiTopList
) do
584 cidx
:= ctl
.getColorIndex
;
585 //if (f <> High(uiTopList)) then darkenRect(ctl.x0, ctl.y0, ctl.width, ctl.height, 128);
586 if (ctl
.mDarken
[cidx
] > 0) then darkenRect(ctl
.x0
, ctl
.y0
, ctl
.width
, ctl
.height
, ctl
.mDarken
[cidx
]);
589 glMatrixMode(GL_MODELVIEW
);
595 procedure uiAddWindow (ctl
: TUIControl
);
599 if (ctl
= nil) then exit
;
601 if not (ctl
is TUITopWindow
) then exit
; // alas
602 for f
:= 0 to High(uiTopList
) do
604 if (uiTopList
[f
] = ctl
) then
606 if (f
<> High(uiTopList
)) then
608 uiTopList
[High(uiTopList
)].blurred();
609 for c
:= f
+1 to High(uiTopList
) do uiTopList
[c
-1] := uiTopList
[c
];
610 uiTopList
[High(uiTopList
)] := ctl
;
616 if (Length(uiTopList
) > 0) then uiTopList
[High(uiTopList
)].blurred();
617 SetLength(uiTopList
, Length(uiTopList
)+1);
618 uiTopList
[High(uiTopList
)] := ctl
;
624 procedure uiRemoveWindow (ctl
: TUIControl
);
628 if (ctl
= nil) then exit
;
630 if not (ctl
is TUITopWindow
) then exit
; // alas
631 for f
:= 0 to High(uiTopList
) do
633 if (uiTopList
[f
] = ctl
) then
636 for c
:= f
+1 to High(uiTopList
) do uiTopList
[c
-1] := uiTopList
[c
];
637 SetLength(uiTopList
, Length(uiTopList
)-1);
638 if (ctl
is TUITopWindow
) then
641 if assigned(TUITopWindow(ctl
).closeCB
) then TUITopWindow(ctl
).closeCB(ctl
, 0);
643 if (TUITopWindow(ctl
).mFreeOnClose
) then FreeAndNil(ctl
);
652 function uiVisibleWindow (ctl
: TUIControl
): Boolean;
657 if (ctl
= nil) then exit
;
659 if not (ctl
is TUITopWindow
) then exit
; // alas
660 for f
:= 0 to High(uiTopList
) do
662 if (uiTopList
[f
] = ctl
) then begin result
:= true; exit
; end;
667 // ////////////////////////////////////////////////////////////////////////// //
668 constructor TUIControl
.Create ();
686 mDrawShadow
:= false;
688 // layouter interface
689 //mDefSize := TLaySize.Create(64, 8); // default size
690 mDefSize
:= TLaySize
.Create(0, 0); // default size
691 mMaxSize
:= TLaySize
.Create(-1, -1); // maximum size
700 mAlign
:= -1; // left/top
705 constructor TUIControl
.Create (ax
, ay
, aw
, ah
: Integer);
715 destructor TUIControl
.Destroy ();
719 if (mParent
<> nil) then
722 for f
:= 0 to High(mParent
.mChildren
) do
724 if (mParent
.mChildren
[f
] = self
) then
726 for c
:= f
+1 to High(mParent
.mChildren
) do mParent
.mChildren
[c
-1] := mParent
.mChildren
[c
];
727 SetLength(mParent
.mChildren
, Length(mParent
.mChildren
)-1);
731 for f
:= 0 to High(mChildren
) do
733 mChildren
[f
].mParent
:= nil;
740 function TUIControl
.getColorIndex (): Integer; inline;
742 if (not mEnabled
) then begin result
:= ClrIdxDisabled
; exit
; end;
743 if (getFocused
) then begin result
:= ClrIdxActive
; exit
; end;
744 result
:= ClrIdxInactive
;
747 procedure TUIControl
.updateStyle ();
753 while (ctl
<> nil) do
755 if (Length(ctl
.mStyleId
) <> 0) then begin stl
:= uiFindStyle(ctl
.mStyleId
); break
; end;
758 if (stl
= nil) then stl
:= uiFindStyle(''); // default
760 for ctl
in mChildren
do ctl
.updateStyle();
763 procedure TUIControl
.cacheStyle (root
: TUIStyle
);
765 cst
: AnsiString = '';
767 //writeln('caching style for <', className, '> (', mCtl4Style, ')...');
768 if (Length(mCtl4Style
) > 0) then
771 if (cst
[1] <> '@') then cst
:= '@'+cst
;
774 mBackColor
[ClrIdxActive
] := root
['back-color'+cst
].asRGBADef(TGxRGBA
.Create(0, 0, 128));
775 mTextColor
[ClrIdxActive
] := root
['text-color'+cst
].asRGBADef(TGxRGBA
.Create(255, 255, 255));
776 mFrameColor
[ClrIdxActive
] := root
['frame-color'+cst
].asRGBADef(TGxRGBA
.Create(255, 255, 255));
777 mFrameTextColor
[ClrIdxActive
] := root
['frame-text-color'+cst
].asRGBADef(TGxRGBA
.Create(255, 255, 255));
778 mFrameIconColor
[ClrIdxActive
] := root
['frame-icon-color'+cst
].asRGBADef(TGxRGBA
.Create(0, 255, 0));
779 mDarken
[ClrIdxActive
] := root
['darken'+cst
].asIntDef(-1);
781 mBackColor
[ClrIdxDisabled
] := root
['back-color#disabled'+cst
].asRGBADef(TGxRGBA
.Create(0, 0, 128));
782 mTextColor
[ClrIdxDisabled
] := root
['text-color#disabled'+cst
].asRGBADef(TGxRGBA
.Create(127, 127, 127));
783 mFrameColor
[ClrIdxDisabled
] := root
['frame-color#disabled'+cst
].asRGBADef(TGxRGBA
.Create(127, 127, 127));
784 mFrameTextColor
[ClrIdxDisabled
] := root
['frame-text-color#disabled'+cst
].asRGBADef(TGxRGBA
.Create(127, 127, 127));
785 mFrameIconColor
[ClrIdxDisabled
] := root
['frame-icon-color#disabled'+cst
].asRGBADef(TGxRGBA
.Create(0, 127, 0));
786 mDarken
[ClrIdxDisabled
] := root
['darken#disabled'+cst
].asIntDef(128);
788 mBackColor
[ClrIdxInactive
] := root
['back-color#inactive'+cst
].asRGBADef(TGxRGBA
.Create(0, 0, 128));
789 mTextColor
[ClrIdxInactive
] := root
['text-color#inactive'+cst
].asRGBADef(TGxRGBA
.Create(255, 255, 255));
790 mFrameColor
[ClrIdxInactive
] := root
['frame-color#inactive'+cst
].asRGBADef(TGxRGBA
.Create(255, 255, 255));
791 mFrameTextColor
[ClrIdxInactive
] := root
['frame-text-color#inactive'+cst
].asRGBADef(TGxRGBA
.Create(255, 255, 255));
792 mFrameIconColor
[ClrIdxInactive
] := root
['frame-icon-color#inactive'+cst
].asRGBADef(TGxRGBA
.Create(0, 255, 0));
793 mDarken
[ClrIdxInactive
] := root
['darken#inactive'+cst
].asIntDef(128);
797 // ////////////////////////////////////////////////////////////////////////// //
798 function TUIControl
.getDefSize (): TLaySize
; inline; begin result
:= mLayDefSize
; end;
799 function TUIControl
.getMaxSize (): TLaySize
; inline; begin result
:= mLayMaxSize
; end;
800 function TUIControl
.getFlex (): Integer; inline; begin result
:= mFlex
; end;
801 function TUIControl
.isHorizBox (): Boolean; inline; begin result
:= mHoriz
; end;
802 procedure TUIControl
.setHorizBox (v
: Boolean); inline; begin mHoriz
:= v
; end;
803 function TUIControl
.canWrap (): Boolean; inline; begin result
:= mCanWrap
; end;
804 procedure TUIControl
.setCanWrap (v
: Boolean); inline; begin mCanWrap
:= v
; end;
805 function TUIControl
.isLineStart (): Boolean; inline; begin result
:= mLineStart
; end;
806 procedure TUIControl
.setLineStart (v
: Boolean); inline; begin mLineStart
:= v
; end;
807 function TUIControl
.getAlign (): Integer; inline; begin result
:= mAlign
; end;
808 procedure TUIControl
.setAlign (v
: Integer); inline; begin mAlign
:= v
; end;
809 function TUIControl
.getExpand (): Boolean; inline; begin result
:= mExpand
; end;
810 procedure TUIControl
.setExpand (v
: Boolean); inline; begin mExpand
:= v
; end;
811 function TUIControl
.getHGroup (): AnsiString; inline; begin result
:= mHGroup
; end;
812 procedure TUIControl
.setHGroup (const v
: AnsiString); inline; begin mHGroup
:= v
; end;
813 function TUIControl
.getVGroup (): AnsiString; inline; begin result
:= mVGroup
; end;
814 procedure TUIControl
.setVGroup (const v
: AnsiString); inline; begin mVGroup
:= v
; end;
816 function TUIControl
.getMargins (): TLayMargins
; inline;
818 result
:= TLayMargins
.Create(mFrameHeight
, mFrameWidth
, mFrameHeight
, mFrameWidth
);
821 procedure TUIControl
.setActualSizePos (constref apos
: TLayPos
; constref asize
: TLaySize
); inline; begin
822 //writeln(self.className, '; pos=', apos.toString, '; size=', asize.toString);
823 if (mParent
<> nil) then
832 procedure TUIControl
.layPrepare ();
834 mLayDefSize
:= mDefSize
;
835 mLayMaxSize
:= mMaxSize
;
836 if (mLayMaxSize
.w
>= 0) then mLayMaxSize
.w
+= mFrameWidth
*2;
837 if (mLayMaxSize
.h
>= 0) then mLayMaxSize
.h
+= mFrameHeight
*2;
841 // ////////////////////////////////////////////////////////////////////////// //
842 function TUIControl
.parsePos (par
: TTextParser
): TLayPos
;
846 if (par
.eatDelim('[')) then ech
:= ']' else par
.expectDelim('(');
847 result
.x
:= par
.expectInt();
848 par
.eatDelim(','); // optional comma
849 result
.y
:= par
.expectInt();
850 par
.eatDelim(','); // optional comma
851 par
.expectDelim(ech
);
854 function TUIControl
.parseSize (par
: TTextParser
): TLaySize
;
858 if (par
.eatDelim('[')) then ech
:= ']' else par
.expectDelim('(');
859 result
.w
:= par
.expectInt();
860 par
.eatDelim(','); // optional comma
861 result
.h
:= par
.expectInt();
862 par
.eatDelim(','); // optional comma
863 par
.expectDelim(ech
);
866 function TUIControl
.parseBool (par
: TTextParser
): Boolean;
869 par
.eatIdOrStrCI('true') or
870 par
.eatIdOrStrCI('yes') or
871 par
.eatIdOrStrCI('tan');
874 if (not par
.eatIdOrStrCI('false')) and (not par
.eatIdOrStrCI('no')) and (not par
.eatIdOrStrCI('ona')) then
876 par
.error('boolean value expected');
881 function TUIControl
.parseAnyAlign (par
: TTextParser
): Integer;
883 if (par
.eatIdOrStrCI('left')) or (par
.eatIdOrStrCI('top')) then result
:= -1
884 else if (par
.eatIdOrStrCI('right')) or (par
.eatIdOrStrCI('bottom')) then result
:= 1
885 else if (par
.eatIdOrStrCI('center')) then result
:= 0
886 else par
.error('invalid align value');
889 function TUIControl
.parseHAlign (par
: TTextParser
): Integer;
891 if (par
.eatIdOrStrCI('left')) then result
:= -1
892 else if (par
.eatIdOrStrCI('right')) then result
:= 1
893 else if (par
.eatIdOrStrCI('center')) then result
:= 0
894 else par
.error('invalid horizontal align value');
897 function TUIControl
.parseVAlign (par
: TTextParser
): Integer;
899 if (par
.eatIdOrStrCI('top')) then result
:= -1
900 else if (par
.eatIdOrStrCI('bottom')) then result
:= 1
901 else if (par
.eatIdOrStrCI('center')) then result
:= 0
902 else par
.error('invalid vertical align value');
905 procedure TUIControl
.parseTextAlign (par
: TTextParser
; var h
, v
: Integer);
907 wasH
: Boolean = false;
908 wasV
: Boolean = false;
912 if (par
.eatIdOrStrCI('left')) then
914 if wasH
then par
.error('too many align directives');
919 if (par
.eatIdOrStrCI('right')) then
921 if wasH
then par
.error('too many align directives');
926 if (par
.eatIdOrStrCI('hcenter')) then
928 if wasH
then par
.error('too many align directives');
933 if (par
.eatIdOrStrCI('top')) then
935 if wasV
then par
.error('too many align directives');
940 if (par
.eatIdOrStrCI('bottom')) then
942 if wasV
then par
.error('too many align directives');
947 if (par
.eatIdOrStrCI('vcenter')) then
949 if wasV
then par
.error('too many align directives');
954 if (par
.eatIdOrStrCI('center')) then
956 if wasV
or wasH
then par
.error('too many align directives');
965 if not wasV
and not wasH
then par
.error('invalid align value');
968 function TUIControl
.parseOrientation (const prname
: AnsiString; par
: TTextParser
): Boolean;
970 if (strEquCI1251(prname
, 'orientation')) or (strEquCI1251(prname
, 'orient')) then
972 if (par
.eatIdOrStrCI('horizontal')) or (par
.eatIdOrStrCI('horiz')) then mHoriz
:= true
973 else if (par
.eatIdOrStrCI('vertical')) or (par
.eatIdOrStrCI('vert')) then mHoriz
:= false
974 else par
.error('`horizontal` or `vertical` expected');
983 // par should be on '{'; final '}' is eaten
984 procedure TUIControl
.parseProperties (par
: TTextParser
);
988 if (not par
.eatDelim('{')) then exit
;
989 while (not par
.eatDelim('}')) do
991 if (not par
.isIdOrStr
) then par
.error('property name expected');
994 par
.eatDelim(':'); // optional
995 if not parseProperty(pn
, par
) then par
.errorfmt('invalid property name ''%s''', [pn
]);
996 par
.eatDelim(','); // optional
1000 // par should be on '{'
1001 procedure TUIControl
.parseChildren (par
: TTextParser
);
1003 cc
: TUIControlClass
;
1006 par
.expectDelim('{');
1007 while (not par
.eatDelim('}')) do
1009 if (not par
.isIdOrStr
) then par
.error('control name expected');
1010 cc
:= findCtlClass(par
.tokStr
);
1011 if (cc
= nil) then par
.errorfmt('unknown control name: ''%s''', [par
.tokStr
]);
1012 //writeln('children for <', par.tokStr, '>: <', cc.className, '>');
1014 par
.eatDelim(':'); // optional
1016 //writeln(' mHoriz=', ctl.mHoriz);
1018 ctl
.parseProperties(par
);
1023 //writeln(': ', ctl.mDefSize.toString);
1025 par
.eatDelim(','); // optional
1030 function TUIControl
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
1033 if (strEquCI1251(prname
, 'id')) then begin mId
:= par
.expectIdOrStr(true); exit
; end; // allow empty strings
1034 if (strEquCI1251(prname
, 'style')) then begin mStyleId
:= par
.expectIdOrStr(); exit
; end; // no empty strings
1035 if (strEquCI1251(prname
, 'flex')) then begin flex
:= par
.expectInt(); exit
; end;
1037 if (strEquCI1251(prname
, 'defsize')) or (strEquCI1251(prname
, 'size')) then begin mDefSize
:= parseSize(par
); exit
; end;
1038 if (strEquCI1251(prname
, 'maxsize')) then begin mMaxSize
:= parseSize(par
); exit
; end;
1039 if (strEquCI1251(prname
, 'defwidth')) or (strEquCI1251(prname
, 'width')) then begin mDefSize
.w
:= par
.expectInt(); exit
; end;
1040 if (strEquCI1251(prname
, 'defheight')) or (strEquCI1251(prname
, 'height')) then begin mDefSize
.h
:= par
.expectInt(); exit
; end;
1041 if (strEquCI1251(prname
, 'maxwidth')) then begin mMaxSize
.w
:= par
.expectInt(); exit
; end;
1042 if (strEquCI1251(prname
, 'maxheight')) then begin mMaxSize
.h
:= par
.expectInt(); exit
; end;
1044 if (strEquCI1251(prname
, 'wrap')) then begin mCanWrap
:= parseBool(par
); exit
; end;
1045 if (strEquCI1251(prname
, 'linestart')) then begin mLineStart
:= parseBool(par
); exit
; end;
1046 if (strEquCI1251(prname
, 'expand')) then begin mExpand
:= parseBool(par
); exit
; end;
1048 if (strEquCI1251(prname
, 'align')) then begin mAlign
:= parseAnyAlign(par
); exit
; end;
1049 if (strEquCI1251(prname
, 'hgroup')) then begin mHGroup
:= par
.expectIdOrStr(true); exit
; end; // allow empty strings
1050 if (strEquCI1251(prname
, 'vgroup')) then begin mVGroup
:= par
.expectIdOrStr(true); exit
; end; // allow empty strings
1052 if (strEquCI1251(prname
, 'canfocus')) then begin mCanFocus
:= parseBool(par
); exit
; end;
1053 if (strEquCI1251(prname
, 'enabled')) then begin mEnabled
:= parseBool(par
); exit
; end;
1054 if (strEquCI1251(prname
, 'disabled')) then begin mEnabled
:= not parseBool(par
); exit
; end;
1055 if (strEquCI1251(prname
, 'escclose')) then begin mEscClose
:= not parseBool(par
); exit
; end;
1056 if (strEquCI1251(prname
, 'eatkeys')) then begin mEatKeys
:= not parseBool(par
); exit
; end;
1061 // ////////////////////////////////////////////////////////////////////////// //
1062 procedure TUIControl
.activated ();
1067 procedure TUIControl
.blurred ();
1073 function TUIControl
.topLevel (): TUIControl
; inline;
1076 while (result
.mParent
<> nil) do result
:= result
.mParent
;
1080 function TUIControl
.getEnabled (): Boolean;
1085 if (not mEnabled
) or (mWidth
< 1) or (mHeight
< 1) then exit
;
1087 while (ctl
<> nil) do
1089 if (not ctl
.mEnabled
) or (ctl
.mWidth
< 1) or (ctl
.mHeight
< 1) then exit
;
1096 procedure TUIControl
.setEnabled (v
: Boolean); inline;
1098 if (mEnabled
= v
) then exit
;
1100 if not v
and focused
then setFocused(false);
1104 function TUIControl
.getFocused (): Boolean; inline;
1106 if (mParent
= nil) then
1108 result
:= (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)] = self
);
1112 result
:= (topLevel
.mFocused
= self
);
1113 if (result
) then result
:= (Length(uiTopList
) > 0) and (uiTopList
[High(uiTopList
)] = topLevel
);
1118 procedure TUIControl
.setFocused (v
: Boolean); inline;
1125 if (tl
.mFocused
= self
) then
1128 tl
.mFocused
:= tl
.findNextFocus(self
);
1129 if (tl
.mFocused
= self
) then tl
.mFocused
:= nil;
1133 if (not mEnabled
) or (not mCanFocus
) then exit
;
1134 if (tl
.mFocused
<> self
) then
1136 if (tl
.mFocused
<> nil) then tl
.mFocused
.blurred();
1137 tl
.mFocused
:= self
;
1138 if (tl
.mGrab
<> self
) then tl
.mGrab
:= nil;
1144 function TUIControl
.isMyChild (ctl
: TUIControl
): Boolean;
1147 while (ctl
<> nil) do
1149 if (ctl
.mParent
= self
) then exit
;
1156 // returns `true` if global coords are inside this control
1157 function TUIControl
.toLocal (var x
, y
: Integer): Boolean;
1162 while (ctl
<> nil) do
1168 result
:= (x
>= 0) and (y
>= 0) and (x
< mWidth
) and (y
< mHeight
);
1171 function TUIControl
.toLocal (gx
, gy
: Integer; out x
, y
: Integer): Boolean; inline;
1175 result
:= toLocal(x
, y
);
1178 procedure TUIControl
.toGlobal (var x
, y
: Integer);
1183 while (ctl
<> nil) do
1191 procedure TUIControl
.toGlobal (lx
, ly
: Integer; out x
, y
: Integer); inline;
1199 // x and y are global coords
1200 function TUIControl
.controlAtXY (x
, y
: Integer): TUIControl
;
1206 if (not mEnabled
) or (mWidth
< 1) or (mHeight
< 1) then exit
;
1207 if not toLocal(x
, y
, lx
, ly
) then exit
;
1208 for f
:= High(mChildren
) downto 0 do
1210 result
:= mChildren
[f
].controlAtXY(x
, y
);
1211 if (result
<> nil) then exit
;
1217 function TUIControl
.prevSibling (): TUIControl
;
1221 if (mParent
<> nil) then
1223 for f
:= 1 to High(mParent
.mChildren
) do
1225 if (mParent
.mChildren
[f
] = self
) then begin result
:= mParent
.mChildren
[f
-1]; exit
; end;
1231 function TUIControl
.nextSibling (): TUIControl
;
1235 if (mParent
<> nil) then
1237 for f
:= 0 to High(mParent
.mChildren
)-1 do
1239 if (mParent
.mChildren
[f
] = self
) then begin result
:= mParent
.mChildren
[f
+1]; exit
; end;
1245 function TUIControl
.firstChild (): TUIControl
; inline;
1247 if (Length(mChildren
) <> 0) then result
:= mChildren
[0] else result
:= nil;
1250 function TUIControl
.lastChild (): TUIControl
; inline;
1252 if (Length(mChildren
) <> 0) then result
:= mChildren
[High(mChildren
)] else result
:= nil;
1256 function TUIControl
.findFirstFocus (): TUIControl
;
1263 for f
:= 0 to High(mChildren
) do
1265 result
:= mChildren
[f
].findFirstFocus();
1266 if (result
<> nil) then exit
;
1268 if mCanFocus
then result
:= self
;
1273 function TUIControl
.findLastFocus (): TUIControl
;
1280 for f
:= High(mChildren
) downto 0 do
1282 result
:= mChildren
[f
].findLastFocus();
1283 if (result
<> nil) then exit
;
1285 if mCanFocus
then result
:= self
;
1290 function TUIControl
.findNextFocus (cur
: TUIControl
): TUIControl
;
1295 if not isMyChild(cur
) then cur
:= nil;
1296 if (cur
= nil) then begin result
:= findFirstFocus(); exit
; end;
1297 result
:= cur
.findFirstFocus();
1298 if (result
<> nil) and (result
<> cur
) then exit
;
1301 cur
:= cur
.nextSibling
;
1302 if (cur
= nil) then break
;
1303 result
:= cur
.findFirstFocus();
1304 if (result
<> nil) then exit
;
1306 result
:= findFirstFocus();
1311 function TUIControl
.findPrevFocus (cur
: TUIControl
): TUIControl
;
1316 if not isMyChild(cur
) then cur
:= nil;
1317 if (cur
= nil) then begin result
:= findLastFocus(); exit
; end;
1319 result
:= cur
.findLastFocus();
1320 if (result
<> nil) and (result
<> cur
) then exit
;
1323 cur
:= cur
.prevSibling
;
1324 if (cur
= nil) then break
;
1325 result
:= cur
.findLastFocus();
1326 if (result
<> nil) then exit
;
1328 result
:= findLastFocus();
1333 procedure TUIControl
.appendChild (ctl
: TUIControl
);
1335 if (ctl
= nil) then exit
;
1336 if (ctl
.mParent
<> nil) then exit
;
1337 SetLength(mChildren
, Length(mChildren
)+1);
1338 mChildren
[High(mChildren
)] := ctl
;
1339 ctl
.mParent
:= self
;
1340 Inc(ctl
.mX
, mFrameWidth
);
1341 Inc(ctl
.mY
, mFrameHeight
);
1342 if (ctl
.mWidth
> 0) and (ctl
.mHeight
> 0) and
1343 (ctl
.mX
+ctl
.mWidth
> mFrameWidth
) and (ctl
.mY
+ctl
.mHeight
> mFrameHeight
) then
1345 if (mWidth
+mFrameWidth
< ctl
.mX
+ctl
.mWidth
) then mWidth
:= ctl
.mX
+ctl
.mWidth
+mFrameWidth
;
1346 if (mHeight
+mFrameHeight
< ctl
.mY
+ctl
.mHeight
) then mHeight
:= ctl
.mY
+ctl
.mHeight
+mFrameHeight
;
1348 //if (mFocused = nil) and ctl.mEnabled and ctl.mCanFocus and (ctl.mWidth > 0) and (ctl.mHeight > 0) then mFocused := ctl;
1352 // ////////////////////////////////////////////////////////////////////////// //
1353 procedure TUIControl
.setScissorGLInternal (x
, y
, w
, h
: Integer);
1355 if not scallowed
then exit
;
1356 x
:= trunc(x
*gh_ui_scale
);
1357 y
:= trunc(y
*gh_ui_scale
);
1358 w
:= trunc(w
*gh_ui_scale
);
1359 h
:= trunc(h
*gh_ui_scale
);
1360 scis
.combineRect(x
, y
, w
, h
);
1363 procedure TUIControl
.setScissor (lx
, ly
, lw
, lh
: Integer);
1366 //ox, oy, ow, oh: Integer;
1368 if not scallowed
then exit
;
1369 //ox := lx; oy := ly; ow := lw; oh := lh;
1370 if not intersectRect(lx
, ly
, lw
, lh
, 0, 0, mWidth
, mHeight
) then
1372 //writeln('oops: <', self.className, '>: old=(', ox, ',', oy, ')-[', ow, ',', oh, ']');
1373 glScissor(0, 0, 0, 0);
1376 toGlobal(lx
, ly
, gx
, gy
);
1377 setScissorGLInternal(gx
, gy
, lw
, lh
);
1380 procedure TUIControl
.resetScissor (fullArea
: Boolean); inline;
1382 if not scallowed
then exit
;
1385 setScissor(0, 0, mWidth
, mHeight
);
1389 setScissor(mFrameWidth
, mFrameHeight
, mWidth
-mFrameWidth
*2, mHeight
-mFrameHeight
*2);
1394 // ////////////////////////////////////////////////////////////////////////// //
1395 procedure TUIControl
.draw ();
1400 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1401 toGlobal(0, 0, gx
, gy
);
1402 //conwritefln('[%s]: (%d,%d)-(%d,%d) (%d,%d)', [ClassName, mX, mY, mWidth, mHeight, x, y]);
1404 scis
.save(true); // scissoring enabled
1407 resetScissor(true); // full area
1408 drawControl(gx
, gy
);
1409 resetScissor(false); // client area
1410 for f
:= 0 to High(mChildren
) do mChildren
[f
].draw();
1411 resetScissor(true); // full area
1412 drawControlPost(gx
, gy
);
1419 procedure TUIControl
.drawControl (gx
, gy
: Integer);
1421 //if (mParent = nil) then darkenRect(gx, gy, mWidth, mHeight, 64);
1424 procedure TUIControl
.drawControlPost (gx
, gy
: Integer);
1427 if mDrawShadow
and (mWidth
> 0) and (mHeight
> 0) then
1429 setScissorGLInternal(gx
+8, gy
+8, mWidth
, mHeight
);
1430 darkenRect(gx
+mWidth
, gy
+8, 8, mHeight
, 128);
1431 darkenRect(gx
+8, gy
+mHeight
, mWidth
-8, 8, 128);
1436 // ////////////////////////////////////////////////////////////////////////// //
1437 function TUIControl
.mouseEvent (var ev
: THMouseEvent
): Boolean;
1442 if not mEnabled
then exit
;
1443 if (mParent
= nil) then
1445 if (mGrab
<> nil) then
1447 result
:= mGrab
.mouseEvent(ev
);
1448 if (ev
.release
) then mGrab
:= nil;
1452 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1453 ctl
:= controlAtXY(ev
.x
, ev
.y
);
1454 if (ctl
<> nil) and (ctl
<> self
) then
1456 if (ctl
<> topLevel
.mFocused
) then ctl
.setFocused(true);
1457 result
:= ctl
.mouseEvent(ev
);
1459 else if (ctl
= self
) and assigned(actionCB
) then
1466 function TUIControl
.keyEvent (var ev
: THKeyEvent
): Boolean;
1471 if not mEnabled
then exit
;
1472 if (topLevel
.mFocused
<> self
) and isMyChild(topLevel
.mFocused
) and topLevel
.mFocused
.mEnabled
then result
:= topLevel
.mFocused
.keyEvent(ev
);
1473 if (mParent
= nil) then
1475 if (ev
= 'S-Tab') then
1478 ctl
:= findPrevFocus(mFocused
);
1479 if (ctl
<> mFocused
) then
1486 if (ev
= 'Tab') then
1489 ctl
:= findNextFocus(mFocused
);
1490 if (ctl
<> mFocused
) then
1497 if mEscClose
and (ev
= 'Escape') then
1500 uiRemoveWindow(self
);
1504 if mEatKeys
then result
:= true;
1508 // ////////////////////////////////////////////////////////////////////////// //
1509 constructor TUITopWindow
.Create (const atitle
: AnsiString; ax
, ay
: Integer; aw
: Integer=-1; ah
: Integer=-1);
1511 inherited Create(ax
, ay
, aw
, ah
);
1517 procedure TUITopWindow
.AfterConstruction ();
1519 inherited AfterConstruction();
1520 if (mWidth
< mFrameWidth
*2+3*8) then mWidth
:= mFrameWidth
*2+3*8;
1521 if (mHeight
< mFrameHeight
*2) then mHeight
:= mFrameHeight
*2;
1522 if (Length(mTitle
) > 0) then
1524 if (mWidth
< Length(mTitle
)*8+mFrameWidth
*2+3*8) then mWidth
:= Length(mTitle
)*8+mFrameWidth
*2+3*8;
1527 mDrawShadow
:= true;
1528 mWaitingClose
:= false;
1535 function TUITopWindow
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
1537 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) then
1539 mTitle
:= par
.expectIdOrStr(true);
1543 if (strEquCI1251(prname
, 'children')) then
1549 if (strEquCI1251(prname
, 'position')) then
1551 if (par
.eatIdOrStrCI('default')) then mDoCenter
:= false
1552 else if (par
.eatIdOrStrCI('center')) then mDoCenter
:= true
1553 else par
.error('`center` or `default` expected');
1557 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
1558 result
:= inherited parseProperty(prname
, par
);
1562 procedure TUITopWindow
.cacheStyle (root
: TUIStyle
);
1564 inherited cacheStyle(root
);
1568 procedure TUITopWindow
.centerInScreen ();
1570 if (mWidth
> 0) and (mHeight
> 0) then
1572 mX
:= trunc((gScrWidth
/gh_ui_scale
-mWidth
)/2);
1573 mY
:= trunc((gScrHeight
/gh_ui_scale
-mHeight
)/2);
1578 procedure TUITopWindow
.drawControl (gx
, gy
: Integer);
1580 fillRect(gx
, gy
, mWidth
, mHeight
, mBackColor
[getColorIndex
]);
1584 procedure TUITopWindow
.drawControlPost (gx
, gy
: Integer);
1589 cidx
:= getColorIndex
;
1592 drawRectUI(mX
+4, mY
+4, mWidth
-8, mHeight
-8, mFrameColor
[cidx
]);
1596 drawRectUI(mX
+3, mY
+3, mWidth
-6, mHeight
-6, mFrameColor
[cidx
]);
1597 drawRectUI(mX
+5, mY
+5, mWidth
-10, mHeight
-10, mFrameColor
[cidx
]);
1598 setScissor(mFrameWidth
, 0, 3*8, 8);
1599 fillRect(mX
+mFrameWidth
, mY
, 3*8, 8, mBackColor
[cidx
]);
1600 drawText8(mX
+mFrameWidth
, mY
, '[ ]', mFrameColor
[cidx
]);
1601 if mInClose
then drawText8(mX
+mFrameWidth
+7, mY
, '#', mFrameIconColor
[cidx
])
1602 else drawText8(mX
+mFrameWidth
+7, mY
, '*', mFrameIconColor
[cidx
]);
1604 if (Length(mTitle
) > 0) then
1606 setScissor(mFrameWidth
+3*8, 0, mWidth
-mFrameWidth
*2-3*8, 8);
1607 tx
:= (mX
+3*8)+((mWidth
-3*8)-Length(mTitle
)*8) div 2;
1608 fillRect(tx
-3, mY
, Length(mTitle
)*8+3+2, 8, mBackColor
[cidx
]);
1609 drawText8(tx
, mY
, mTitle
, mFrameTextColor
[cidx
]);
1611 inherited drawControlPost(gx
, gy
);
1615 procedure TUITopWindow
.activated ();
1617 if (mFocused
= nil) or (mFocused
= self
) then
1619 mFocused
:= findFirstFocus();
1620 if (mFocused
<> nil) and (mFocused
<> self
) then mFocused
.activated();
1626 procedure TUITopWindow
.blurred ();
1629 mWaitingClose
:= false;
1635 function TUITopWindow
.keyEvent (var ev
: THKeyEvent
): Boolean;
1637 result
:= inherited keyEvent(ev
);
1638 if not getFocused
then exit
;
1639 if (ev
= 'M-F3') then
1641 uiRemoveWindow(self
);
1648 function TUITopWindow
.mouseEvent (var ev
: THMouseEvent
): Boolean;
1653 if not mEnabled
then exit
;
1654 if (mWidth
< 1) or (mHeight
< 1) then exit
;
1658 mX
+= ev
.x
-mDragStartX
;
1659 mY
+= ev
.y
-mDragStartY
;
1660 mDragStartX
:= ev
.x
;
1661 mDragStartY
:= ev
.y
;
1662 if (ev
.release
) then mDragging
:= false;
1667 if toLocal(ev
.x
, ev
.y
, lx
, ly
) then
1673 if (lx
>= mFrameWidth
) and (lx
< mFrameWidth
+3*8) then
1675 //uiRemoveWindow(self);
1676 mWaitingClose
:= true;
1682 mDragStartX
:= ev
.x
;
1683 mDragStartY
:= ev
.y
;
1688 if (lx
< mFrameWidth
) or (lx
>= mWidth
-mFrameWidth
) or (ly
>= mHeight
-mFrameHeight
) then
1691 mDragStartX
:= ev
.x
;
1692 mDragStartY
:= ev
.y
;
1698 if (ev
.release
) then
1700 if mWaitingClose
and (lx
>= mFrameWidth
) and (lx
< mFrameWidth
+3*8) then
1702 uiRemoveWindow(self
);
1706 mWaitingClose
:= false;
1712 if mWaitingClose
then
1714 mInClose
:= (lx
>= mFrameWidth
) and (lx
< mFrameWidth
+3*8);
1723 if (not ev
.motion
) then mWaitingClose
:= false;
1726 result
:= inherited mouseEvent(ev
);
1730 // ////////////////////////////////////////////////////////////////////////// //
1731 constructor TUISimpleText
.Create (ax
, ay
: Integer);
1734 inherited Create(ax
, ay
, 4, 4);
1738 destructor TUISimpleText
.Destroy ();
1745 procedure TUISimpleText
.appendItem (const atext
: AnsiString; acentered
: Boolean=false; ahline
: Boolean=false);
1749 if (Length(atext
)*8+3*8+2 > mWidth
) then mWidth
:= Length(atext
)*8+3*8+2;
1750 SetLength(mItems
, Length(mItems
)+1);
1751 it
:= @mItems
[High(mItems
)];
1753 it
.centered
:= acentered
;
1755 if (Length(mItems
)*8 > mHeight
) then mHeight
:= Length(mItems
)*8;
1759 procedure TUISimpleText
.drawControl (gx
, gy
: Integer);
1765 for f
:= 0 to High(mItems
) do
1772 if it
.centered
then begin b
:= 255; tx
:= gx
+(mWidth
-Length(it
.title
)*8) div 2; end;
1776 if (Length(it
.title
) = 0) then
1778 drawHLine(gx
+4, gy
+3, mWidth
-8, TGxRGBA
.Create(r
, g
, b
));
1780 else if (tx
-3 > gx
+4) then
1782 drawHLine(gx
+4, gy
+3, tx
-3-(gx
+3), TGxRGBA
.Create(r
, g
, b
));
1783 drawHLine(tx
+Length(it
.title
)*8, gy
+3, mWidth
-4, TGxRGBA
.Create(r
, g
, b
));
1786 drawText8(tx
, gy
, it
.title
, TGxRGBA
.Create(r
, g
, b
));
1792 function TUISimpleText
.mouseEvent (var ev
: THMouseEvent
): Boolean;
1796 result
:= inherited mouseEvent(ev
);
1797 if not result
and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
1804 function TUISimpleText
.keyEvent (var ev
: THKeyEvent
): Boolean;
1806 result
:= inherited keyEvent(ev
);
1810 // ////////////////////////////////////////////////////////////////////////// //
1811 constructor TUICBListBox
.Create (ax
, ay
: Integer);
1815 inherited Create(ax
, ay
, 4, 4);
1819 destructor TUICBListBox
.Destroy ();
1826 procedure TUICBListBox
.appendItem (const atext
: AnsiString; bv
: PBoolean; aaction
: TActionCB
=nil);
1830 if (Length(atext
)*8+3*8+2 > mWidth
) then mWidth
:= Length(atext
)*8+3*8+2;
1831 SetLength(mItems
, Length(mItems
)+1);
1832 it
:= @mItems
[High(mItems
)];
1835 it
.actionCB
:= aaction
;
1836 if (Length(mItems
)*8 > mHeight
) then mHeight
:= Length(mItems
)*8;
1837 if (mCurIndex
< 0) then mCurIndex
:= 0;
1841 procedure TUICBListBox
.drawControl (gx
, gy
: Integer);
1846 for f
:= 0 to High(mItems
) do
1849 if (mCurIndex
= f
) then fillRect(gx
, gy
, mWidth
, 8, TGxRGBA
.Create(0, 128, 0));
1850 if (it
.varp
<> nil) then
1852 if it
.varp
^ then drawText8(gx
, gy
, '[x]', TGxRGBA
.Create(255, 255, 255)) else drawText8(gx
, gy
, '[ ]', TGxRGBA
.Create(255, 255, 255));
1853 drawText8(gx
+3*8+2, gy
, it
.title
, TGxRGBA
.Create(255, 255, 0));
1855 else if (Length(it
.title
) > 0) then
1857 tx
:= gx
+(mWidth
-Length(it
.title
)*8) div 2;
1858 if (tx
-3 > gx
+4) then
1860 drawHLine(gx
+4, gy
+3, tx
-3-(gx
+3), TGxRGBA
.Create(255, 255, 255));
1861 drawHLine(tx
+Length(it
.title
)*8, gy
+3, mWidth
-4, TGxRGBA
.Create(255, 255, 255));
1863 drawText8(tx
, gy
, it
.title
, TGxRGBA
.Create(255, 255, 255));
1867 drawHLine(gx
+4, gy
+3, mWidth
-8, TGxRGBA
.Create(255, 255, 255));
1874 function TUICBListBox
.mouseEvent (var ev
: THMouseEvent
): Boolean;
1879 result
:= inherited mouseEvent(ev
);
1880 if not result
and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
1883 if (ev
= 'lmb') then
1886 if (ly
>= 0) and (ly
< Length(mItems
)) then
1889 if (it
.varp
<> nil) then
1892 it
.varp
^ := not it
.varp
^;
1893 if assigned(it
.actionCB
) then it
.actionCB(self
, Integer(it
.varp
^));
1894 if assigned(actionCB
) then actionCB(self
, ly
);
1902 function TUICBListBox
.keyEvent (var ev
: THKeyEvent
): Boolean;
1906 result
:= inherited keyEvent(ev
);
1907 if not getFocused
then exit
;
1909 if (ev
= 'Home') or (ev
= 'PageUp') then
1914 if (ev
= 'End') or (ev
= 'PageDown') then
1917 mCurIndex
:= High(mItems
);
1922 if (Length(mItems
) > 0) then
1924 if (mCurIndex
< 0) then mCurIndex
:= Length(mItems
);
1925 while (mCurIndex
> 0) do
1928 if (mItems
[mCurIndex
].varp
<> nil) then break
;
1936 if (ev
= 'Down') then
1939 if (Length(mItems
) > 0) then
1941 if (mCurIndex
< 0) then mCurIndex
:= -1;
1942 while (mCurIndex
< High(mItems
)) do
1945 if (mItems
[mCurIndex
].varp
<> nil) then break
;
1953 if (ev
= 'Space') or (ev
= 'Enter') then
1956 if (mCurIndex
>= 0) and (mCurIndex
< Length(mItems
)) and (mItems
[mCurIndex
].varp
<> nil) then
1958 it
:= @mItems
[mCurIndex
];
1959 it
.varp
^ := not it
.varp
^;
1960 if assigned(it
.actionCB
) then it
.actionCB(self
, Integer(it
.varp
^));
1961 if assigned(actionCB
) then actionCB(self
, mCurIndex
);
1967 // ////////////////////////////////////////////////////////////////////////// //
1968 constructor TUIBox
.Create (ahoriz
: Boolean);
1975 procedure TUIBox
.AfterConstruction ();
1977 inherited AfterConstruction();
1979 mCtl4Style
:= 'box';
1983 function TUIBox
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
1985 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
1986 if (strEquCI1251(prname
, 'frame')) then
1988 mHasFrame
:= parseBool(par
);
1989 if (mHasFrame
) then begin mFrameWidth
:= 8; mFrameHeight
:= 8; end else begin mFrameWidth
:= 0; mFrameHeight
:= 0; end;
1993 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) then
1995 mCaption
:= par
.expectIdOrStr(true);
1996 mDefSize
:= TLaySize
.Create(Length(mCaption
)*8+3, 8);
2000 if (strEquCI1251(prname
, 'children')) then
2006 result
:= inherited parseProperty(prname
, par
);
2010 procedure TUIBox
.drawControl (gx
, gy
: Integer);
2015 cidx
:= getColorIndex
;
2016 fillRect(gx
, gy
, mWidth
, mHeight
, mBackColor
[cidx
]);
2020 drawRectUI(gx
+3, gy
+3, mWidth
-6, mHeight
-6, mFrameColor
[cidx
]);
2023 if (Length(mCaption
) > 0) then
2025 setScissor(mFrameWidth
+1, 0, mWidth
-mFrameWidth
-2, 8);
2026 tx
:= gx
+((mWidth
-Length(mCaption
)*8) div 2);
2027 if mHasFrame
then fillRect(tx
-2, gy
, Length(mCaption
)*8+3, 8, mBackColor
[cidx
]);
2028 drawText8(tx
, gy
, mCaption
, mFrameTextColor
[cidx
]);
2033 function TUIBox
.mouseEvent (var ev
: THMouseEvent
): Boolean;
2037 result
:= inherited mouseEvent(ev
);
2038 if not result
and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
2045 //TODO: navigation with arrow keys, according to box orientation
2046 function TUIBox
.keyEvent (var ev
: THKeyEvent
): Boolean;
2048 result
:= inherited keyEvent(ev
);
2052 // ////////////////////////////////////////////////////////////////////////// //
2053 procedure TUIHBox
.AfterConstruction ();
2055 inherited AfterConstruction();
2060 // ////////////////////////////////////////////////////////////////////////// //
2061 procedure TUIVBox
.AfterConstruction ();
2063 inherited AfterConstruction();
2068 // ////////////////////////////////////////////////////////////////////////// //
2069 procedure TUISpan
.AfterConstruction ();
2071 inherited AfterConstruction();
2074 mCtl4Style
:= 'span';
2078 function TUISpan
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2080 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
2081 result
:= inherited parseProperty(prname
, par
);
2085 procedure TUISpan
.drawControl (gx
, gy
: Integer);
2090 // ////////////////////////////////////////////////////////////////////// //
2091 procedure TUILine
.AfterConstruction ();
2093 inherited AfterConstruction();
2096 mCtl4Style
:= 'line';
2100 function TUILine
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2102 if (parseOrientation(prname
, par
)) then begin result
:= true; exit
; end;
2103 result
:= inherited parseProperty(prname
, par
);
2107 procedure TUILine
.drawControl (gx
, gy
: Integer);
2111 cidx
:= getColorIndex
;
2114 drawHLine(gx
, gy
+(mHeight
div 2), mWidth
, mTextColor
[cidx
]);
2118 drawVLine(gx
+(mWidth
div 2), gy
, mHeight
, mTextColor
[cidx
]);
2123 // ////////////////////////////////////////////////////////////////////////// //
2124 procedure TUIHLine
.AfterConstruction ();
2126 inherited AfterConstruction();
2132 // ////////////////////////////////////////////////////////////////////////// //
2133 procedure TUIVLine
.AfterConstruction ();
2135 inherited AfterConstruction();
2141 // ////////////////////////////////////////////////////////////////////////// //
2142 constructor TUITextLabel
.Create (const atext
: AnsiString);
2146 mDefSize
:= TLaySize
.Create(Length(atext
)*8, 8);
2150 procedure TUITextLabel
.AfterConstruction ();
2152 inherited AfterConstruction();
2156 if (mDefSize
.h
<= 0) then mDefSize
.h
:= 8;
2157 mCtl4Style
:= 'label';
2161 function TUITextLabel
.parseProperty (const prname
: AnsiString; par
: TTextParser
): Boolean;
2163 if (strEquCI1251(prname
, 'title')) or (strEquCI1251(prname
, 'caption')) then
2165 mText
:= par
.expectIdOrStr(true);
2166 mDefSize
:= TLaySize
.Create(Length(mText
)*8, 8);
2170 if (strEquCI1251(prname
, 'textalign')) then
2172 parseTextAlign(par
, mHAlign
, mVAlign
);
2176 result
:= inherited parseProperty(prname
, par
);
2180 procedure TUITextLabel
.drawControl (gx
, gy
: Integer);
2182 xpos
, ypos
: Integer;
2185 cidx
:= getColorIndex
;
2186 fillRect(gx
, gy
, mWidth
, mHeight
, mBackColor
[cidx
]);
2187 if (Length(mText
) > 0) then
2189 if (mHAlign
< 0) then xpos
:= 0
2190 else if (mHAlign
> 0) then xpos
:= mWidth
-Length(mText
)*8
2191 else xpos
:= (mWidth
-Length(mText
)*8) div 2;
2193 if (mVAlign
< 0) then ypos
:= 0
2194 else if (mVAlign
> 0) then ypos
:= mHeight
-8
2195 else ypos
:= (mHeight
-8) div 2;
2197 drawText8(gx
+xpos
, gy
+ypos
, mText
, mTextColor
[cidx
]);
2202 function TUITextLabel
.mouseEvent (var ev
: THMouseEvent
): Boolean;
2206 result
:= inherited mouseEvent(ev
);
2207 if not result
and toLocal(ev
.x
, ev
.y
, lx
, ly
) then
2214 function TUITextLabel
.keyEvent (var ev
: THKeyEvent
): Boolean;
2216 result
:= inherited keyEvent(ev
);
2221 registerCtlClass(TUIHBox
, 'hbox');
2222 registerCtlClass(TUIVBox
, 'vbox');
2223 registerCtlClass(TUISpan
, 'span');
2224 registerCtlClass(TUIHLine
, 'hline');
2225 registerCtlClass(TUIVLine
, 'vline');
2226 registerCtlClass(TUITextLabel
, 'label');