DEADSOFTWARE

Merge branch 'master' of ssh://repo.or.cz/d2df-sdl
[d2df-sdl.git] / src / flexui / fui_ctls.pas
1 (* coded by Ketmar // Invisible Vector <ketmar@ketmar.no-ip.org>
2 * Understanding is not required. Only obedience.
3 *
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.
8 *
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.
13 *
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/>.
16 *)
17 {$INCLUDE ../shared/a_modes.inc}
18 {$M+}
19 unit fui_ctls;
21 interface
23 uses
24 SysUtils, Classes,
25 SDL2,
26 sdlcarcass,
27 fui_common, fui_events, fui_style,
28 fui_gfx_gl,
29 xparser;
32 // ////////////////////////////////////////////////////////////////////////// //
33 type
34 TUIControlClass = class of TUIControl;
36 TUIControl = class
37 public
38 type TActionCB = procedure (me: TUIControl);
39 type TCloseRequestCB = function (me: TUIControl): Boolean; // top-level windows will call this before closing with icon/keyboard
41 // return `true` to stop
42 type TCtlEnumCB = function (ctl: TUIControl): Boolean is nested;
44 public
45 const ClrIdxActive = 0;
46 const ClrIdxDisabled = 1;
47 const ClrIdxInactive = 2;
48 const ClrIdxMax = 2;
50 private
51 mParent: TUIControl;
52 mId: AnsiString;
53 mStyleId: AnsiString;
54 mX, mY: Integer;
55 mWidth, mHeight: Integer;
56 mFrameWidth, mFrameHeight: Integer;
57 mScrollX, mScrollY: Integer;
58 mEnabled: Boolean;
59 mCanFocus: Boolean;
60 mChildren: array of TUIControl;
61 mFocused: TUIControl; // valid only for top-level controls
62 mEscClose: Boolean; // valid only for top-level controls
63 mDrawShadow: Boolean;
64 mCancel: Boolean;
65 mDefault: Boolean;
66 // colors
67 mCtl4Style: AnsiString;
68 mBackColor: array[0..ClrIdxMax] of TGxRGBA;
69 mTextColor: array[0..ClrIdxMax] of TGxRGBA;
70 mFrameColor: array[0..ClrIdxMax] of TGxRGBA;
71 mFrameTextColor: array[0..ClrIdxMax] of TGxRGBA;
72 mFrameIconColor: array[0..ClrIdxMax] of TGxRGBA;
73 mDarken: array[0..ClrIdxMax] of Integer; // >255: none
75 protected
76 procedure updateStyle (); virtual;
77 procedure cacheStyle (root: TUIStyle); virtual;
78 function getColorIndex (): Integer; inline;
80 protected
81 function getEnabled (): Boolean;
82 procedure setEnabled (v: Boolean); inline;
84 function getFocused (): Boolean; inline;
85 procedure setFocused (v: Boolean); inline;
87 function getActive (): Boolean; inline;
89 function getCanFocus (): Boolean; inline;
91 function isMyChild (ctl: TUIControl): Boolean;
93 function findFirstFocus (): TUIControl;
94 function findLastFocus (): TUIControl;
96 function findNextFocus (cur: TUIControl; wrap: Boolean): TUIControl;
97 function findPrevFocus (cur: TUIControl; wrap: Boolean): TUIControl;
99 function findCancelControl (): TUIControl;
100 function findDefaulControl (): TUIControl;
102 function findControlById (const aid: AnsiString): TUIControl;
104 procedure activated (); virtual;
105 procedure blurred (); virtual;
107 procedure calcFullClientSize ();
109 protected
110 var savedClip: TGxRect; // valid only in `draw*()` calls
111 //WARNING! do not call scissor functions outside `.draw*()` API!
112 // set scissor to this rect (in local coords)
113 procedure setScissor (lx, ly, lw, lh: Integer); // valid only in `draw*()` calls
115 public
116 actionCB: TActionCB;
117 closeRequestCB: TCloseRequestCB;
119 private
120 mDefSize: TLaySize; // default size
121 mMaxSize: TLaySize; // maximum size
122 mFlex: Integer;
123 mHoriz: Boolean;
124 mCanWrap: Boolean;
125 mLineStart: Boolean;
126 mHGroup: AnsiString;
127 mVGroup: AnsiString;
128 mAlign: Integer;
129 mExpand: Boolean;
130 mLayDefSize: TLaySize;
131 mLayMaxSize: TLaySize;
132 mFullSize: TLaySize;
133 mNoPad: Boolean;
134 mPadding: TLaySize;
136 public
137 // layouter interface
138 function getDefSize (): TLaySize; inline; // default size; <0: use max size
139 //procedure setDefSize (const sz: TLaySize); inline; // default size; <0: use max size
140 function getMargins (): TLayMargins; inline;
141 function getPadding (): TLaySize; inline; // children padding (each non-first child will get this on left/top)
142 function getMaxSize (): TLaySize; inline; // max size; <0: set to some huge value
143 //procedure setMaxSize (const sz: TLaySize); inline; // max size; <0: set to some huge value
144 function getFlex (): Integer; inline; // <=0: not flexible
145 function isHorizBox (): Boolean; inline; // horizontal layout for children?
146 function canWrap (): Boolean; inline; // for horizontal boxes: can wrap children? for child: `false` means 'nonbreakable at *next* ctl'
147 function noPad (): Boolean; inline; // ignore padding in box direction for this control
148 function isLineStart (): Boolean; inline; // `true` if this ctl should start a new line; ignored for vertical boxes
149 function getAlign (): Integer; inline; // aligning in non-main direction: <0: left/up; 0: center; >0: right/down
150 function getExpand (): Boolean; inline; // expanding in non-main direction: `true` will ignore align and eat all available space
151 function getHGroup (): AnsiString; inline; // empty: not grouped
152 function getVGroup (): AnsiString; inline; // empty: not grouped
154 procedure setActualSizePos (constref apos: TLayPos; constref asize: TLaySize); inline;
156 procedure layPrepare (); virtual; // called before registering control in layouter
158 public
159 property flex: Integer read mFlex write mFlex;
160 property flDefaultSize: TLaySize read mDefSize write mDefSize;
161 property flMaxSize: TLaySize read mMaxSize write mMaxSize;
162 property flPadding: TLaySize read mPadding write mPadding;
163 property flHoriz: Boolean read mHoriz write mHoriz;
164 property flCanWrap: Boolean read mCanWrap write mCanWrap;
165 property flLineStart: Boolean read mLineStart write mLineStart;
166 property flAlign: Integer read mAlign write mAlign;
167 property flExpand: Boolean read mExpand write mExpand;
168 property flHGroup: AnsiString read mHGroup write mHGroup;
169 property flVGroup: AnsiString read mVGroup write mVGroup;
170 property flNoPad: Boolean read mNoPad write mNoPad;
171 property fullSize: TLaySize read mFullSize;
173 protected
174 function parsePos (par: TTextParser): TLayPos;
175 function parseSize (par: TTextParser): TLaySize;
176 function parsePadding (par: TTextParser): TLaySize;
177 function parseHPadding (par: TTextParser; def: Integer): TLaySize;
178 function parseVPadding (par: TTextParser; def: Integer): TLaySize;
179 function parseBool (par: TTextParser): Boolean;
180 function parseAnyAlign (par: TTextParser): Integer;
181 function parseHAlign (par: TTextParser): Integer;
182 function parseVAlign (par: TTextParser): Integer;
183 function parseOrientation (const prname: AnsiString; par: TTextParser): Boolean;
184 procedure parseTextAlign (par: TTextParser; var h, v: Integer);
185 procedure parseChildren (par: TTextParser); // par should be on '{'; final '}' is eaten
187 public
188 // par is on property data
189 // there may be more data in text stream, don't eat it!
190 // return `true` if property name is valid and value was parsed
191 // return `false` if property name is invalid; don't advance parser in this case
192 // throw on property data errors
193 function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; virtual;
195 // par should be on '{'; final '}' is eaten
196 procedure parseProperties (par: TTextParser);
198 public
199 constructor Create ();
200 destructor Destroy (); override;
202 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
204 // `sx` and `sy` are screen coordinates
205 procedure drawControl (gx, gy: Integer); virtual;
207 // called after all children drawn
208 procedure drawControlPost (gx, gy: Integer); virtual;
210 procedure draw (); virtual;
212 function topLevel (): TUIControl; inline;
214 // returns `true` if global coords are inside this control
215 function toLocal (var x, y: Integer): Boolean;
216 function toLocal (gx, gy: Integer; out x, y: Integer): Boolean; inline;
217 procedure toGlobal (var x, y: Integer);
218 procedure toGlobal (lx, ly: Integer; out x, y: Integer); inline;
220 procedure getDrawRect (out gx, gy, wdt, hgt: Integer);
222 // x and y are global coords
223 function controlAtXY (x, y: Integer; allowDisabled: Boolean=false): TUIControl;
225 function parentScrollX (): Integer; inline;
226 function parentScrollY (): Integer; inline;
228 procedure makeVisibleInParent ();
230 procedure doAction (); virtual; // so user controls can override it
232 procedure mouseEvent (var ev: THMouseEvent); virtual; // returns `true` if event was eaten
233 procedure keyEvent (var ev: THKeyEvent); virtual; // returns `true` if event was eaten
234 procedure keyEventPre (var ev: THKeyEvent); virtual; // will be called before dispatching the event
235 procedure keyEventPost (var ev: THKeyEvent); virtual; // will be called after if nobody processed the event
237 function prevSibling (): TUIControl;
238 function nextSibling (): TUIControl;
239 function firstChild (): TUIControl; inline;
240 function lastChild (): TUIControl; inline;
242 procedure appendChild (ctl: TUIControl); virtual;
244 function setActionCBFor (const aid: AnsiString; cb: TActionCB): TActionCB; // returns previous cb
246 function forEachChildren (cb: TCtlEnumCB): TUIControl; // doesn't recurse
247 function forEachControl (cb: TCtlEnumCB; includeSelf: Boolean=true): TUIControl;
249 procedure close (); // this closes *top-level* control
251 public
252 property id: AnsiString read mId write mId;
253 property styleId: AnsiString read mStyleId;
254 property scrollX: Integer read mScrollX write mScrollX;
255 property scrollY: Integer read mScrollY write mScrollY;
256 property x0: Integer read mX write mX;
257 property y0: Integer read mY write mY;
258 property width: Integer read mWidth write mWidth;
259 property height: Integer read mHeight write mHeight;
260 property enabled: Boolean read getEnabled write setEnabled;
261 property parent: TUIControl read mParent;
262 property focused: Boolean read getFocused write setFocused;
263 property active: Boolean read getActive;
264 property escClose: Boolean read mEscClose write mEscClose;
265 property cancel: Boolean read mCancel write mCancel;
266 property defctl: Boolean read mDefault write mDefault;
267 property canFocus: Boolean read getCanFocus write mCanFocus;
268 property ctlById[const aid: AnsiString]: TUIControl read findControlById; default;
269 end;
272 TUITopWindow = class(TUIControl)
273 private
274 type TXMode = (None, Drag, Scroll);
276 private
277 mTitle: AnsiString;
278 mDragScroll: TXMode;
279 mDragStartX, mDragStartY: Integer;
280 mWaitingClose: Boolean;
281 mInClose: Boolean;
282 mFreeOnClose: Boolean; // default: false
283 mDoCenter: Boolean; // after layouting
284 mFitToScreen: Boolean;
286 protected
287 procedure activated (); override;
288 procedure blurred (); override;
290 public
291 closeCB: TActionCB; // called after window was removed from ui window list
293 public
294 constructor Create (const atitle: AnsiString);
296 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
298 function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
300 procedure flFitToScreen (); // call this before layouting
302 procedure centerInScreen ();
304 // `sx` and `sy` are screen coordinates
305 procedure drawControl (gx, gy: Integer); override;
306 procedure drawControlPost (gx, gy: Integer); override;
308 procedure keyEvent (var ev: THKeyEvent); override; // returns `true` if event was eaten
309 procedure mouseEvent (var ev: THMouseEvent); override; // returns `true` if event was eaten
311 public
312 property freeOnClose: Boolean read mFreeOnClose write mFreeOnClose;
313 property fitToScreen: Boolean read mFitToScreen write mFitToScreen;
314 end;
316 // ////////////////////////////////////////////////////////////////////// //
317 TUIBox = class(TUIControl)
318 private
319 mHasFrame: Boolean;
320 mCaption: AnsiString;
321 mHAlign: Integer; // -1: left; 0: center; 1: right; default: left
323 protected
324 procedure setCaption (const acap: AnsiString);
325 procedure setHasFrame (v: Boolean);
327 public
328 constructor Create (ahoriz: Boolean);
330 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
332 function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
334 procedure drawControl (gx, gy: Integer); override;
336 procedure mouseEvent (var ev: THMouseEvent); override;
337 procedure keyEvent (var ev: THKeyEvent); override;
339 public
340 property caption: AnsiString read mCaption write setCaption;
341 property hasFrame: Boolean read mHasFrame write setHasFrame;
342 property captionAlign: Integer read mHAlign write mHAlign;
343 end;
345 TUIHBox = class(TUIBox)
346 public
347 constructor Create ();
349 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
350 end;
352 TUIVBox = class(TUIBox)
353 public
354 constructor Create ();
356 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
357 end;
359 // ////////////////////////////////////////////////////////////////////// //
360 TUISpan = class(TUIControl)
361 public
362 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
364 function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
366 procedure drawControl (gx, gy: Integer); override;
367 end;
369 // ////////////////////////////////////////////////////////////////////// //
370 TUILine = class(TUIControl)
371 public
372 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
374 function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
376 procedure drawControl (gx, gy: Integer); override;
377 end;
379 TUIHLine = class(TUILine)
380 public
381 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
382 end;
384 TUIVLine = class(TUILine)
385 public
386 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
387 end;
389 // ////////////////////////////////////////////////////////////////////// //
390 TUIStaticText = class(TUIControl)
391 private
392 mText: AnsiString;
393 mHAlign: Integer; // -1: left; 0: center; 1: right; default: left
394 mVAlign: Integer; // -1: top; 0: center; 1: bottom; default: center
395 mHeader: Boolean; // true: draw with frame text color
396 mLine: Boolean; // true: draw horizontal line
398 private
399 procedure setText (const atext: AnsiString);
401 public
402 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
404 function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
406 procedure drawControl (gx, gy: Integer); override;
408 public
409 property text: AnsiString read mText write setText;
410 property halign: Integer read mHAlign write mHAlign;
411 property valign: Integer read mVAlign write mVAlign;
412 property header: Boolean read mHeader write mHeader;
413 property line: Boolean read mLine write mLine;
414 end;
416 // ////////////////////////////////////////////////////////////////////// //
417 TUITextLabel = class(TUIControl)
418 private
419 mText: AnsiString;
420 mHAlign: Integer; // -1: left; 0: center; 1: right; default: left
421 mVAlign: Integer; // -1: top; 0: center; 1: bottom; default: center
422 mHotChar: AnsiChar;
423 mHotOfs: Integer; // from text start, in pixels
424 mHotColor: array[0..ClrIdxMax] of TGxRGBA;
425 mLinkId: AnsiString; // linked control
427 protected
428 procedure cacheStyle (root: TUIStyle); override;
430 procedure setText (const s: AnsiString); virtual;
432 public
433 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
435 function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
437 procedure doAction (); override;
439 procedure drawControl (gx, gy: Integer); override;
441 procedure mouseEvent (var ev: THMouseEvent); override;
442 procedure keyEventPost (var ev: THKeyEvent); override;
444 public
445 property text: AnsiString read mText write setText;
446 property halign: Integer read mHAlign write mHAlign;
447 property valign: Integer read mVAlign write mVAlign;
448 end;
450 // ////////////////////////////////////////////////////////////////////// //
451 TUIButton = class(TUITextLabel)
452 protected
453 procedure setText (const s: AnsiString); override;
455 public
456 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
458 procedure drawControl (gx, gy: Integer); override;
460 procedure mouseEvent (var ev: THMouseEvent); override;
461 procedure keyEvent (var ev: THKeyEvent); override;
462 end;
464 // ////////////////////////////////////////////////////////////////////// //
465 TUISwitchBox = class(TUITextLabel)
466 protected
467 mBoolVar: PBoolean;
468 mChecked: Boolean;
469 mIcon: TGxContext.TMarkIcon;
470 mSwitchColor: array[0..ClrIdxMax] of TGxRGBA;
472 protected
473 procedure cacheStyle (root: TUIStyle); override;
475 procedure setText (const s: AnsiString); override;
477 function getChecked (): Boolean; virtual;
478 procedure setChecked (v: Boolean); virtual; abstract;
480 public
481 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
483 function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
485 procedure drawControl (gx, gy: Integer); override;
487 procedure mouseEvent (var ev: THMouseEvent); override;
488 procedure keyEvent (var ev: THKeyEvent); override;
490 procedure setVar (pvar: PBoolean);
492 public
493 property checked: Boolean read getChecked write setChecked;
494 end;
496 TUICheckBox = class(TUISwitchBox)
497 protected
498 procedure setChecked (v: Boolean); override;
500 public
501 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
503 procedure doAction (); override;
504 end;
506 TUIRadioBox = class(TUISwitchBox)
507 private
508 mRadioGroup: AnsiString;
510 protected
511 procedure setChecked (v: Boolean); override;
513 public
514 procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
516 function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
518 procedure doAction (); override;
520 public
521 property radioGroup: AnsiString read mRadioGroup write mRadioGroup; //FIXME
522 end;
525 // ////////////////////////////////////////////////////////////////////////// //
526 procedure uiMouseEvent (var evt: THMouseEvent);
527 procedure uiKeyEvent (var evt: THKeyEvent);
528 procedure uiDraw ();
531 // ////////////////////////////////////////////////////////////////////////// //
532 procedure uiAddWindow (ctl: TUIControl);
533 procedure uiRemoveWindow (ctl: TUIControl); // will free window if `mFreeOnClose` is `true`
534 function uiVisibleWindow (ctl: TUIControl): Boolean;
536 procedure uiUpdateStyles ();
539 // ////////////////////////////////////////////////////////////////////////// //
540 // do layouting
541 procedure uiLayoutCtl (ctl: TUIControl);
544 // ////////////////////////////////////////////////////////////////////////// //
545 var
546 fuiRenderScale: Single = 1.0;
547 uiContext: TGxContext = nil;
550 implementation
552 uses
553 fui_flexlay,
554 utils;
557 // ////////////////////////////////////////////////////////////////////////// //
558 var
559 ctlsToKill: array of TUIControl = nil;
562 procedure scheduleKill (ctl: TUIControl);
563 var
564 f: Integer;
565 begin
566 if (ctl = nil) then exit;
567 ctl := ctl.topLevel;
568 for f := 0 to High(ctlsToKill) do
569 begin
570 if (ctlsToKill[f] = ctl) then exit;
571 if (ctlsToKill[f] = nil) then begin ctlsToKill[f] := ctl; exit; end;
572 end;
573 SetLength(ctlsToKill, Length(ctlsToKill)+1);
574 ctlsToKill[High(ctlsToKill)] := ctl;
575 end;
578 procedure processKills ();
579 var
580 f: Integer;
581 ctl: TUIControl;
582 begin
583 for f := 0 to High(ctlsToKill) do
584 begin
585 ctl := ctlsToKill[f];
586 if (ctl = nil) then break;
587 ctlsToKill[f] := nil;
588 FreeAndNil(ctl);
589 end;
590 if (Length(ctlsToKill) > 0) then ctlsToKill[0] := nil; // just in case
591 end;
594 // ////////////////////////////////////////////////////////////////////////// //
595 var
596 knownCtlClasses: array of record
597 klass: TUIControlClass;
598 name: AnsiString;
599 end = nil;
602 procedure registerCtlClass (aklass: TUIControlClass; const aname: AnsiString);
603 begin
604 assert(aklass <> nil);
605 assert(Length(aname) > 0);
606 SetLength(knownCtlClasses, Length(knownCtlClasses)+1);
607 knownCtlClasses[High(knownCtlClasses)].klass := aklass;
608 knownCtlClasses[High(knownCtlClasses)].name := aname;
609 end;
612 function findCtlClass (const aname: AnsiString): TUIControlClass;
613 var
614 f: Integer;
615 begin
616 for f := 0 to High(knownCtlClasses) do
617 begin
618 if (strEquCI1251(aname, knownCtlClasses[f].name)) then
619 begin
620 result := knownCtlClasses[f].klass;
621 exit;
622 end;
623 end;
624 result := nil;
625 end;
628 // ////////////////////////////////////////////////////////////////////////// //
629 type
630 TFlexLayouter = specialize TFlexLayouterBase<TUIControl>;
632 procedure uiLayoutCtl (ctl: TUIControl);
633 var
634 lay: TFlexLayouter;
635 begin
636 if (ctl = nil) then exit;
637 lay := TFlexLayouter.Create();
638 try
639 if (ctl is TUITopWindow) and (TUITopWindow(ctl).fitToScreen) then TUITopWindow(ctl).flFitToScreen();
641 lay.setup(ctl);
642 //lay.layout();
644 //writeln('============================'); lay.dumpFlat();
646 //writeln('=== initial ==='); lay.dump();
648 //lay.calcMaxSizeInternal(0);
650 lay.firstPass();
651 writeln('=== after first pass ===');
652 lay.dump();
654 lay.secondPass();
655 writeln('=== after second pass ===');
656 lay.dump();
659 lay.layout();
660 //writeln('=== final ==='); lay.dump();
662 if (ctl.mParent = nil) and (ctl is TUITopWindow) and (TUITopWindow(ctl).mDoCenter) then
663 begin
664 TUITopWindow(ctl).centerInScreen();
665 end;
667 // calculate full size
668 ctl.calcFullClientSize();
670 // fix focus
671 if (ctl.mParent = nil) then
672 begin
673 if (ctl.mFocused = nil) or (ctl.mFocused = ctl) or (not ctl.mFocused.enabled) then
674 begin
675 ctl.mFocused := ctl.findFirstFocus();
676 end;
677 end;
679 finally
680 FreeAndNil(lay);
681 end;
682 end;
685 // ////////////////////////////////////////////////////////////////////////// //
686 var
687 uiTopList: array of TUIControl = nil;
688 uiGrabCtl: TUIControl = nil;
691 procedure uiUpdateStyles ();
692 var
693 ctl: TUIControl;
694 begin
695 for ctl in uiTopList do ctl.updateStyle();
696 end;
699 procedure uiMouseEvent (var evt: THMouseEvent);
700 var
701 ev: THMouseEvent;
702 f, c: Integer;
703 lx, ly: Integer;
704 ctmp: TUIControl;
705 begin
706 processKills();
707 if (evt.eaten) or (evt.cancelled) then exit;
708 ev := evt;
709 ev.x := trunc(ev.x/fuiRenderScale);
710 ev.y := trunc(ev.y/fuiRenderScale);
711 ev.dx := trunc(ev.dx/fuiRenderScale); //FIXME
712 ev.dy := trunc(ev.dy/fuiRenderScale); //FIXME
713 try
714 if (uiGrabCtl <> nil) then
715 begin
716 uiGrabCtl.mouseEvent(ev);
717 if (ev.release) and ((ev.bstate and (not ev.but)) = 0) then uiGrabCtl := nil;
718 ev.eat();
719 exit;
720 end;
721 if (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)].enabled) then uiTopList[High(uiTopList)].mouseEvent(ev);
722 if (not ev.eaten) and (not ev.cancelled) and (ev.press) then
723 begin
724 for f := High(uiTopList) downto 0 do
725 begin
726 if uiTopList[f].toLocal(ev.x, ev.y, lx, ly) then
727 begin
728 if (uiTopList[f].enabled) and (f <> High(uiTopList)) then
729 begin
730 uiTopList[High(uiTopList)].blurred();
731 ctmp := uiTopList[f];
732 uiGrabCtl := nil;
733 for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
734 uiTopList[High(uiTopList)] := ctmp;
735 ctmp.activated();
736 ctmp.mouseEvent(ev);
737 end;
738 ev.eat();
739 exit;
740 end;
741 end;
742 end;
743 finally
744 if (ev.eaten) then evt.eat();
745 if (ev.cancelled) then evt.cancel();
746 end;
747 end;
750 procedure uiKeyEvent (var evt: THKeyEvent);
751 var
752 ev: THKeyEvent;
753 begin
754 processKills();
755 if (evt.eaten) or (evt.cancelled) then exit;
756 ev := evt;
757 ev.x := trunc(ev.x/fuiRenderScale);
758 ev.y := trunc(ev.y/fuiRenderScale);
759 try
760 if (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)].enabled) then uiTopList[High(uiTopList)].keyEvent(ev);
761 //if (ev.release) then begin ev.eat(); exit; end;
762 finally
763 if (ev.eaten) then evt.eat();
764 if (ev.cancelled) then evt.cancel();
765 end;
766 end;
769 procedure uiDraw ();
770 var
771 f, cidx: Integer;
772 ctl: TUIControl;
773 begin
774 processKills();
775 //if (uiContext = nil) then uiContext := TGxContext.Create();
776 gxSetContext(uiContext, fuiRenderScale);
777 uiContext.resetClip();
778 try
779 for f := 0 to High(uiTopList) do
780 begin
781 ctl := uiTopList[f];
782 ctl.draw();
783 if (f <> High(uiTopList)) then
784 begin
785 cidx := ctl.getColorIndex;
786 uiContext.darkenRect(ctl.x0, ctl.y0, ctl.width, ctl.height, ctl.mDarken[cidx]);
787 end;
788 end;
789 finally
790 gxSetContext(nil);
791 end;
792 end;
795 procedure uiAddWindow (ctl: TUIControl);
796 var
797 f, c: Integer;
798 begin
799 if (ctl = nil) then exit;
800 ctl := ctl.topLevel;
801 if not (ctl is TUITopWindow) then exit; // alas
802 for f := 0 to High(uiTopList) do
803 begin
804 if (uiTopList[f] = ctl) then
805 begin
806 if (f <> High(uiTopList)) then
807 begin
808 uiTopList[High(uiTopList)].blurred();
809 for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
810 uiTopList[High(uiTopList)] := ctl;
811 ctl.activated();
812 end;
813 exit;
814 end;
815 end;
816 if (Length(uiTopList) > 0) then uiTopList[High(uiTopList)].blurred();
817 SetLength(uiTopList, Length(uiTopList)+1);
818 uiTopList[High(uiTopList)] := ctl;
819 ctl.updateStyle();
820 ctl.activated();
821 end;
824 procedure uiRemoveWindow (ctl: TUIControl);
825 var
826 f, c: Integer;
827 begin
828 if (ctl = nil) then exit;
829 ctl := ctl.topLevel;
830 if not (ctl is TUITopWindow) then exit; // alas
831 for f := 0 to High(uiTopList) do
832 begin
833 if (uiTopList[f] = ctl) then
834 begin
835 ctl.blurred();
836 for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
837 SetLength(uiTopList, Length(uiTopList)-1);
838 if (ctl is TUITopWindow) then
839 begin
840 try
841 if assigned(TUITopWindow(ctl).closeCB) then TUITopWindow(ctl).closeCB(ctl);
842 finally
843 if (TUITopWindow(ctl).mFreeOnClose) then scheduleKill(ctl);
844 end;
845 end;
846 exit;
847 end;
848 end;
849 end;
852 function uiVisibleWindow (ctl: TUIControl): Boolean;
853 var
854 f: Integer;
855 begin
856 result := false;
857 if (ctl = nil) then exit;
858 ctl := ctl.topLevel;
859 if not (ctl is TUITopWindow) then exit; // alas
860 for f := 0 to High(uiTopList) do
861 begin
862 if (uiTopList[f] = ctl) then begin result := true; exit; end;
863 end;
864 end;
867 // ////////////////////////////////////////////////////////////////////////// //
868 constructor TUIControl.Create ();
869 begin
870 end;
873 procedure TUIControl.AfterConstruction ();
874 begin
875 inherited;
876 mParent := nil;
877 mId := '';
878 mX := 0;
879 mY := 0;
880 mWidth := 64;
881 mHeight := uiContext.charHeight(' ');
882 mFrameWidth := 0;
883 mFrameHeight := 0;
884 mEnabled := true;
885 mCanFocus := true;
886 mChildren := nil;
887 mFocused := nil;
888 mEscClose := false;
889 mDrawShadow := false;
890 actionCB := nil;
891 // layouter interface
892 //mDefSize := TLaySize.Create(64, uiContext.charHeight(' ')); // default size
893 mDefSize := TLaySize.Create(0, 0); // default size
894 mMaxSize := TLaySize.Create(-1, -1); // maximum size
895 mPadding := TLaySize.Create(0, 0);
896 mNoPad := false;
897 mFlex := 0;
898 mHoriz := true;
899 mCanWrap := false;
900 mLineStart := false;
901 mHGroup := '';
902 mVGroup := '';
903 mStyleId := '';
904 mCtl4Style := '';
905 mAlign := -1; // left/top
906 mExpand := false;
907 end;
910 destructor TUIControl.Destroy ();
911 var
912 f, c: Integer;
913 begin
914 if (mParent <> nil) then
915 begin
916 setFocused(false);
917 for f := 0 to High(mParent.mChildren) do
918 begin
919 if (mParent.mChildren[f] = self) then
920 begin
921 for c := f+1 to High(mParent.mChildren) do mParent.mChildren[c-1] := mParent.mChildren[c];
922 SetLength(mParent.mChildren, Length(mParent.mChildren)-1);
923 end;
924 end;
925 end;
926 for f := 0 to High(mChildren) do
927 begin
928 mChildren[f].mParent := nil;
929 mChildren[f].Free();
930 end;
931 mChildren := nil;
932 end;
935 function TUIControl.getColorIndex (): Integer; inline;
936 begin
937 if (not enabled) then begin result := ClrIdxDisabled; exit; end;
938 // top windows: no focus hack
939 if (self is TUITopWindow) then
940 begin
941 if (getActive) then begin result := ClrIdxActive; exit; end;
942 end
943 else
944 begin
945 // if control cannot be focused, take "active" color scheme for it (it is easier this way)
946 if (not canFocus) or (getActive) then begin result := ClrIdxActive; exit; end;
947 end;
948 result := ClrIdxInactive;
949 end;
951 procedure TUIControl.updateStyle ();
952 var
953 stl: TUIStyle = nil;
954 ctl: TUIControl;
955 begin
956 ctl := self;
957 while (ctl <> nil) do
958 begin
959 if (Length(ctl.mStyleId) <> 0) then begin stl := uiFindStyle(ctl.mStyleId); break; end;
960 ctl := ctl.mParent;
961 end;
962 if (stl = nil) then stl := uiFindStyle(''); // default
963 cacheStyle(stl);
964 for ctl in mChildren do ctl.updateStyle();
965 end;
967 procedure TUIControl.cacheStyle (root: TUIStyle);
968 var
969 cst: AnsiString;
970 begin
971 //writeln('caching style for <', className, '> (', mCtl4Style, ')...');
972 cst := mCtl4Style;
973 // active
974 mBackColor[ClrIdxActive] := root.get('back-color', 'active', cst).asRGBADef(TGxRGBA.Create(0, 0, 128));
975 mTextColor[ClrIdxActive] := root.get('text-color', 'active', cst).asRGBADef(TGxRGBA.Create(255, 255, 255));
976 mFrameColor[ClrIdxActive] := root.get('frame-color', 'active', cst).asRGBADef(TGxRGBA.Create(255, 255, 255));
977 mFrameTextColor[ClrIdxActive] := root.get('frame-text-color', 'active', cst).asRGBADef(TGxRGBA.Create(255, 255, 255));
978 mFrameIconColor[ClrIdxActive] := root.get('frame-icon-color', 'active', cst).asRGBADef(TGxRGBA.Create(0, 255, 0));
979 mDarken[ClrIdxActive] := root.get('darken', 'active', cst).asInt(666);
980 // disabled
981 mBackColor[ClrIdxDisabled] := root.get('back-color', 'disabled', cst).asRGBADef(TGxRGBA.Create(0, 0, 128));
982 mTextColor[ClrIdxDisabled] := root.get('text-color', 'disabled', cst).asRGBADef(TGxRGBA.Create(127, 127, 127));
983 mFrameColor[ClrIdxDisabled] := root.get('frame-color', 'disabled', cst).asRGBADef(TGxRGBA.Create(127, 127, 127));
984 mFrameTextColor[ClrIdxDisabled] := root.get('frame-text-color', 'disabled', cst).asRGBADef(TGxRGBA.Create(127, 127, 127));
985 mFrameIconColor[ClrIdxDisabled] := root.get('frame-icon-color', 'disabled', cst).asRGBADef(TGxRGBA.Create(0, 127, 0));
986 mDarken[ClrIdxDisabled] := root.get('darken', 'disabled', cst).asInt(666);
987 // inactive
988 mBackColor[ClrIdxInactive] := root.get('back-color', 'inactive', cst).asRGBADef(TGxRGBA.Create(0, 0, 128));
989 mTextColor[ClrIdxInactive] := root.get('text-color', 'inactive', cst).asRGBADef(TGxRGBA.Create(255, 255, 255));
990 mFrameColor[ClrIdxInactive] := root.get('frame-color', 'inactive', cst).asRGBADef(TGxRGBA.Create(255, 255, 255));
991 mFrameTextColor[ClrIdxInactive] := root.get('frame-text-color', 'inactive', cst).asRGBADef(TGxRGBA.Create(255, 255, 255));
992 mFrameIconColor[ClrIdxInactive] := root.get('frame-icon-color', 'inactive', cst).asRGBADef(TGxRGBA.Create(0, 255, 0));
993 mDarken[ClrIdxInactive] := root.get('darken', 'inactive', cst).asInt(666);
994 end;
997 // ////////////////////////////////////////////////////////////////////////// //
998 function TUIControl.getDefSize (): TLaySize; inline; begin result := mLayDefSize; end;
999 function TUIControl.getMaxSize (): TLaySize; inline; begin result := mLayMaxSize; end;
1000 function TUIControl.getPadding (): TLaySize; inline; begin result := mPadding; end;
1001 function TUIControl.getFlex (): Integer; inline; begin result := mFlex; end;
1002 function TUIControl.isHorizBox (): Boolean; inline; begin result := mHoriz; end;
1003 function TUIControl.canWrap (): Boolean; inline; begin result := mCanWrap; end;
1004 function TUIControl.noPad (): Boolean; inline; begin result := mNoPad; end;
1005 function TUIControl.isLineStart (): Boolean; inline; begin result := mLineStart; end;
1006 function TUIControl.getAlign (): Integer; inline; begin result := mAlign; end;
1007 function TUIControl.getExpand (): Boolean; inline; begin result := mExpand; end;
1008 function TUIControl.getHGroup (): AnsiString; inline; begin result := mHGroup; end;
1009 function TUIControl.getVGroup (): AnsiString; inline; begin result := mVGroup; end;
1010 function TUIControl.getMargins (): TLayMargins; inline; begin result := TLayMargins.Create(mFrameHeight, mFrameWidth, mFrameHeight, mFrameWidth); end;
1012 procedure TUIControl.setActualSizePos (constref apos: TLayPos; constref asize: TLaySize); inline;
1013 begin
1014 //writeln(self.className, '; pos=', apos.toString, '; size=', asize.toString);
1015 if (mParent <> nil) then
1016 begin
1017 mX := apos.x;
1018 mY := apos.y;
1019 end;
1020 mWidth := asize.w;
1021 mHeight := asize.h;
1022 end;
1024 procedure TUIControl.layPrepare ();
1025 begin
1026 mLayDefSize := mDefSize;
1027 mLayMaxSize := mMaxSize;
1028 if (mLayMaxSize.w >= 0) then mLayMaxSize.w += mFrameWidth*2;
1029 if (mLayMaxSize.h >= 0) then mLayMaxSize.h += mFrameHeight*2;
1030 end;
1033 // ////////////////////////////////////////////////////////////////////////// //
1034 function TUIControl.parsePos (par: TTextParser): TLayPos;
1035 var
1036 ech: AnsiChar = ')';
1037 begin
1038 if (par.eatDelim('[')) then ech := ']' else par.expectDelim('(');
1039 result.x := par.expectInt();
1040 par.eatDelim(','); // optional comma
1041 result.y := par.expectInt();
1042 par.eatDelim(','); // optional comma
1043 par.expectDelim(ech);
1044 end;
1046 function TUIControl.parseSize (par: TTextParser): TLaySize;
1047 var
1048 ech: AnsiChar = ')';
1049 begin
1050 if (par.eatDelim('[')) then ech := ']' else par.expectDelim('(');
1051 result.w := par.expectInt();
1052 par.eatDelim(','); // optional comma
1053 result.h := par.expectInt();
1054 par.eatDelim(','); // optional comma
1055 par.expectDelim(ech);
1056 end;
1058 function TUIControl.parsePadding (par: TTextParser): TLaySize;
1059 begin
1060 result := parseSize(par);
1061 end;
1063 function TUIControl.parseHPadding (par: TTextParser; def: Integer): TLaySize;
1064 begin
1065 if (par.isInt) then
1066 begin
1067 result.h := def;
1068 result.w := par.expectInt();
1069 end
1070 else
1071 begin
1072 result := parsePadding(par);
1073 end;
1074 end;
1076 function TUIControl.parseVPadding (par: TTextParser; def: Integer): TLaySize;
1077 begin
1078 if (par.isInt) then
1079 begin
1080 result.w := def;
1081 result.h := par.expectInt();
1082 end
1083 else
1084 begin
1085 result := parsePadding(par);
1086 end;
1087 end;
1089 function TUIControl.parseBool (par: TTextParser): Boolean;
1090 begin
1091 result :=
1092 par.eatIdOrStrCI('true') or
1093 par.eatIdOrStrCI('yes') or
1094 par.eatIdOrStrCI('tan');
1095 if not result then
1096 begin
1097 if (not par.eatIdOrStrCI('false')) and (not par.eatIdOrStrCI('no')) and (not par.eatIdOrStrCI('ona')) then
1098 begin
1099 par.error('boolean value expected');
1100 end;
1101 end;
1102 end;
1104 function TUIControl.parseAnyAlign (par: TTextParser): Integer;
1105 begin
1106 if (par.eatIdOrStrCI('left')) or (par.eatIdOrStrCI('top')) then result := -1
1107 else if (par.eatIdOrStrCI('right')) or (par.eatIdOrStrCI('bottom')) then result := 1
1108 else if (par.eatIdOrStrCI('center')) then result := 0
1109 else par.error('invalid align value');
1110 end;
1112 function TUIControl.parseHAlign (par: TTextParser): Integer;
1113 begin
1114 if (par.eatIdOrStrCI('left')) then result := -1
1115 else if (par.eatIdOrStrCI('right')) then result := 1
1116 else if (par.eatIdOrStrCI('center')) then result := 0
1117 else par.error('invalid horizontal align value');
1118 end;
1120 function TUIControl.parseVAlign (par: TTextParser): Integer;
1121 begin
1122 if (par.eatIdOrStrCI('top')) then result := -1
1123 else if (par.eatIdOrStrCI('bottom')) then result := 1
1124 else if (par.eatIdOrStrCI('center')) then result := 0
1125 else par.error('invalid vertical align value');
1126 end;
1128 procedure TUIControl.parseTextAlign (par: TTextParser; var h, v: Integer);
1129 var
1130 wasH: Boolean = false;
1131 wasV: Boolean = false;
1132 begin
1133 while true do
1134 begin
1135 if (par.eatIdOrStrCI('left')) then
1136 begin
1137 if wasH then par.error('too many align directives');
1138 wasH := true;
1139 h := -1;
1140 continue;
1141 end;
1142 if (par.eatIdOrStrCI('right')) then
1143 begin
1144 if wasH then par.error('too many align directives');
1145 wasH := true;
1146 h := 1;
1147 continue;
1148 end;
1149 if (par.eatIdOrStrCI('hcenter')) then
1150 begin
1151 if wasH then par.error('too many align directives');
1152 wasH := true;
1153 h := 0;
1154 continue;
1155 end;
1156 if (par.eatIdOrStrCI('top')) then
1157 begin
1158 if wasV then par.error('too many align directives');
1159 wasV := true;
1160 v := -1;
1161 continue;
1162 end;
1163 if (par.eatIdOrStrCI('bottom')) then
1164 begin
1165 if wasV then par.error('too many align directives');
1166 wasV := true;
1167 v := 1;
1168 continue;
1169 end;
1170 if (par.eatIdOrStrCI('vcenter')) then
1171 begin
1172 if wasV then par.error('too many align directives');
1173 wasV := true;
1174 v := 0;
1175 continue;
1176 end;
1177 if (par.eatIdOrStrCI('center')) then
1178 begin
1179 if wasV or wasH then par.error('too many align directives');
1180 wasV := true;
1181 wasH := true;
1182 h := 0;
1183 v := 0;
1184 continue;
1185 end;
1186 break;
1187 end;
1188 if not wasV and not wasH then par.error('invalid align value');
1189 end;
1191 function TUIControl.parseOrientation (const prname: AnsiString; par: TTextParser): Boolean;
1192 begin
1193 if (strEquCI1251(prname, 'orientation')) or (strEquCI1251(prname, 'orient')) then
1194 begin
1195 if (par.eatIdOrStrCI('horizontal')) or (par.eatIdOrStrCI('horiz')) then mHoriz := true
1196 else if (par.eatIdOrStrCI('vertical')) or (par.eatIdOrStrCI('vert')) then mHoriz := false
1197 else par.error('`horizontal` or `vertical` expected');
1198 result := true;
1199 end
1200 else
1201 begin
1202 result := false;
1203 end;
1204 end;
1206 // par should be on '{'; final '}' is eaten
1207 procedure TUIControl.parseProperties (par: TTextParser);
1208 var
1209 pn: AnsiString;
1210 begin
1211 if (not par.eatDelim('{')) then exit;
1212 while (not par.eatDelim('}')) do
1213 begin
1214 if (not par.isIdOrStr) then par.error('property name expected');
1215 pn := par.tokStr;
1216 par.skipToken();
1217 par.eatDelim(':'); // optional
1218 if not parseProperty(pn, par) then par.errorfmt('invalid property name ''%s''', [pn]);
1219 par.eatDelim(','); // optional
1220 end;
1221 end;
1223 // par should be on '{'
1224 procedure TUIControl.parseChildren (par: TTextParser);
1225 var
1226 cc: TUIControlClass;
1227 ctl: TUIControl;
1228 begin
1229 par.expectDelim('{');
1230 while (not par.eatDelim('}')) do
1231 begin
1232 if (not par.isIdOrStr) then par.error('control name expected');
1233 cc := findCtlClass(par.tokStr);
1234 if (cc = nil) then par.errorfmt('unknown control name: ''%s''', [par.tokStr]);
1235 //writeln('children for <', par.tokStr, '>: <', cc.className, '>');
1236 par.skipToken();
1237 par.eatDelim(':'); // optional
1238 ctl := cc.Create();
1239 //writeln(' mHoriz=', ctl.mHoriz);
1240 try
1241 ctl.parseProperties(par);
1242 except
1243 FreeAndNil(ctl);
1244 raise;
1245 end;
1246 //writeln(': ', ctl.mDefSize.toString);
1247 appendChild(ctl);
1248 par.eatDelim(','); // optional
1249 end;
1250 end;
1253 function TUIControl.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
1254 begin
1255 result := true;
1256 if (strEquCI1251(prname, 'id')) then begin mId := par.expectIdOrStr(true); exit; end; // allow empty strings
1257 if (strEquCI1251(prname, 'style')) then begin mStyleId := par.expectIdOrStr(); exit; end; // no empty strings
1258 if (strEquCI1251(prname, 'flex')) then begin flex := par.expectInt(); exit; end;
1259 // sizes
1260 if (strEquCI1251(prname, 'defsize')) or (strEquCI1251(prname, 'size')) then begin mDefSize := parseSize(par); exit; end;
1261 if (strEquCI1251(prname, 'maxsize')) then begin mMaxSize := parseSize(par); exit; end;
1262 if (strEquCI1251(prname, 'defwidth')) or (strEquCI1251(prname, 'width')) then begin mDefSize.w := par.expectInt(); exit; end;
1263 if (strEquCI1251(prname, 'defheight')) or (strEquCI1251(prname, 'height')) then begin mDefSize.h := par.expectInt(); exit; end;
1264 if (strEquCI1251(prname, 'maxwidth')) then begin mMaxSize.w := par.expectInt(); exit; end;
1265 if (strEquCI1251(prname, 'maxheight')) then begin mMaxSize.h := par.expectInt(); exit; end;
1266 // padding
1267 if (strEquCI1251(prname, 'padding')) then begin mPadding := parsePadding(par); exit; end;
1268 if (strEquCI1251(prname, 'nopad')) then begin mNoPad := true; exit; end;
1269 // flags
1270 if (strEquCI1251(prname, 'wrap')) then begin mCanWrap := parseBool(par); exit; end;
1271 if (strEquCI1251(prname, 'linestart')) then begin mLineStart := parseBool(par); exit; end;
1272 if (strEquCI1251(prname, 'expand')) then begin mExpand := parseBool(par); exit; end;
1273 // align
1274 if (strEquCI1251(prname, 'align')) then begin mAlign := parseAnyAlign(par); exit; end;
1275 if (strEquCI1251(prname, 'hgroup')) then begin mHGroup := par.expectIdOrStr(true); exit; end; // allow empty strings
1276 if (strEquCI1251(prname, 'vgroup')) then begin mVGroup := par.expectIdOrStr(true); exit; end; // allow empty strings
1277 // other
1278 if (strEquCI1251(prname, 'canfocus')) then begin mCanFocus := true; exit; end;
1279 if (strEquCI1251(prname, 'nofocus')) then begin mCanFocus := false; exit; end;
1280 if (strEquCI1251(prname, 'disabled')) then begin mEnabled := false; exit; end;
1281 if (strEquCI1251(prname, 'enabled')) then begin mEnabled := true; exit; end;
1282 if (strEquCI1251(prname, 'escclose')) then begin mEscClose := not parseBool(par); exit; end;
1283 if (strEquCI1251(prname, 'default')) then begin mDefault := true; exit; end;
1284 if (strEquCI1251(prname, 'cancel')) then begin mCancel := true; exit; end;
1285 result := false;
1286 end;
1289 // ////////////////////////////////////////////////////////////////////////// //
1290 procedure TUIControl.activated ();
1291 begin
1292 makeVisibleInParent();
1293 end;
1296 procedure TUIControl.blurred ();
1297 begin
1298 if (uiGrabCtl = self) then uiGrabCtl := nil;
1299 end;
1302 procedure TUIControl.calcFullClientSize ();
1303 var
1304 ctl: TUIControl;
1305 begin
1306 mFullSize := TLaySize.Create(0, 0);
1307 if (mWidth < 1) or (mHeight < 1) then exit;
1308 for ctl in mChildren do
1309 begin
1310 ctl.calcFullClientSize();
1311 mFullSize.w := nmax(mFullSize.w, ctl.mX-mFrameWidth+ctl.mFullSize.w);
1312 mFullSize.h := nmax(mFullSize.h, ctl.mY-mFrameHeight+ctl.mFullSize.h);
1313 end;
1314 mFullSize.w := nmax(mFullSize.w, mWidth-mFrameWidth*2);
1315 mFullSize.h := nmax(mFullSize.h, mHeight-mFrameHeight*2);
1316 end;
1319 function TUIControl.topLevel (): TUIControl; inline;
1320 begin
1321 result := self;
1322 while (result.mParent <> nil) do result := result.mParent;
1323 end;
1326 function TUIControl.getEnabled (): Boolean;
1327 var
1328 ctl: TUIControl;
1329 begin
1330 result := false;
1331 if (not mEnabled) then exit;
1332 ctl := mParent;
1333 while (ctl <> nil) do
1334 begin
1335 if (not ctl.mEnabled) then exit;
1336 ctl := ctl.mParent;
1337 end;
1338 result := true;
1339 end;
1342 procedure TUIControl.setEnabled (v: Boolean); inline;
1343 begin
1344 if (mEnabled = v) then exit;
1345 mEnabled := v;
1346 if (not v) and focused then setFocused(false);
1347 end;
1350 function TUIControl.getFocused (): Boolean; inline;
1351 begin
1352 if (mParent = nil) then
1353 begin
1354 result := (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)] = self);
1355 end
1356 else
1357 begin
1358 result := (topLevel.mFocused = self);
1359 if (result) then result := (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)] = topLevel);
1360 end;
1361 end;
1364 function TUIControl.getActive (): Boolean; inline;
1365 var
1366 ctl: TUIControl;
1367 begin
1368 if (mParent = nil) then
1369 begin
1370 result := (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)] = self);
1371 end
1372 else
1373 begin
1374 ctl := topLevel.mFocused;
1375 while (ctl <> nil) and (ctl <> self) do ctl := ctl.mParent;
1376 result := (ctl = self);
1377 if (result) then result := (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)] = topLevel);
1378 end;
1379 end;
1382 procedure TUIControl.setFocused (v: Boolean); inline;
1383 var
1384 tl: TUIControl;
1385 begin
1386 tl := topLevel;
1387 if (not v) then
1388 begin
1389 if (tl.mFocused = self) then
1390 begin
1391 blurred(); // this will reset grab, but still...
1392 if (uiGrabCtl = self) then uiGrabCtl := nil;
1393 tl.mFocused := tl.findNextFocus(self, true);
1394 if (tl.mFocused = self) then tl.mFocused := nil;
1395 if (tl.mFocused <> nil) then tl.mFocused.activated();
1396 end;
1397 exit;
1398 end;
1399 if (not canFocus) then exit;
1400 if (tl.mFocused <> self) then
1401 begin
1402 if (tl.mFocused <> nil) then tl.mFocused.blurred();
1403 tl.mFocused := self;
1404 if (uiGrabCtl <> self) then uiGrabCtl := nil;
1405 activated();
1406 end;
1407 end;
1410 function TUIControl.getCanFocus (): Boolean; inline;
1411 begin
1412 result := (getEnabled) and (mCanFocus) and (mWidth > 0) and (mHeight > 0);
1413 end;
1416 function TUIControl.isMyChild (ctl: TUIControl): Boolean;
1417 begin
1418 result := true;
1419 while (ctl <> nil) do
1420 begin
1421 if (ctl.mParent = self) then exit;
1422 ctl := ctl.mParent;
1423 end;
1424 result := false;
1425 end;
1428 // returns `true` if global coords are inside this control
1429 function TUIControl.toLocal (var x, y: Integer): Boolean;
1430 begin
1431 if (mParent = nil) then
1432 begin
1433 Dec(x, mX);
1434 Dec(y, mY);
1435 result := true; // hack
1436 end
1437 else
1438 begin
1439 result := mParent.toLocal(x, y);
1440 Inc(x, mParent.mScrollX);
1441 Inc(y, mParent.mScrollY);
1442 Dec(x, mX);
1443 Dec(y, mY);
1444 if result then result := (x >= 0) and (y >= 0) and (x < mParent.mWidth) and (y < mParent.mHeight);
1445 end;
1446 if result then result := (x >= 0) and (y >= 0) and (x < mWidth) and (y < mHeight);
1447 end;
1449 function TUIControl.toLocal (gx, gy: Integer; out x, y: Integer): Boolean; inline;
1450 begin
1451 x := gx;
1452 y := gy;
1453 result := toLocal(x, y);
1454 end;
1457 procedure TUIControl.toGlobal (var x, y: Integer);
1458 begin
1459 Inc(x, mX);
1460 Inc(y, mY);
1461 if (mParent <> nil) then
1462 begin
1463 Dec(x, mParent.mScrollX);
1464 Dec(y, mParent.mScrollY);
1465 mParent.toGlobal(x, y);
1466 end;
1467 end;
1469 procedure TUIControl.toGlobal (lx, ly: Integer; out x, y: Integer); inline;
1470 begin
1471 x := lx;
1472 y := ly;
1473 toGlobal(x, y);
1474 end;
1476 procedure TUIControl.getDrawRect (out gx, gy, wdt, hgt: Integer);
1477 var
1478 cgx, cgy: Integer;
1479 begin
1480 if (mParent = nil) then
1481 begin
1482 gx := mX;
1483 gy := mY;
1484 wdt := mWidth;
1485 hgt := mHeight;
1486 end
1487 else
1488 begin
1489 toGlobal(0, 0, cgx, cgy);
1490 mParent.getDrawRect(gx, gy, wdt, hgt);
1491 if (wdt > 0) and (hgt > 0) then
1492 begin
1493 if not intersectRect(gx, gy, wdt, hgt, cgx, cgy, mWidth, mHeight) then
1494 begin
1495 wdt := 0;
1496 hgt := 0;
1497 end;
1498 end;
1499 end;
1500 end;
1503 // x and y are global coords
1504 function TUIControl.controlAtXY (x, y: Integer; allowDisabled: Boolean=false): TUIControl;
1505 var
1506 lx, ly: Integer;
1507 f: Integer;
1508 begin
1509 result := nil;
1510 if (not allowDisabled) and (not enabled) then exit;
1511 if (mWidth < 1) or (mHeight < 1) then exit;
1512 if not toLocal(x, y, lx, ly) then exit;
1513 for f := High(mChildren) downto 0 do
1514 begin
1515 result := mChildren[f].controlAtXY(x, y, allowDisabled);
1516 if (result <> nil) then exit;
1517 end;
1518 result := self;
1519 end;
1522 function TUIControl.parentScrollX (): Integer; inline; begin if (mParent <> nil) then result := mParent.mScrollX else result := 0; end;
1523 function TUIControl.parentScrollY (): Integer; inline; begin if (mParent <> nil) then result := mParent.mScrollY else result := 0; end;
1526 procedure TUIControl.makeVisibleInParent ();
1527 var
1528 sy, ey, cy: Integer;
1529 p: TUIControl;
1530 begin
1531 if (mWidth < 1) or (mHeight < 1) then exit;
1532 p := mParent;
1533 if (p = nil) then exit;
1534 if (p.mFullSize.w < 1) or (p.mFullSize.h < 1) then
1535 begin
1536 p.mScrollX := 0;
1537 p.mScrollY := 0;
1538 exit;
1539 end;
1540 p.makeVisibleInParent();
1541 cy := mY-p.mFrameHeight;
1542 sy := p.mScrollY;
1543 ey := sy+(p.mHeight-p.mFrameHeight*2);
1544 if (cy < sy) then
1545 begin
1546 p.mScrollY := nmax(0, cy);
1547 end
1548 else if (cy+mHeight > ey) then
1549 begin
1550 p.mScrollY := nmax(0, cy+mHeight-(p.mHeight-p.mFrameHeight*2));
1551 end;
1552 end;
1555 // ////////////////////////////////////////////////////////////////////////// //
1556 function TUIControl.prevSibling (): TUIControl;
1557 var
1558 f: Integer;
1559 begin
1560 if (mParent <> nil) then
1561 begin
1562 for f := 1 to High(mParent.mChildren) do
1563 begin
1564 if (mParent.mChildren[f] = self) then begin result := mParent.mChildren[f-1]; exit; end;
1565 end;
1566 end;
1567 result := nil;
1568 end;
1570 function TUIControl.nextSibling (): TUIControl;
1571 var
1572 f: Integer;
1573 begin
1574 if (mParent <> nil) then
1575 begin
1576 for f := 0 to High(mParent.mChildren)-1 do
1577 begin
1578 if (mParent.mChildren[f] = self) then begin result := mParent.mChildren[f+1]; exit; end;
1579 end;
1580 end;
1581 result := nil;
1582 end;
1584 function TUIControl.firstChild (): TUIControl; inline;
1585 begin
1586 if (Length(mChildren) <> 0) then result := mChildren[0] else result := nil;
1587 end;
1589 function TUIControl.lastChild (): TUIControl; inline;
1590 begin
1591 if (Length(mChildren) <> 0) then result := mChildren[High(mChildren)] else result := nil;
1592 end;
1595 function TUIControl.findFirstFocus (): TUIControl;
1596 var
1597 f: Integer;
1598 begin
1599 result := nil;
1600 if enabled then
1601 begin
1602 for f := 0 to High(mChildren) do
1603 begin
1604 result := mChildren[f].findFirstFocus();
1605 if (result <> nil) then exit;
1606 end;
1607 if (canFocus) then result := self;
1608 end;
1609 end;
1612 function TUIControl.findLastFocus (): TUIControl;
1613 var
1614 f: Integer;
1615 begin
1616 result := nil;
1617 if enabled then
1618 begin
1619 for f := High(mChildren) downto 0 do
1620 begin
1621 result := mChildren[f].findLastFocus();
1622 if (result <> nil) then exit;
1623 end;
1624 if (canFocus) then result := self;
1625 end;
1626 end;
1629 function TUIControl.findNextFocus (cur: TUIControl; wrap: Boolean): TUIControl;
1630 var
1631 curHit: Boolean = false;
1633 function checkFocus (ctl: TUIControl): Boolean;
1634 begin
1635 if curHit then
1636 begin
1637 result := (ctl.canFocus);
1638 end
1639 else
1640 begin
1641 curHit := (ctl = cur);
1642 result := false; // don't stop
1643 end;
1644 end;
1646 begin
1647 result := nil;
1648 if enabled then
1649 begin
1650 if not isMyChild(cur) then
1651 begin
1652 result := findFirstFocus();
1653 end
1654 else
1655 begin
1656 result := forEachControl(checkFocus);
1657 if (result = nil) and (wrap) then result := findFirstFocus();
1658 end;
1659 end;
1660 end;
1663 function TUIControl.findPrevFocus (cur: TUIControl; wrap: Boolean): TUIControl;
1664 var
1665 lastCtl: TUIControl = nil;
1667 function checkFocus (ctl: TUIControl): Boolean;
1668 begin
1669 if (ctl = cur) then
1670 begin
1671 result := true;
1672 end
1673 else
1674 begin
1675 result := false;
1676 if (ctl.canFocus) then lastCtl := ctl;
1677 end;
1678 end;
1680 begin
1681 result := nil;
1682 if enabled then
1683 begin
1684 if not isMyChild(cur) then
1685 begin
1686 result := findLastFocus();
1687 end
1688 else
1689 begin
1690 forEachControl(checkFocus);
1691 if (lastCtl = nil) and (wrap) then lastCtl := findLastFocus();
1692 result := lastCtl;
1693 //if (lastCtl <> nil) then writeln('ctl<', lastCtl.className, '>: {', lastCtl.id, '}');
1694 end;
1695 end;
1696 end;
1699 function TUIControl.findDefaulControl (): TUIControl;
1700 var
1701 ctl: TUIControl;
1702 begin
1703 if (enabled) then
1704 begin
1705 if (mDefault) then begin result := self; exit; end;
1706 for ctl in mChildren do
1707 begin
1708 result := ctl.findDefaulControl();
1709 if (result <> nil) then exit;
1710 end;
1711 end;
1712 result := nil;
1713 end;
1715 function TUIControl.findCancelControl (): TUIControl;
1716 var
1717 ctl: TUIControl;
1718 begin
1719 if (enabled) then
1720 begin
1721 if (mCancel) then begin result := self; exit; end;
1722 for ctl in mChildren do
1723 begin
1724 result := ctl.findCancelControl();
1725 if (result <> nil) then exit;
1726 end;
1727 end;
1728 result := nil;
1729 end;
1732 function TUIControl.findControlById (const aid: AnsiString): TUIControl;
1733 var
1734 ctl: TUIControl;
1735 begin
1736 if (strEquCI1251(aid, mId)) then begin result := self; exit; end;
1737 for ctl in mChildren do
1738 begin
1739 result := ctl.findControlById(aid);
1740 if (result <> nil) then exit;
1741 end;
1742 result := nil;
1743 end;
1746 procedure TUIControl.appendChild (ctl: TUIControl);
1747 begin
1748 if (ctl = nil) then exit;
1749 if (ctl.mParent <> nil) then exit;
1750 SetLength(mChildren, Length(mChildren)+1);
1751 mChildren[High(mChildren)] := ctl;
1752 ctl.mParent := self;
1753 Inc(ctl.mX, mFrameWidth);
1754 Inc(ctl.mY, mFrameHeight);
1755 if (ctl.mWidth > 0) and (ctl.mHeight > 0) and
1756 (ctl.mX+ctl.mWidth > mFrameWidth) and (ctl.mY+ctl.mHeight > mFrameHeight) then
1757 begin
1758 if (mWidth+mFrameWidth < ctl.mX+ctl.mWidth) then mWidth := ctl.mX+ctl.mWidth+mFrameWidth;
1759 if (mHeight+mFrameHeight < ctl.mY+ctl.mHeight) then mHeight := ctl.mY+ctl.mHeight+mFrameHeight;
1760 end;
1761 end;
1764 function TUIControl.setActionCBFor (const aid: AnsiString; cb: TActionCB): TActionCB;
1765 var
1766 ctl: TUIControl;
1767 begin
1768 ctl := self[aid];
1769 if (ctl <> nil) then
1770 begin
1771 result := ctl.actionCB;
1772 ctl.actionCB := cb;
1773 end
1774 else
1775 begin
1776 result := nil;
1777 end;
1778 end;
1781 function TUIControl.forEachChildren (cb: TCtlEnumCB): TUIControl;
1782 var
1783 ctl: TUIControl;
1784 begin
1785 result := nil;
1786 if (not assigned(cb)) then exit;
1787 for ctl in mChildren do
1788 begin
1789 if cb(ctl) then begin result := ctl; exit; end;
1790 end;
1791 end;
1794 function TUIControl.forEachControl (cb: TCtlEnumCB; includeSelf: Boolean=true): TUIControl;
1796 function forChildren (p: TUIControl; incSelf: Boolean): TUIControl;
1797 var
1798 ctl: TUIControl;
1799 begin
1800 result := nil;
1801 if (p = nil) then exit;
1802 if (incSelf) and (cb(p)) then begin result := p; exit; end;
1803 for ctl in p.mChildren do
1804 begin
1805 result := forChildren(ctl, true);
1806 if (result <> nil) then break;
1807 end;
1808 end;
1810 begin
1811 result := nil;
1812 if (not assigned(cb)) then exit;
1813 result := forChildren(self, includeSelf);
1814 end;
1817 procedure TUIControl.close (); // this closes *top-level* control
1818 var
1819 ctl: TUIControl;
1820 begin
1821 ctl := topLevel;
1822 uiRemoveWindow(ctl);
1823 if (ctl is TUITopWindow) and (TUITopWindow(ctl).mFreeOnClose) then scheduleKill(ctl); // just in case
1824 end;
1827 procedure TUIControl.doAction ();
1828 begin
1829 if assigned(actionCB) then actionCB(self);
1830 end;
1833 // ////////////////////////////////////////////////////////////////////////// //
1834 procedure TUIControl.setScissor (lx, ly, lw, lh: Integer);
1835 var
1836 gx, gy, wdt, hgt, cgx, cgy: Integer;
1837 begin
1838 if (not intersectRect(lx, ly, lw, lh, 0, 0, mWidth, mHeight)) then
1839 begin
1840 uiContext.clip := TGxRect.Create(0, 0, 0, 0);
1841 exit;
1842 end;
1844 getDrawRect(gx, gy, wdt, hgt);
1846 toGlobal(lx, ly, cgx, cgy);
1847 if (not intersectRect(gx, gy, wdt, hgt, cgx, cgy, lw, lh)) then
1848 begin
1849 uiContext.clip := TGxRect.Create(0, 0, 0, 0);
1850 exit;
1851 end;
1853 uiContext.clip := savedClip;
1854 uiContext.combineClip(TGxRect.Create(gx, gy, wdt, hgt));
1855 //uiContext.clip := TGxRect.Create(gx, gy, wdt, hgt);
1856 end;
1860 // ////////////////////////////////////////////////////////////////////////// //
1861 procedure TUIControl.draw ();
1862 var
1863 f: Integer;
1864 gx, gy: Integer;
1866 procedure resetScissor (fullArea: Boolean); inline;
1867 begin
1868 uiContext.clip := savedClip;
1869 if (fullArea) then
1870 begin
1871 setScissor(0, 0, mWidth, mHeight);
1872 end
1873 else
1874 begin
1875 setScissor(mFrameWidth, mFrameHeight, mWidth-mFrameWidth*2, mHeight-mFrameHeight*2);
1876 end;
1877 end;
1879 begin
1880 if (mWidth < 1) or (mHeight < 1) or (uiContext = nil) or (not uiContext.active) then exit;
1881 toGlobal(0, 0, gx, gy);
1883 savedClip := uiContext.clip;
1884 try
1885 resetScissor(true); // full area
1886 drawControl(gx, gy);
1887 resetScissor(false); // client area
1888 for f := 0 to High(mChildren) do mChildren[f].draw();
1889 resetScissor(true); // full area
1890 drawControlPost(gx, gy);
1891 finally
1892 uiContext.clip := savedClip;
1893 end;
1894 end;
1896 procedure TUIControl.drawControl (gx, gy: Integer);
1897 begin
1898 //if (mParent = nil) then darkenRect(gx, gy, mWidth, mHeight, 64);
1899 end;
1901 procedure TUIControl.drawControlPost (gx, gy: Integer);
1902 begin
1903 // shadow
1904 if (mParent = nil) and (mDrawShadow) and (mWidth > 0) and (mHeight > 0) then
1905 begin
1906 //setScissorGLInternal(gx+8, gy+8, mWidth, mHeight);
1907 uiContext.resetClip();
1908 uiContext.darkenRect(gx+mWidth, gy+8, 8, mHeight, 128);
1909 uiContext.darkenRect(gx+8, gy+mHeight, mWidth-8, 8, 128);
1910 end;
1911 end;
1914 // ////////////////////////////////////////////////////////////////////////// //
1915 procedure TUIControl.mouseEvent (var ev: THMouseEvent);
1916 var
1917 ctl: TUIControl;
1918 begin
1919 if (not enabled) then exit;
1920 if (mWidth < 1) or (mHeight < 1) then exit;
1921 ctl := controlAtXY(ev.x, ev.y);
1922 if (ctl = nil) then exit;
1923 if (ctl.canFocus) and (ev.press) then
1924 begin
1925 if (ctl <> topLevel.mFocused) then ctl.setFocused(true);
1926 uiGrabCtl := ctl;
1927 end;
1928 if (ctl <> self) then ctl.mouseEvent(ev);
1929 //ev.eat();
1930 end;
1933 procedure TUIControl.keyEvent (var ev: THKeyEvent);
1935 function doPreKey (ctl: TUIControl): Boolean;
1936 begin
1937 if (not ctl.enabled) then begin result := false; exit; end;
1938 ctl.keyEventPre(ev);
1939 result := (ev.eaten) or (ev.cancelled); // stop if event was consumed
1940 end;
1942 function doPostKey (ctl: TUIControl): Boolean;
1943 begin
1944 if (not ctl.enabled) then begin result := false; exit; end;
1945 ctl.keyEventPost(ev);
1946 result := (ev.eaten) or (ev.cancelled); // stop if event was consumed
1947 end;
1949 var
1950 ctl: TUIControl;
1951 begin
1952 if (not enabled) then exit;
1953 if (ev.eaten) or (ev.cancelled) then exit;
1954 // call pre-key
1955 if (mParent = nil) then
1956 begin
1957 forEachControl(doPreKey);
1958 if (ev.eaten) or (ev.cancelled) then exit;
1959 end;
1960 // focused control should process keyboard first
1961 if (topLevel.mFocused <> self) and isMyChild(topLevel.mFocused) and (topLevel.mFocused.enabled) then
1962 begin
1963 // bubble keyboard event
1964 ctl := topLevel.mFocused;
1965 while (ctl <> nil) and (ctl <> self) do
1966 begin
1967 ctl.keyEvent(ev);
1968 if (ev.eaten) or (ev.cancelled) then exit;
1969 ctl := ctl.mParent;
1970 end;
1971 end;
1972 // for top-level controls
1973 if (mParent = nil) then
1974 begin
1975 if (ev = 'S-Tab') then
1976 begin
1977 ctl := findPrevFocus(mFocused, true);
1978 if (ctl <> nil) and (ctl <> mFocused) then ctl.setFocused(true);
1979 ev.eat();
1980 exit;
1981 end;
1982 if (ev = 'Tab') then
1983 begin
1984 ctl := findNextFocus(mFocused, true);
1985 if (ctl <> nil) and (ctl <> mFocused) then ctl.setFocused(true);
1986 ev.eat();
1987 exit;
1988 end;
1989 if (ev = 'Enter') or (ev = 'C-Enter') then
1990 begin
1991 ctl := findDefaulControl();
1992 if (ctl <> nil) then
1993 begin
1994 ev.eat();
1995 ctl.doAction();
1996 exit;
1997 end;
1998 end;
1999 if (ev = 'Escape') then
2000 begin
2001 ctl := findCancelControl();
2002 if (ctl <> nil) then
2003 begin
2004 ev.eat();
2005 ctl.doAction();
2006 exit;
2007 end;
2008 end;
2009 if mEscClose and (ev = 'Escape') then
2010 begin
2011 if (not assigned(closeRequestCB)) or (closeRequestCB(self)) then
2012 begin
2013 uiRemoveWindow(self);
2014 end;
2015 ev.eat();
2016 exit;
2017 end;
2018 // call post-keys
2019 if (ev.eaten) or (ev.cancelled) then exit;
2020 forEachControl(doPostKey);
2021 end;
2022 end;
2025 procedure TUIControl.keyEventPre (var ev: THKeyEvent);
2026 begin
2027 end;
2030 procedure TUIControl.keyEventPost (var ev: THKeyEvent);
2031 begin
2032 end;
2035 // ////////////////////////////////////////////////////////////////////////// //
2036 constructor TUITopWindow.Create (const atitle: AnsiString);
2037 begin
2038 inherited Create();
2039 mTitle := atitle;
2040 end;
2043 procedure TUITopWindow.AfterConstruction ();
2044 begin
2045 inherited;
2046 mFitToScreen := true;
2047 mFrameWidth := 8;
2048 mFrameHeight := 8;
2049 if (mWidth < mFrameWidth*2+uiContext.iconWinWidth(TGxContext.TWinIcon.Close)) then mWidth := mFrameWidth*2+uiContext.iconWinWidth(TGxContext.TWinIcon.Close);
2050 if (mHeight < mFrameHeight*2) then mHeight := mFrameHeight*2;
2051 if (Length(mTitle) > 0) then
2052 begin
2053 if (mWidth < uiContext.textWidth(mTitle)+mFrameWidth*2+uiContext.iconWinWidth(TGxContext.TWinIcon.Close)) then
2054 begin
2055 mWidth := uiContext.textWidth(mTitle)+mFrameWidth*2+uiContext.iconWinWidth(TGxContext.TWinIcon.Close);
2056 end;
2057 end;
2058 mCanFocus := false;
2059 mDragScroll := TXMode.None;
2060 mDrawShadow := true;
2061 mWaitingClose := false;
2062 mInClose := false;
2063 closeCB := nil;
2064 mCtl4Style := 'window';
2065 end;
2068 function TUITopWindow.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
2069 begin
2070 if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) then
2071 begin
2072 mTitle := par.expectIdOrStr(true);
2073 result := true;
2074 exit;
2075 end;
2076 if (strEquCI1251(prname, 'children')) then
2077 begin
2078 parseChildren(par);
2079 result := true;
2080 exit;
2081 end;
2082 if (strEquCI1251(prname, 'position')) then
2083 begin
2084 if (par.eatIdOrStrCI('default')) then mDoCenter := false
2085 else if (par.eatIdOrStrCI('center')) then mDoCenter := true
2086 else par.error('`center` or `default` expected');
2087 result := true;
2088 exit;
2089 end;
2090 if (parseOrientation(prname, par)) then begin result := true; exit; end;
2091 result := inherited parseProperty(prname, par);
2092 end;
2095 procedure TUITopWindow.flFitToScreen ();
2096 var
2097 nsz: TLaySize;
2098 begin
2099 nsz := TLaySize.Create(trunc(fuiScrWdt/fuiRenderScale)-mFrameWidth*2-6, trunc(fuiScrHgt/fuiRenderScale)-mFrameHeight*2-6);
2100 if (mMaxSize.w < 1) then mMaxSize.w := nsz.w;
2101 if (mMaxSize.h < 1) then mMaxSize.h := nsz.h;
2102 end;
2105 procedure TUITopWindow.centerInScreen ();
2106 begin
2107 if (mWidth > 0) and (mHeight > 0) then
2108 begin
2109 mX := trunc((fuiScrWdt/fuiRenderScale-mWidth)/2);
2110 mY := trunc((fuiScrHgt/fuiRenderScale-mHeight)/2);
2111 end;
2112 end;
2115 procedure TUITopWindow.drawControl (gx, gy: Integer);
2116 begin
2117 uiContext.color := mBackColor[getColorIndex];
2118 uiContext.fillRect(gx, gy, mWidth, mHeight);
2119 end;
2122 procedure TUITopWindow.drawControlPost (gx, gy: Integer);
2123 var
2124 cidx: Integer;
2125 tx, hgt, sbhgt, iwdt: Integer;
2126 begin
2127 cidx := getColorIndex;
2128 if (mDragScroll = TXMode.Drag) then
2129 begin
2130 uiContext.color := mFrameColor[cidx];
2131 uiContext.rect(gx+4, gy+4, mWidth-8, mHeight-8);
2132 end
2133 else
2134 begin
2135 uiContext.color := mFrameColor[cidx];
2136 uiContext.rect(gx+3, gy+3, mWidth-6, mHeight-6);
2137 uiContext.rect(gx+5, gy+5, mWidth-10, mHeight-10);
2138 // vertical scroll bar
2139 hgt := mHeight-mFrameHeight*2;
2140 if (hgt > 0) and (mFullSize.h > hgt) then
2141 begin
2142 //writeln(mTitle, ': height=', mHeight-mFrameHeight*2, '; fullsize=', mFullSize.toString);
2143 sbhgt := mHeight-mFrameHeight*2+2;
2144 uiContext.fillRect(gx+mWidth-mFrameWidth+1, gy+7, mFrameWidth-3, sbhgt);
2145 hgt += mScrollY;
2146 if (hgt > mFullSize.h) then hgt := mFullSize.h;
2147 hgt := sbhgt*hgt div mFullSize.h;
2148 if (hgt > 0) then
2149 begin
2150 setScissor(mWidth-mFrameWidth+1, 7, mFrameWidth-3, sbhgt);
2151 uiContext.darkenRect(gx+mWidth-mFrameWidth+1, gy+7+hgt, mFrameWidth-3, sbhgt, 128);
2152 end;
2153 end;
2154 // frame icon
2155 iwdt := uiContext.iconWinWidth(TGxContext.TWinIcon.Close);
2156 setScissor(mFrameWidth, 0, iwdt, 8);
2157 uiContext.color := mBackColor[cidx];
2158 uiContext.fillRect(gx+mFrameWidth, gy, iwdt, 8);
2159 uiContext.color := mFrameIconColor[cidx];
2160 uiContext.drawIconWin(TGxContext.TWinIcon.Close, gx+mFrameWidth, gy, mInClose);
2161 end;
2162 // title
2163 if (Length(mTitle) > 0) then
2164 begin
2165 iwdt := uiContext.iconWinWidth(TGxContext.TWinIcon.Close);
2166 setScissor(mFrameWidth+iwdt, 0, mWidth-mFrameWidth*2-iwdt, 8);
2167 tx := (gx+iwdt)+((mWidth-iwdt)-uiContext.textWidth(mTitle)) div 2;
2168 uiContext.color := mBackColor[cidx];
2169 uiContext.fillRect(tx-3, gy, uiContext.textWidth(mTitle)+3+2, 8);
2170 uiContext.color := mFrameTextColor[cidx];
2171 uiContext.drawText(tx, gy, mTitle);
2172 end;
2173 // shadow
2174 inherited drawControlPost(gx, gy);
2175 end;
2178 procedure TUITopWindow.activated ();
2179 begin
2180 if (mFocused = nil) or (mFocused = self) then
2181 begin
2182 mFocused := findFirstFocus();
2183 end;
2184 if (mFocused <> nil) and (mFocused <> self) then mFocused.activated();
2185 inherited;
2186 end;
2189 procedure TUITopWindow.blurred ();
2190 begin
2191 mDragScroll := TXMode.None;
2192 mWaitingClose := false;
2193 mInClose := false;
2194 if (mFocused <> nil) and (mFocused <> self) then mFocused.blurred();
2195 inherited;
2196 end;
2199 procedure TUITopWindow.keyEvent (var ev: THKeyEvent);
2200 begin
2201 inherited keyEvent(ev);
2202 if (ev.eaten) or (ev.cancelled) or (not enabled) {or (not getFocused)} then exit;
2203 if (ev = 'M-F3') then
2204 begin
2205 if (not assigned(closeRequestCB)) or (closeRequestCB(self)) then
2206 begin
2207 uiRemoveWindow(self);
2208 end;
2209 ev.eat();
2210 exit;
2211 end;
2212 end;
2215 procedure TUITopWindow.mouseEvent (var ev: THMouseEvent);
2216 var
2217 lx, ly: Integer;
2218 hgt, sbhgt: Integer;
2219 begin
2220 if (not enabled) then exit;
2221 if (mWidth < 1) or (mHeight < 1) then exit;
2223 if (mDragScroll = TXMode.Drag) then
2224 begin
2225 mX += ev.x-mDragStartX;
2226 mY += ev.y-mDragStartY;
2227 mDragStartX := ev.x;
2228 mDragStartY := ev.y;
2229 if (ev.release) and (ev.but = ev.Left) then mDragScroll := TXMode.None;
2230 ev.eat();
2231 exit;
2232 end;
2234 if (mDragScroll = TXMode.Scroll) then
2235 begin
2236 // check for vertical scrollbar
2237 ly := ev.y-mY;
2238 if (ly < 7) then
2239 begin
2240 mScrollY := 0;
2241 end
2242 else
2243 begin
2244 sbhgt := mHeight-mFrameHeight*2+2;
2245 hgt := mHeight-mFrameHeight*2;
2246 if (hgt > 0) and (mFullSize.h > hgt) then
2247 begin
2248 hgt := (mFullSize.h*(ly-7) div (sbhgt-1))-(mHeight-mFrameHeight*2);
2249 mScrollY := nmax(0, hgt);
2250 hgt := mHeight-mFrameHeight*2;
2251 if (mScrollY+hgt > mFullSize.h) then mScrollY := nmax(0, mFullSize.h-hgt);
2252 end;
2253 end;
2254 if (ev.release) and (ev.but = ev.Left) then mDragScroll := TXMode.None;
2255 ev.eat();
2256 exit;
2257 end;
2259 if toLocal(ev.x, ev.y, lx, ly) then
2260 begin
2261 if (ev.press) then
2262 begin
2263 if (ly < 8) then
2264 begin
2265 uiGrabCtl := self;
2266 if (lx >= mFrameWidth) and (lx < mFrameWidth+uiContext.iconWinWidth(TGxContext.TWinIcon.Close)) then
2267 begin
2268 //uiRemoveWindow(self);
2269 mWaitingClose := true;
2270 mInClose := true;
2271 end
2272 else
2273 begin
2274 mDragScroll := TXMode.Drag;
2275 mDragStartX := ev.x;
2276 mDragStartY := ev.y;
2277 end;
2278 ev.eat();
2279 exit;
2280 end;
2281 // check for vertical scrollbar
2282 if (lx >= mWidth-mFrameWidth+1) and (ly >= 7) and (ly < mHeight-mFrameHeight+1) then
2283 begin
2284 sbhgt := mHeight-mFrameHeight*2+2;
2285 hgt := mHeight-mFrameHeight*2;
2286 if (hgt > 0) and (mFullSize.h > hgt) then
2287 begin
2288 hgt := (mFullSize.h*(ly-7) div (sbhgt-1))-(mHeight-mFrameHeight*2);
2289 mScrollY := nmax(0, hgt);
2290 uiGrabCtl := self;
2291 mDragScroll := TXMode.Scroll;
2292 ev.eat();
2293 exit;
2294 end;
2295 end;
2296 // drag
2297 if (lx < mFrameWidth) or (lx >= mWidth-mFrameWidth) or (ly >= mHeight-mFrameHeight) then
2298 begin
2299 uiGrabCtl := self;
2300 mDragScroll := TXMode.Drag;
2301 mDragStartX := ev.x;
2302 mDragStartY := ev.y;
2303 ev.eat();
2304 exit;
2305 end;
2306 end;
2308 if (ev.release) then
2309 begin
2310 if mWaitingClose then
2311 begin
2312 if (lx >= mFrameWidth) and (lx < mFrameWidth+uiContext.iconWinWidth(TGxContext.TWinIcon.Close)) then
2313 begin
2314 if (not assigned(closeRequestCB)) or (closeRequestCB(self)) then
2315 begin
2316 uiRemoveWindow(self);
2317 end;
2318 end;
2319 mWaitingClose := false;
2320 mInClose := false;
2321 ev.eat();
2322 exit;
2323 end;
2324 end;
2326 if (ev.motion) then
2327 begin
2328 if mWaitingClose then
2329 begin
2330 mInClose := (lx >= mFrameWidth) and (lx < mFrameWidth+uiContext.iconWinWidth(TGxContext.TWinIcon.Close));
2331 ev.eat();
2332 exit;
2333 end;
2334 end;
2336 inherited mouseEvent(ev);
2337 end
2338 else
2339 begin
2340 mInClose := false;
2341 if (not ev.motion) and (mWaitingClose) then begin ev.eat(); mWaitingClose := false; exit; end;
2342 end;
2343 end;
2346 // ////////////////////////////////////////////////////////////////////////// //
2347 constructor TUIBox.Create (ahoriz: Boolean);
2348 begin
2349 inherited Create();
2350 mHoriz := ahoriz;
2351 end;
2354 procedure TUIBox.AfterConstruction ();
2355 begin
2356 inherited;
2357 mCanFocus := false;
2358 mHAlign := -1; // left
2359 mCtl4Style := 'box';
2360 end;
2363 procedure TUIBox.setCaption (const acap: AnsiString);
2364 begin
2365 mCaption := acap;
2366 mDefSize := TLaySize.Create(uiContext.textWidth(mCaption)+3, uiContext.textHeight(mCaption));
2367 end;
2370 procedure TUIBox.setHasFrame (v: Boolean);
2371 begin
2372 mHasFrame := v;
2373 if (mHasFrame) then begin mFrameWidth := 8; mFrameHeight := 8; end else begin mFrameWidth := 0; mFrameHeight := 0; end;
2374 if (mHasFrame) then mNoPad := true;
2375 end;
2378 function TUIBox.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
2379 begin
2380 if (parseOrientation(prname, par)) then begin result := true; exit; end;
2381 if (strEquCI1251(prname, 'padding')) then
2382 begin
2383 if (mHoriz) then mPadding := parseHPadding(par, 0) else mPadding := parseVPadding(par, 0);
2384 result := true;
2385 exit;
2386 end;
2387 if (strEquCI1251(prname, 'frame')) then
2388 begin
2389 setHasFrame(parseBool(par));
2390 result := true;
2391 exit;
2392 end;
2393 if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) then
2394 begin
2395 setCaption(par.expectIdOrStr(true));
2396 result := true;
2397 exit;
2398 end;
2399 if (strEquCI1251(prname, 'textalign')) or (strEquCI1251(prname, 'text-align')) then
2400 begin
2401 mHAlign := parseHAlign(par);
2402 result := true;
2403 exit;
2404 end;
2405 if (strEquCI1251(prname, 'children')) then
2406 begin
2407 parseChildren(par);
2408 result := true;
2409 exit;
2410 end;
2411 result := inherited parseProperty(prname, par);
2412 end;
2415 procedure TUIBox.drawControl (gx, gy: Integer);
2416 var
2417 cidx: Integer;
2418 xpos: Integer;
2419 begin
2420 cidx := getColorIndex;
2421 uiContext.color := mBackColor[cidx];
2422 uiContext.fillRect(gx, gy, mWidth, mHeight);
2423 if mHasFrame then
2424 begin
2425 // draw frame
2426 uiContext.color := mFrameColor[cidx];
2427 uiContext.rect(gx+3, gy+3, mWidth-6, mHeight-6);
2428 end;
2429 // draw caption
2430 if (Length(mCaption) > 0) then
2431 begin
2432 if (mHAlign < 0) then xpos := 3
2433 else if (mHAlign > 0) then xpos := mWidth-mFrameWidth*2-uiContext.textWidth(mCaption)
2434 else xpos := (mWidth-mFrameWidth*2-uiContext.textWidth(mCaption)) div 2;
2435 xpos += gx+mFrameWidth;
2437 setScissor(mFrameWidth+1, 0, mWidth-mFrameWidth-2, 8);
2438 if mHasFrame then
2439 begin
2440 uiContext.color := mBackColor[cidx];
2441 uiContext.fillRect(xpos-3, gy, uiContext.textWidth(mCaption)+4, 8);
2442 end;
2443 uiContext.color := mFrameTextColor[cidx];
2444 uiContext.drawText(xpos, gy, mCaption);
2445 end;
2446 end;
2449 procedure TUIBox.mouseEvent (var ev: THMouseEvent);
2450 var
2451 lx, ly: Integer;
2452 begin
2453 inherited mouseEvent(ev);
2454 if (not ev.eaten) and (not ev.cancelled) and (enabled) and toLocal(ev.x, ev.y, lx, ly) then
2455 begin
2456 ev.eat();
2457 end;
2458 end;
2461 procedure TUIBox.keyEvent (var ev: THKeyEvent);
2462 var
2463 dir: Integer = 0;
2464 cur, ctl: TUIControl;
2465 begin
2466 inherited keyEvent(ev);
2467 if (ev.eaten) or (ev.cancelled) or (not ev.press) or (not enabled) or (not getActive) then exit;
2468 if (Length(mChildren) = 0) then exit;
2469 if (mHoriz) and (ev = 'Left') then dir := -1
2470 else if (mHoriz) and (ev = 'Right') then dir := 1
2471 else if (not mHoriz) and (ev = 'Up') then dir := -1
2472 else if (not mHoriz) and (ev = 'Down') then dir := 1;
2473 if (dir = 0) then exit;
2474 ev.eat();
2475 cur := topLevel.mFocused;
2476 while (cur <> nil) and (cur.mParent <> self) do cur := cur.mParent;
2477 //if (cur = nil) then writeln('CUR: nil') else writeln('CUR: ', cur.className, '#', cur.id);
2478 if (dir < 0) then ctl := findPrevFocus(cur, true) else ctl := findNextFocus(cur, true);
2479 //if (ctl = nil) then writeln('CTL: nil') else writeln('CTL: ', ctl.className, '#', ctl.id);
2480 if (ctl <> nil) and (ctl <> self) then
2481 begin
2482 ctl.focused := true;
2483 end;
2484 end;
2487 // ////////////////////////////////////////////////////////////////////////// //
2488 constructor TUIHBox.Create ();
2489 begin
2490 end;
2493 procedure TUIHBox.AfterConstruction ();
2494 begin
2495 inherited;
2496 mHoriz := true;
2497 end;
2500 // ////////////////////////////////////////////////////////////////////////// //
2501 constructor TUIVBox.Create ();
2502 begin
2503 end;
2506 procedure TUIVBox.AfterConstruction ();
2507 begin
2508 inherited;
2509 mHoriz := false;
2510 end;
2513 // ////////////////////////////////////////////////////////////////////////// //
2514 procedure TUISpan.AfterConstruction ();
2515 begin
2516 inherited;
2517 mExpand := true;
2518 mCanFocus := false;
2519 mNoPad := true;
2520 mCtl4Style := 'span';
2521 end;
2524 function TUISpan.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
2525 begin
2526 if (parseOrientation(prname, par)) then begin result := true; exit; end;
2527 result := inherited parseProperty(prname, par);
2528 end;
2531 procedure TUISpan.drawControl (gx, gy: Integer);
2532 begin
2533 end;
2536 // ////////////////////////////////////////////////////////////////////// //
2537 procedure TUILine.AfterConstruction ();
2538 begin
2539 inherited;
2540 mCanFocus := false;
2541 mExpand := true;
2542 mCanFocus := false;
2543 mCtl4Style := 'line';
2544 end;
2547 function TUILine.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
2548 begin
2549 if (parseOrientation(prname, par)) then begin result := true; exit; end;
2550 result := inherited parseProperty(prname, par);
2551 end;
2554 procedure TUILine.drawControl (gx, gy: Integer);
2555 var
2556 cidx: Integer;
2557 begin
2558 cidx := getColorIndex;
2559 uiContext.color := mTextColor[cidx];
2560 if mHoriz then uiContext.hline(gx, gy+(mHeight div 2), mWidth)
2561 else uiContext.vline(gx+(mWidth div 2), gy, mHeight);
2562 end;
2565 // ////////////////////////////////////////////////////////////////////////// //
2566 procedure TUIHLine.AfterConstruction ();
2567 begin
2568 inherited;
2569 mHoriz := true;
2570 mDefSize.h := 7;
2571 end;
2574 // ////////////////////////////////////////////////////////////////////////// //
2575 procedure TUIVLine.AfterConstruction ();
2576 begin
2577 inherited;
2578 mHoriz := false;
2579 mDefSize.w := 7;
2580 end;
2583 // ////////////////////////////////////////////////////////////////////////// //
2584 procedure TUIStaticText.AfterConstruction ();
2585 begin
2586 inherited;
2587 mCanFocus := false;
2588 mHAlign := -1;
2589 mVAlign := 0;
2590 mHoriz := true; // nobody cares
2591 mHeader := false;
2592 mLine := false;
2593 mDefSize.h := uiContext.charHeight(' ');
2594 mCtl4Style := 'static';
2595 end;
2598 procedure TUIStaticText.setText (const atext: AnsiString);
2599 begin
2600 mText := atext;
2601 mDefSize := TLaySize.Create(uiContext.textWidth(mText), uiContext.textHeight(mText));
2602 end;
2605 function TUIStaticText.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
2606 begin
2607 if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) or (strEquCI1251(prname, 'text')) then
2608 begin
2609 setText(par.expectIdOrStr(true));
2610 result := true;
2611 exit;
2612 end;
2613 if (strEquCI1251(prname, 'textalign')) or (strEquCI1251(prname, 'text-align')) then
2614 begin
2615 parseTextAlign(par, mHAlign, mVAlign);
2616 result := true;
2617 exit;
2618 end;
2619 if (strEquCI1251(prname, 'header')) then
2620 begin
2621 mHeader := true;
2622 result := true;
2623 exit;
2624 end;
2625 if (strEquCI1251(prname, 'line')) then
2626 begin
2627 mLine := true;
2628 result := true;
2629 exit;
2630 end;
2631 result := inherited parseProperty(prname, par);
2632 end;
2635 procedure TUIStaticText.drawControl (gx, gy: Integer);
2636 var
2637 xpos, ypos: Integer;
2638 cidx: Integer;
2639 begin
2640 cidx := getColorIndex;
2641 uiContext.color := mBackColor[cidx];
2642 uiContext.fillRect(gx, gy, mWidth, mHeight);
2644 if (mHAlign < 0) then xpos := 0
2645 else if (mHAlign > 0) then xpos := mWidth-uiContext.textWidth(mText)
2646 else xpos := (mWidth-uiContext.textWidth(mText)) div 2;
2648 if (Length(mText) > 0) then
2649 begin
2650 if (mHeader) then uiContext.color := mFrameTextColor[cidx] else uiContext.color := mTextColor[cidx];
2652 if (mVAlign < 0) then ypos := 0
2653 else if (mVAlign > 0) then ypos := mHeight-uiContext.textHeight(mText)
2654 else ypos := (mHeight-uiContext.textHeight(mText)) div 2;
2656 uiContext.drawText(gx+xpos, gy+ypos, mText);
2657 end;
2659 if (mLine) then
2660 begin
2661 if (mHeader) then uiContext.color := mFrameColor[cidx] else uiContext.color := mTextColor[cidx];
2663 if (mVAlign < 0) then ypos := 0
2664 else if (mVAlign > 0) then ypos := mHeight-1
2665 else ypos := (mHeight div 2);
2666 ypos += gy;
2668 if (Length(mText) = 0) then
2669 begin
2670 uiContext.hline(gx, ypos, mWidth);
2671 end
2672 else
2673 begin
2674 uiContext.hline(gx, ypos, xpos-1);
2675 uiContext.hline(gx+xpos+uiContext.textWidth(mText), ypos, mWidth);
2676 end;
2677 end;
2678 end;
2681 // ////////////////////////////////////////////////////////////////////////// //
2682 procedure TUITextLabel.AfterConstruction ();
2683 begin
2684 inherited;
2685 mHAlign := -1;
2686 mVAlign := 0;
2687 mCanFocus := false;
2688 mDefSize := TLaySize.Create(uiContext.textWidth(mText), uiContext.textHeight(mText));
2689 mCtl4Style := 'label';
2690 mLinkId := '';
2691 end;
2694 procedure TUITextLabel.cacheStyle (root: TUIStyle);
2695 begin
2696 inherited cacheStyle(root);
2697 // active
2698 mHotColor[ClrIdxActive] := root.get('hot-color', 'active', mCtl4Style).asRGBADef(TGxRGBA.Create(0, 128, 0));
2699 // disabled
2700 mHotColor[ClrIdxDisabled] := root.get('hot-color', 'disabled', mCtl4Style).asRGBADef(TGxRGBA.Create(0, 64, 0));
2701 // inactive
2702 mHotColor[ClrIdxInactive] := root.get('hot-color', 'inactive', mCtl4Style).asRGBADef(TGxRGBA.Create(0, 64, 0));
2703 end;
2706 procedure TUITextLabel.setText (const s: AnsiString);
2707 var
2708 f: Integer;
2709 begin
2710 mText := '';
2711 mHotChar := #0;
2712 mHotOfs := 0;
2713 f := 1;
2714 while (f <= Length(s)) do
2715 begin
2716 if (s[f] = '\\') then
2717 begin
2718 Inc(f);
2719 if (f <= Length(s)) then mText += s[f];
2720 Inc(f);
2721 end
2722 else if (s[f] = '~') then
2723 begin
2724 Inc(f);
2725 if (f <= Length(s)) then
2726 begin
2727 if (mHotChar = #0) then
2728 begin
2729 mHotChar := s[f];
2730 mHotOfs := Length(mText);
2731 end;
2732 mText += s[f];
2733 end;
2734 Inc(f);
2735 end
2736 else
2737 begin
2738 mText += s[f];
2739 Inc(f);
2740 end;
2741 end;
2742 // fix hotchar offset
2743 if (mHotChar <> #0) and (mHotOfs > 0) then
2744 begin
2745 mHotOfs := uiContext.textWidth(Copy(mText, 1, mHotOfs+1))-uiContext.charWidth(mText[mHotOfs+1]);
2746 end;
2747 // fix size
2748 mDefSize := TLaySize.Create(uiContext.textWidth(mText), uiContext.textHeight(mText));
2749 end;
2752 function TUITextLabel.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
2753 begin
2754 if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) or (strEquCI1251(prname, 'text')) then
2755 begin
2756 setText(par.expectIdOrStr(true));
2757 result := true;
2758 exit;
2759 end;
2760 if (strEquCI1251(prname, 'link')) then
2761 begin
2762 mLinkId := par.expectIdOrStr(true);
2763 result := true;
2764 exit;
2765 end;
2766 if (strEquCI1251(prname, 'textalign')) or (strEquCI1251(prname, 'text-align')) then
2767 begin
2768 parseTextAlign(par, mHAlign, mVAlign);
2769 result := true;
2770 exit;
2771 end;
2772 result := inherited parseProperty(prname, par);
2773 end;
2776 procedure TUITextLabel.drawControl (gx, gy: Integer);
2777 var
2778 xpos, ypos: Integer;
2779 cidx: Integer;
2780 begin
2781 cidx := getColorIndex;
2782 uiContext.color := mBackColor[cidx];
2783 uiContext.fillRect(gx, gy, mWidth, mHeight);
2784 if (Length(mText) > 0) then
2785 begin
2786 if (mHAlign < 0) then xpos := 0
2787 else if (mHAlign > 0) then xpos := mWidth-uiContext.textWidth(mText)
2788 else xpos := (mWidth-uiContext.textWidth(mText)) div 2;
2790 if (mVAlign < 0) then ypos := 0
2791 else if (mVAlign > 0) then ypos := mHeight-uiContext.textHeight(mText)
2792 else ypos := (mHeight-uiContext.textHeight(mText)) div 2;
2794 uiContext.color := mTextColor[cidx];
2795 uiContext.drawText(gx+xpos, gy+ypos, mText);
2797 if (Length(mLinkId) > 0) and (mHotChar <> #0) and (mHotChar <> ' ') then
2798 begin
2799 uiContext.color := mHotColor[cidx];
2800 uiContext.drawChar(gx+xpos+mHotOfs, gy+ypos, mHotChar);
2801 end;
2802 end;
2803 end;
2806 procedure TUITextLabel.mouseEvent (var ev: THMouseEvent);
2807 var
2808 lx, ly: Integer;
2809 begin
2810 inherited mouseEvent(ev);
2811 if (not ev.eaten) and (not ev.cancelled) and (enabled) and toLocal(ev.x, ev.y, lx, ly) then
2812 begin
2813 ev.eat();
2814 end;
2815 end;
2818 procedure TUITextLabel.doAction ();
2819 var
2820 ctl: TUIControl;
2821 begin
2822 if (assigned(actionCB)) then
2823 begin
2824 actionCB(self);
2825 end
2826 else
2827 begin
2828 ctl := topLevel[mLinkId];
2829 if (ctl <> nil) then
2830 begin
2831 if (ctl.canFocus) then ctl.focused := true;
2832 end;
2833 end;
2834 end;
2837 procedure TUITextLabel.keyEventPost (var ev: THKeyEvent);
2838 begin
2839 if (not enabled) then exit;
2840 if (mHotChar = #0) then exit;
2841 if (ev.eaten) or (ev.cancelled) or (not ev.press) then exit;
2842 if (ev.kstate <> ev.ModAlt) then exit;
2843 if (not ev.isHot(mHotChar)) then exit;
2844 ev.eat();
2845 if (canFocus) then focused := true;
2846 doAction();
2847 end;
2850 // ////////////////////////////////////////////////////////////////////////// //
2851 procedure TUIButton.AfterConstruction ();
2852 begin
2853 inherited;
2854 mHAlign := -1;
2855 mVAlign := 0;
2856 mCanFocus := true;
2857 mDefSize := TLaySize.Create(uiContext.textWidth(mText)+8*2, uiContext.textHeight(mText)+2);
2858 mCtl4Style := 'button';
2859 end;
2862 procedure TUIButton.setText (const s: AnsiString);
2863 begin
2864 inherited setText(s);
2865 mDefSize := TLaySize.Create(uiContext.textWidth(mText)+8*2, uiContext.textHeight(mText)+2);
2866 end;
2869 procedure TUIButton.drawControl (gx, gy: Integer);
2870 var
2871 xpos, ypos: Integer;
2872 cidx: Integer;
2873 begin
2874 cidx := getColorIndex;
2876 uiContext.color := mBackColor[cidx];
2877 uiContext.fillRect(gx+1, gy, mWidth-2, mHeight);
2878 uiContext.fillRect(gx, gy+1, 1, mHeight-2);
2879 uiContext.fillRect(gx+mWidth-1, gy+1, 1, mHeight-2);
2881 if (Length(mText) > 0) then
2882 begin
2883 if (mHAlign < 0) then xpos := 0
2884 else if (mHAlign > 0) then xpos := mWidth-uiContext.textWidth(mText)
2885 else xpos := (mWidth-uiContext.textWidth(mText)) div 2;
2887 if (mVAlign < 0) then ypos := 0
2888 else if (mVAlign > 0) then ypos := mHeight-uiContext.textHeight(mText)
2889 else ypos := (mHeight-uiContext.textHeight(mText)) div 2;
2891 setScissor(8, 0, mWidth-16, mHeight);
2892 uiContext.color := mTextColor[cidx];
2893 uiContext.drawText(gx+xpos+8, gy+ypos, mText);
2895 if (mHotChar <> #0) and (mHotChar <> ' ') then
2896 begin
2897 uiContext.color := mHotColor[cidx];
2898 uiContext.drawChar(gx+xpos+8+mHotOfs, gy+ypos, mHotChar);
2899 end;
2900 end;
2901 end;
2904 procedure TUIButton.mouseEvent (var ev: THMouseEvent);
2905 var
2906 lx, ly: Integer;
2907 begin
2908 inherited mouseEvent(ev);
2909 if (uiGrabCtl = self) then
2910 begin
2911 ev.eat();
2912 if (ev = '-lmb') and focused and toLocal(ev.x, ev.y, lx, ly) then
2913 begin
2914 doAction();
2915 end;
2916 exit;
2917 end;
2918 if (ev.eaten) or (ev.cancelled) or (not enabled) or not focused then exit;
2919 ev.eat();
2920 end;
2923 procedure TUIButton.keyEvent (var ev: THKeyEvent);
2924 begin
2925 inherited keyEvent(ev);
2926 if (not ev.eaten) and (not ev.cancelled) and (enabled) then
2927 begin
2928 if (ev = 'Enter') or (ev = 'Space') then
2929 begin
2930 ev.eat();
2931 doAction();
2932 exit;
2933 end;
2934 end;
2935 end;
2938 // ////////////////////////////////////////////////////////////////////////// //
2939 procedure TUISwitchBox.AfterConstruction ();
2940 begin
2941 inherited;
2942 mHAlign := -1;
2943 mVAlign := 0;
2944 mCanFocus := true;
2945 mIcon := TGxContext.TMarkIcon.Checkbox;
2946 mDefSize := TLaySize.Create(uiContext.textWidth(mText)+3+uiContext.iconMarkWidth(mIcon), uiContext.iconMarkHeight(mIcon));
2947 mCtl4Style := 'switchbox';
2948 mChecked := false;
2949 mBoolVar := @mChecked;
2950 end;
2953 procedure TUISwitchBox.cacheStyle (root: TUIStyle);
2954 begin
2955 inherited cacheStyle(root);
2956 // active
2957 mSwitchColor[ClrIdxActive] := root.get('switch-color', 'active', mCtl4Style).asRGBADef(TGxRGBA.Create(255, 255, 255));
2958 // disabled
2959 mSwitchColor[ClrIdxDisabled] := root.get('switch-color', 'disabled', mCtl4Style).asRGBADef(TGxRGBA.Create(255, 255, 255));
2960 // inactive
2961 mSwitchColor[ClrIdxInactive] := root.get('switch-color', 'inactive', mCtl4Style).asRGBADef(TGxRGBA.Create(255, 255, 255));
2962 end;
2965 procedure TUISwitchBox.setText (const s: AnsiString);
2966 begin
2967 inherited setText(s);
2968 mDefSize := TLaySize.Create(uiContext.textWidth(mText)+3+uiContext.iconMarkWidth(mIcon), uiContext.iconMarkHeight(mIcon));
2969 end;
2972 function TUISwitchBox.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
2973 begin
2974 if (strEquCI1251(prname, 'checked')) then
2975 begin
2976 result := true;
2977 setChecked(true);
2978 exit;
2979 end;
2980 result := inherited parseProperty(prname, par);
2981 end;
2984 function TUISwitchBox.getChecked (): Boolean;
2985 begin
2986 if (mBoolVar <> nil) then result := mBoolVar^ else result := false;
2987 end;
2990 procedure TUISwitchBox.setVar (pvar: PBoolean);
2991 begin
2992 if (pvar = nil) then pvar := @mChecked;
2993 if (pvar <> mBoolVar) then
2994 begin
2995 mBoolVar := pvar;
2996 setChecked(mBoolVar^);
2997 end;
2998 end;
3001 procedure TUISwitchBox.drawControl (gx, gy: Integer);
3002 var
3003 xpos, ypos: Integer;
3004 cidx: Integer;
3005 begin
3006 cidx := getColorIndex;
3008 if (mHAlign < 0) then xpos := 0
3009 else if (mHAlign > 0) then xpos := mWidth-(uiContext.textWidth(mText)+3+uiContext.iconMarkWidth(mIcon))
3010 else xpos := (mWidth-(uiContext.textWidth(mText)+3+uiContext.iconMarkWidth(mIcon))) div 2;
3012 if (mVAlign < 0) then ypos := 0
3013 else if (mVAlign > 0) then ypos := mHeight-uiContext.iconMarkHeight(mIcon)
3014 else ypos := (mHeight-uiContext.iconMarkHeight(mIcon)) div 2;
3016 uiContext.color := mBackColor[cidx];
3017 uiContext.fillRect(gx, gy, mWidth, mHeight);
3019 uiContext.color := mSwitchColor[cidx];
3020 uiContext.drawIconMark(mIcon, gx, gy, checked);
3022 if (mVAlign < 0) then ypos := 0
3023 else if (mVAlign > 0) then ypos := mHeight-uiContext.textHeight(mText)
3024 else ypos := (mHeight-uiContext.textHeight(mText)) div 2;
3026 uiContext.color := mTextColor[cidx];
3027 uiContext.drawText(gx+xpos+3+uiContext.iconMarkWidth(mIcon), gy+ypos, mText);
3029 if (mHotChar <> #0) and (mHotChar <> ' ') then
3030 begin
3031 uiContext.color := mHotColor[cidx];
3032 uiContext.drawChar(gx+xpos+3+uiContext.iconMarkWidth(mIcon)+mHotOfs, gy+ypos, mHotChar);
3033 end;
3034 end;
3037 procedure TUISwitchBox.mouseEvent (var ev: THMouseEvent);
3038 var
3039 lx, ly: Integer;
3040 begin
3041 inherited mouseEvent(ev);
3042 if (uiGrabCtl = self) then
3043 begin
3044 ev.eat();
3045 if (ev = '-lmb') and focused and toLocal(ev.x, ev.y, lx, ly) then
3046 begin
3047 doAction();
3048 end;
3049 exit;
3050 end;
3051 if (ev.eaten) or (ev.cancelled) or (not enabled) or not focused then exit;
3052 ev.eat();
3053 end;
3056 procedure TUISwitchBox.keyEvent (var ev: THKeyEvent);
3057 begin
3058 inherited keyEvent(ev);
3059 if (not ev.eaten) and (not ev.cancelled) and (enabled) then
3060 begin
3061 if (ev = 'Space') then
3062 begin
3063 ev.eat();
3064 doAction();
3065 exit;
3066 end;
3067 end;
3068 end;
3071 // ////////////////////////////////////////////////////////////////////////// //
3072 procedure TUICheckBox.AfterConstruction ();
3073 begin
3074 inherited;
3075 mChecked := false;
3076 mBoolVar := @mChecked;
3077 mIcon := TGxContext.TMarkIcon.Checkbox;
3078 setText('');
3079 end;
3082 procedure TUICheckBox.setChecked (v: Boolean);
3083 begin
3084 mBoolVar^ := v;
3085 end;
3088 procedure TUICheckBox.doAction ();
3089 begin
3090 if (assigned(actionCB)) then
3091 begin
3092 actionCB(self);
3093 end
3094 else
3095 begin
3096 setChecked(not getChecked);
3097 end;
3098 end;
3101 // ////////////////////////////////////////////////////////////////////////// //
3102 procedure TUIRadioBox.AfterConstruction ();
3103 begin
3104 inherited;
3105 mChecked := false;
3106 mBoolVar := @mChecked;
3107 mRadioGroup := '';
3108 mIcon := TGxContext.TMarkIcon.Radiobox;
3109 setText('');
3110 end;
3113 function TUIRadioBox.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
3114 begin
3115 if (strEquCI1251(prname, 'group')) then
3116 begin
3117 mRadioGroup := par.expectIdOrStr(true);
3118 if (getChecked) then setChecked(true);
3119 result := true;
3120 exit;
3121 end;
3122 if (strEquCI1251(prname, 'checked')) then
3123 begin
3124 result := true;
3125 setChecked(true);
3126 exit;
3127 end;
3128 result := inherited parseProperty(prname, par);
3129 end;
3132 procedure TUIRadioBox.setChecked (v: Boolean);
3134 function resetGroup (ctl: TUIControl): Boolean;
3135 begin
3136 result := false;
3137 if (ctl <> self) and (ctl is TUIRadioBox) and (TUIRadioBox(ctl).mRadioGroup = mRadioGroup) then
3138 begin
3139 TUIRadioBox(ctl).mBoolVar^ := false;
3140 end;
3141 end;
3143 begin
3144 mBoolVar^ := v;
3145 if v then topLevel.forEachControl(resetGroup);
3146 end;
3149 procedure TUIRadioBox.doAction ();
3150 begin
3151 if (assigned(actionCB)) then
3152 begin
3153 actionCB(self);
3154 end
3155 else
3156 begin
3157 setChecked(true);
3158 end;
3159 end;
3162 // ////////////////////////////////////////////////////////////////////////// //
3163 initialization
3164 registerCtlClass(TUIHBox, 'hbox');
3165 registerCtlClass(TUIVBox, 'vbox');
3166 registerCtlClass(TUISpan, 'span');
3167 registerCtlClass(TUIHLine, 'hline');
3168 registerCtlClass(TUIVLine, 'vline');
3169 registerCtlClass(TUITextLabel, 'label');
3170 registerCtlClass(TUIStaticText, 'static');
3171 registerCtlClass(TUIButton, 'button');
3172 registerCtlClass(TUICheckBox, 'checkbox');
3173 registerCtlClass(TUIRadioBox, 'radiobox');
3175 uiContext := TGxContext.Create();
3176 end.