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;
  20
  21 interface
  22
  23 uses
  24   SysUtils, Classes,
  25   SDL2,
  26   sdlcarcass,
  27   fui_common, fui_events, fui_style,
  28   fui_gfx_gl,
  29   xparser;
  30
  31
  32 // ////////////////////////////////////////////////////////////////////////// //
  33 type
  34   TUIControlClass = class of TUIControl;
  35
  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
  40
  41     // return `true` to stop
  42     type TCtlEnumCB = function (ctl: TUIControl): Boolean is nested;
  43
  44   public
  45     const ClrIdxActive = 0;
  46     const ClrIdxDisabled = 1;
  47     const ClrIdxInactive = 2;
  48     const ClrIdxMax = 2;
  49
  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     mStyleLoaded: Boolean;
  68     mCtl4Style: AnsiString;
  69     mBackColor: array[0..ClrIdxMax] of TGxRGBA;
  70     mTextColor: array[0..ClrIdxMax] of TGxRGBA;
  71     mFrameColor: array[0..ClrIdxMax] of TGxRGBA;
  72     mFrameTextColor: array[0..ClrIdxMax] of TGxRGBA;
  73     mFrameIconColor: array[0..ClrIdxMax] of TGxRGBA;
  74     mDarken: array[0..ClrIdxMax] of Integer; // >255: none
  75
  76   protected
  77     procedure updateStyle (); virtual;
  78     procedure cacheStyle (root: TUIStyle); virtual;
  79     function getColorIndex (): Integer; inline;
  80
  81   protected
  82     function getEnabled (): Boolean;
  83     procedure setEnabled (v: Boolean); inline;
  84
  85     function getFocused (): Boolean; inline;
  86     procedure setFocused (v: Boolean); inline;
  87
  88     function getActive (): Boolean; inline;
  89
  90     function getCanFocus (): Boolean; inline;
  91
  92     function isMyChild (ctl: TUIControl): Boolean;
  93
  94     function findFirstFocus (): TUIControl;
  95     function findLastFocus (): TUIControl;
  96
  97     function findNextFocus (cur: TUIControl; wrap: Boolean): TUIControl;
  98     function findPrevFocus (cur: TUIControl; wrap: Boolean): TUIControl;
  99
 100     function findCancelControl (): TUIControl;
 101     function findDefaulControl (): TUIControl;
 102
 103     function findControlById (const aid: AnsiString): TUIControl;
 104
 105     procedure activated (); virtual;
 106     procedure blurred (); virtual;
 107
 108     procedure calcFullClientSize ();
 109
 110     procedure drawFrame (gx, gy, resx, thalign: Integer; const text: AnsiString; dbl: Boolean);
 111
 112   protected
 113     var savedClip: TGxRect; // valid only in `draw*()` calls
 114     //WARNING! do not call scissor functions outside `.draw*()` API!
 115     // set scissor to this rect (in local coords)
 116     procedure setScissor (lx, ly, lw, lh: Integer); // valid only in `draw*()` calls
 117
 118   public
 119     actionCB: TActionCB;
 120     closeRequestCB: TCloseRequestCB;
 121
 122   private
 123     mDefSize: TLaySize; // default size
 124     mMaxSize: TLaySize; // maximum size
 125     mFlex: Integer;
 126     mHoriz: Boolean;
 127     mHGroup: AnsiString;
 128     mVGroup: AnsiString;
 129     mAlign: Integer;
 130     mExpand: Boolean;
 131     mLayDefSize: TLaySize;
 132     mLayMaxSize: TLaySize;
 133     mFullSize: TLaySize;
 134     mNoPad: Boolean;
 135     mPadding: TLaySize;
 136
 137   public
 138     // layouter interface
 139     function getDefSize (): TLaySize; inline; // default size; <0: use max size
 140     //procedure setDefSize (const sz: TLaySize); inline; // default size; <0: use max size
 141     function getMargins (): TLayMargins; inline;
 142     function getPadding (): TLaySize; inline; // children padding (each non-first child will get this on left/top)
 143     function getMaxSize (): TLaySize; inline; // max size; <0: set to some huge value
 144     //procedure setMaxSize (const sz: TLaySize); inline; // max size; <0: set to some huge value
 145     function getFlex (): Integer; inline; // <=0: not flexible
 146     function isHorizBox (): Boolean; inline; // horizontal layout for children?
 147     function noPad (): Boolean; inline; // ignore padding in box direction for this control
 148     function getAlign (): Integer; inline; // aligning in non-main direction: <0: left/up; 0: center; >0: right/down
 149     function getExpand (): Boolean; inline; // expanding in non-main direction: `true` will ignore align and eat all available space
 150     function getHGroup (): AnsiString; inline; // empty: not grouped
 151     function getVGroup (): AnsiString; inline; // empty: not grouped
 152
 153     procedure setActualSizePos (constref apos: TLayPos; constref asize: TLaySize); inline;
 154
 155     procedure layPrepare (); virtual; // called before registering control in layouter
 156
 157   public
 158     property flex: Integer read mFlex write mFlex;
 159     property flDefaultSize: TLaySize read mDefSize write mDefSize;
 160     property flMaxSize: TLaySize read mMaxSize write mMaxSize;
 161     property flPadding: TLaySize read mPadding write mPadding;
 162     property flHoriz: Boolean read mHoriz write mHoriz;
 163     property flAlign: Integer read mAlign write mAlign;
 164     property flExpand: Boolean read mExpand write mExpand;
 165     property flHGroup: AnsiString read mHGroup write mHGroup;
 166     property flVGroup: AnsiString read mVGroup write mVGroup;
 167     property flNoPad: Boolean read mNoPad write mNoPad;
 168     property fullSize: TLaySize read mFullSize;
 169
 170   protected
 171     function parsePos (par: TTextParser): TLayPos;
 172     function parseSize (par: TTextParser): TLaySize;
 173     function parsePadding (par: TTextParser): TLaySize;
 174     function parseHPadding (par: TTextParser; def: Integer): TLaySize;
 175     function parseVPadding (par: TTextParser; def: Integer): TLaySize;
 176     function parseBool (par: TTextParser): Boolean;
 177     function parseAnyAlign (par: TTextParser): Integer;
 178     function parseHAlign (par: TTextParser): Integer;
 179     function parseVAlign (par: TTextParser): Integer;
 180     function parseOrientation (const prname: AnsiString; par: TTextParser): Boolean;
 181     procedure parseTextAlign (par: TTextParser; var h, v: Integer);
 182     procedure parseChildren (par: TTextParser); // par should be on '{'; final '}' is eaten
 183
 184   public
 185     // par is on property data
 186     // there may be more data in text stream, don't eat it!
 187     // return `true` if property name is valid and value was parsed
 188     // return `false` if property name is invalid; don't advance parser in this case
 189     // throw on property data errors
 190     function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; virtual;
 191
 192     // par should be on '{'; final '}' is eaten
 193     procedure parseProperties (par: TTextParser);
 194
 195   public
 196     constructor Create ();
 197     destructor Destroy (); override;
 198
 199     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 200
 201     // `sx` and `sy` are screen coordinates
 202     procedure drawControl (gx, gy: Integer); virtual;
 203
 204     // called after all children drawn
 205     procedure drawControlPost (gx, gy: Integer); virtual;
 206
 207     procedure draw (); virtual;
 208
 209     function topLevel (): TUIControl; inline;
 210
 211     // returns `true` if global coords are inside this control
 212     function toLocal (var x, y: Integer): Boolean;
 213     function toLocal (gx, gy: Integer; out x, y: Integer): Boolean; inline;
 214     procedure toGlobal (var x, y: Integer);
 215     procedure toGlobal (lx, ly: Integer; out x, y: Integer); inline;
 216
 217     procedure getDrawRect (out gx, gy, wdt, hgt: Integer);
 218
 219     // x and y are global coords
 220     function controlAtXY (x, y: Integer; allowDisabled: Boolean=false): TUIControl;
 221
 222     function parentScrollX (): Integer; inline;
 223     function parentScrollY (): Integer; inline;
 224
 225     procedure makeVisibleInParent ();
 226
 227     procedure doAction (); virtual; // so user controls can override it
 228
 229     procedure mouseEvent (var ev: THMouseEvent); virtual; // returns `true` if event was eaten
 230     procedure keyEvent (var ev: THKeyEvent); virtual; // returns `true` if event was eaten
 231     procedure keyEventPre (var ev: THKeyEvent); virtual; // will be called before dispatching the event
 232     procedure keyEventPost (var ev: THKeyEvent); virtual; // will be called after if nobody processed the event
 233
 234     function prevSibling (): TUIControl;
 235     function nextSibling (): TUIControl;
 236     function firstChild (): TUIControl; inline;
 237     function lastChild (): TUIControl; inline;
 238
 239     procedure appendChild (ctl: TUIControl); virtual;
 240
 241     function setActionCBFor (const aid: AnsiString; cb: TActionCB): TActionCB; // returns previous cb
 242
 243     function forEachChildren (cb: TCtlEnumCB): TUIControl; // doesn't recurse
 244     function forEachControl (cb: TCtlEnumCB; includeSelf: Boolean=true): TUIControl;
 245
 246     procedure close (); // this closes *top-level* control
 247
 248   public
 249     property id: AnsiString read mId write mId;
 250     property styleId: AnsiString read mStyleId;
 251     property scrollX: Integer read mScrollX write mScrollX;
 252     property scrollY: Integer read mScrollY write mScrollY;
 253     property x0: Integer read mX write mX;
 254     property y0: Integer read mY write mY;
 255     property width: Integer read mWidth write mWidth;
 256     property height: Integer read mHeight write mHeight;
 257     property enabled: Boolean read getEnabled write setEnabled;
 258     property parent: TUIControl read mParent;
 259     property focused: Boolean read getFocused write setFocused;
 260     property active: Boolean read getActive;
 261     property escClose: Boolean read mEscClose write mEscClose;
 262     property cancel: Boolean read mCancel write mCancel;
 263     property defctl: Boolean read mDefault write mDefault;
 264     property canFocus: Boolean read getCanFocus write mCanFocus;
 265     property ctlById[const aid: AnsiString]: TUIControl read findControlById; default;
 266   end;
 267
 268
 269   TUITopWindow = class(TUIControl)
 270   private
 271     type TXMode = (None, Drag, Scroll);
 272
 273   private
 274     mTitle: AnsiString;
 275     mDragScroll: TXMode;
 276     mDragStartX, mDragStartY: Integer;
 277     mWaitingClose: Boolean;
 278     mInClose: Boolean;
 279     mFreeOnClose: Boolean; // default: false
 280     mDoCenter: Boolean; // after layouting
 281     mFitToScreen: Boolean;
 282
 283   protected
 284     procedure activated (); override;
 285     procedure blurred (); override;
 286
 287   public
 288     closeCB: TActionCB; // called after window was removed from ui window list
 289
 290   public
 291     constructor Create (const atitle: AnsiString);
 292
 293     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 294
 295     function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
 296
 297     procedure flFitToScreen (); // call this before layouting
 298
 299     procedure centerInScreen ();
 300
 301     // `sx` and `sy` are screen coordinates
 302     procedure drawControl (gx, gy: Integer); override;
 303     procedure drawControlPost (gx, gy: Integer); override;
 304
 305     procedure keyEvent (var ev: THKeyEvent); override; // returns `true` if event was eaten
 306     procedure mouseEvent (var ev: THMouseEvent); override; // returns `true` if event was eaten
 307
 308   public
 309     property freeOnClose: Boolean read mFreeOnClose write mFreeOnClose;
 310     property fitToScreen: Boolean read mFitToScreen write mFitToScreen;
 311   end;
 312
 313   // ////////////////////////////////////////////////////////////////////// //
 314   TUIBox = class(TUIControl)
 315   private
 316     mHasFrame: Boolean;
 317     mCaption: AnsiString;
 318     mHAlign: Integer; // -1: left; 0: center; 1: right; default: left
 319
 320   protected
 321     procedure setCaption (const acap: AnsiString);
 322     procedure setHasFrame (v: Boolean);
 323
 324   public
 325     constructor Create (ahoriz: Boolean);
 326
 327     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 328
 329     function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
 330
 331     procedure drawControl (gx, gy: Integer); override;
 332
 333     procedure mouseEvent (var ev: THMouseEvent); override;
 334     procedure keyEvent (var ev: THKeyEvent); override;
 335
 336   public
 337     property caption: AnsiString read mCaption write setCaption;
 338     property hasFrame: Boolean read mHasFrame write setHasFrame;
 339     property captionAlign: Integer read mHAlign write mHAlign;
 340   end;
 341
 342   TUIHBox = class(TUIBox)
 343   public
 344     constructor Create ();
 345
 346     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 347   end;
 348
 349   TUIVBox = class(TUIBox)
 350   public
 351     constructor Create ();
 352
 353     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 354   end;
 355
 356   // ////////////////////////////////////////////////////////////////////// //
 357   TUISpan = class(TUIControl)
 358   public
 359     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 360
 361     function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
 362
 363     procedure drawControl (gx, gy: Integer); override;
 364   end;
 365
 366   // ////////////////////////////////////////////////////////////////////// //
 367   TUILine = class(TUIControl)
 368   public
 369     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 370
 371     function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
 372
 373     procedure layPrepare (); override; // called before registering control in layouter
 374
 375     procedure drawControl (gx, gy: Integer); override;
 376   end;
 377
 378   // ////////////////////////////////////////////////////////////////////// //
 379   TUIStaticText = class(TUIControl)
 380   private
 381     mText: AnsiString;
 382     mHAlign: Integer; // -1: left; 0: center; 1: right; default: left
 383     mVAlign: Integer; // -1: top; 0: center; 1: bottom; default: center
 384     mHeader: Boolean; // true: draw with frame text color
 385     mLine: Boolean; // true: draw horizontal line
 386
 387   private
 388     procedure setText (const atext: AnsiString);
 389
 390   public
 391     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 392
 393     function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
 394
 395     procedure drawControl (gx, gy: Integer); override;
 396
 397   public
 398     property text: AnsiString read mText write setText;
 399     property halign: Integer read mHAlign write mHAlign;
 400     property valign: Integer read mVAlign write mVAlign;
 401     property header: Boolean read mHeader write mHeader;
 402     property line: Boolean read mLine write mLine;
 403   end;
 404
 405   // ////////////////////////////////////////////////////////////////////// //
 406   TUITextLabel = class(TUIControl)
 407   private
 408     mText: AnsiString;
 409     mHAlign: Integer; // -1: left; 0: center; 1: right; default: left
 410     mVAlign: Integer; // -1: top; 0: center; 1: bottom; default: center
 411     mHotChar: AnsiChar;
 412     mHotOfs: Integer; // from text start, in pixels
 413     mHotColor: array[0..ClrIdxMax] of TGxRGBA;
 414     mLinkId: AnsiString; // linked control
 415
 416   protected
 417     procedure cacheStyle (root: TUIStyle); override;
 418
 419     procedure setText (const s: AnsiString); virtual;
 420
 421   public
 422     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 423
 424     function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
 425
 426     procedure doAction (); override;
 427
 428     procedure drawControl (gx, gy: Integer); override;
 429
 430     procedure mouseEvent (var ev: THMouseEvent); override;
 431     procedure keyEventPost (var ev: THKeyEvent); override;
 432
 433   public
 434     property text: AnsiString read mText write setText;
 435     property halign: Integer read mHAlign write mHAlign;
 436     property valign: Integer read mVAlign write mVAlign;
 437   end;
 438
 439   // ////////////////////////////////////////////////////////////////////// //
 440   TUIButton = class(TUITextLabel)
 441   protected
 442     mSkipLayPrepare: Boolean;
 443     mShadowSize: Integer;
 444     mAddMarkers: Boolean;
 445     mHideMarkers: Boolean;
 446     mPushed: Boolean;
 447
 448   protected
 449     procedure setText (const s: AnsiString); override;
 450
 451     procedure cacheStyle (root: TUIStyle); override;
 452
 453   public
 454     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 455
 456     procedure layPrepare (); override; // called before registering control in layouter
 457
 458     procedure drawControl (gx, gy: Integer); override;
 459
 460     procedure mouseEvent (var ev: THMouseEvent); override;
 461     procedure keyEvent (var ev: THKeyEvent); override;
 462   end;
 463
 464   // ////////////////////////////////////////////////////////////////////// //
 465   TUIButtonRound = class(TUIButton)
 466   protected
 467     procedure setText (const s: AnsiString); override;
 468
 469   public
 470     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 471
 472     procedure layPrepare (); override; // called before registering control in layouter
 473
 474     procedure drawControl (gx, gy: Integer); override;
 475   end;
 476
 477   // ////////////////////////////////////////////////////////////////////// //
 478   TUISwitchBox = class(TUITextLabel)
 479   protected
 480     mBoolVar: PBoolean;
 481     mChecked: Boolean;
 482     mIcon: TGxContext.TMarkIcon;
 483     mSwitchColor: array[0..ClrIdxMax] of TGxRGBA;
 484
 485   protected
 486     procedure cacheStyle (root: TUIStyle); override;
 487
 488     procedure setText (const s: AnsiString); override;
 489
 490     function getChecked (): Boolean; virtual;
 491     procedure setChecked (v: Boolean); virtual; abstract;
 492
 493   public
 494     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 495
 496     function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
 497
 498     procedure drawControl (gx, gy: Integer); override;
 499
 500     procedure mouseEvent (var ev: THMouseEvent); override;
 501     procedure keyEvent (var ev: THKeyEvent); override;
 502
 503     procedure setVar (pvar: PBoolean);
 504
 505   public
 506     property checked: Boolean read getChecked write setChecked;
 507   end;
 508
 509   TUICheckBox = class(TUISwitchBox)
 510   protected
 511     procedure setChecked (v: Boolean); override;
 512
 513   public
 514     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 515
 516     procedure doAction (); override;
 517   end;
 518
 519   TUIRadioBox = class(TUISwitchBox)
 520   private
 521     mRadioGroup: AnsiString;
 522
 523   protected
 524     procedure setChecked (v: Boolean); override;
 525
 526   public
 527     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 528
 529     function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
 530
 531     procedure doAction (); override;
 532
 533   public
 534     property radioGroup: AnsiString read mRadioGroup write mRadioGroup; //FIXME
 535   end;
 536
 537
 538 // ////////////////////////////////////////////////////////////////////////// //
 539 procedure uiMouseEvent (var evt: THMouseEvent);
 540 procedure uiKeyEvent (var evt: THKeyEvent);
 541 procedure uiDraw ();
 542
 543
 544 // ////////////////////////////////////////////////////////////////////////// //
 545 procedure uiAddWindow (ctl: TUIControl);
 546 procedure uiRemoveWindow (ctl: TUIControl); // will free window if `mFreeOnClose` is `true`
 547 function uiVisibleWindow (ctl: TUIControl): Boolean;
 548
 549 procedure uiUpdateStyles ();
 550
 551
 552 // ////////////////////////////////////////////////////////////////////////// //
 553 // do layouting
 554 procedure uiLayoutCtl (ctl: TUIControl);
 555
 556
 557 // ////////////////////////////////////////////////////////////////////////// //
 558 procedure uiInitialize ();
 559 procedure uiDeinitialize ();
 560
 561
 562 // ////////////////////////////////////////////////////////////////////////// //
 563 var
 564   fuiRenderScale: Single = 1.0;
 565   uiContext: TGxContext = nil;
 566
 567
 568 implementation
 569
 570 uses
 571   fui_flexlay,
 572   utils;
 573
 574
 575 // ////////////////////////////////////////////////////////////////////////// //
 576 procedure uiDeinitialize ();
 577 begin
 578   FreeAndNil(uiContext);
 579 end;
 580
 581
 582 procedure uiInitialize ();
 583 begin
 584   if (uiContext <> nil) then raise Exception.Create('FlexUI already initialized');
 585   uiContext := TGxContext.Create();
 586 end;
 587
 588
 589 // ////////////////////////////////////////////////////////////////////////// //
 590 var
 591   ctlsToKill: array of TUIControl = nil;
 592
 593
 594 procedure scheduleKill (ctl: TUIControl);
 595 var
 596   f: Integer;
 597 begin
 598   if (ctl = nil) then exit;
 599   ctl := ctl.topLevel;
 600   for f := 0 to High(ctlsToKill) do
 601   begin
 602     if (ctlsToKill[f] = ctl) then exit;
 603     if (ctlsToKill[f] = nil) then begin ctlsToKill[f] := ctl; exit; end;
 604   end;
 605   SetLength(ctlsToKill, Length(ctlsToKill)+1);
 606   ctlsToKill[High(ctlsToKill)] := ctl;
 607 end;
 608
 609
 610 procedure processKills ();
 611 var
 612   f: Integer;
 613   ctl: TUIControl;
 614 begin
 615   for f := 0 to High(ctlsToKill) do
 616   begin
 617     ctl := ctlsToKill[f];
 618     if (ctl = nil) then break;
 619     ctlsToKill[f] := nil;
 620     FreeAndNil(ctl);
 621   end;
 622   if (Length(ctlsToKill) > 0) then ctlsToKill[0] := nil; // just in case
 623 end;
 624
 625
 626 // ////////////////////////////////////////////////////////////////////////// //
 627 var
 628   knownCtlClasses: array of record
 629     klass: TUIControlClass;
 630     name: AnsiString;
 631   end = nil;
 632
 633
 634 procedure registerCtlClass (aklass: TUIControlClass; const aname: AnsiString);
 635 begin
 636   assert(aklass <> nil);
 637   assert(Length(aname) > 0);
 638   SetLength(knownCtlClasses, Length(knownCtlClasses)+1);
 639   knownCtlClasses[High(knownCtlClasses)].klass := aklass;
 640   knownCtlClasses[High(knownCtlClasses)].name := aname;
 641 end;
 642
 643
 644 function findCtlClass (const aname: AnsiString): TUIControlClass;
 645 var
 646   f: Integer;
 647 begin
 648   for f := 0 to High(knownCtlClasses) do
 649   begin
 650     if (strEquCI1251(aname, knownCtlClasses[f].name)) then
 651     begin
 652       result := knownCtlClasses[f].klass;
 653       exit;
 654     end;
 655   end;
 656   result := nil;
 657 end;
 658
 659
 660 // ////////////////////////////////////////////////////////////////////////// //
 661 type
 662   TFlexLayouter = specialize TFlexLayouterBase<TUIControl>;
 663
 664 procedure uiLayoutCtl (ctl: TUIControl);
 665 var
 666   lay: TFlexLayouter;
 667 begin
 668   if (ctl = nil) then exit;
 669   lay := TFlexLayouter.Create();
 670   try
 671     if (not ctl.mStyleLoaded) then ctl.updateStyle();
 672     if (ctl is TUITopWindow) and (TUITopWindow(ctl).fitToScreen) then TUITopWindow(ctl).flFitToScreen();
 673
 674     lay.setup(ctl);
 675     //lay.layout();
 676
 677     //writeln('============================'); lay.dumpFlat();
 678
 679     //writeln('=== initial ==='); lay.dump();
 680
 681     //lay.calcMaxSizeInternal(0);
 682     {
 683     lay.firstPass();
 684     writeln('=== after first pass ===');
 685     lay.dump();
 686
 687     lay.secondPass();
 688     writeln('=== after second pass ===');
 689     lay.dump();
 690     }
 691
 692     lay.layout();
 693     //writeln('=== final ==='); lay.dump();
 694
 695     if (ctl.mParent = nil) and (ctl is TUITopWindow) and (TUITopWindow(ctl).mDoCenter) then
 696     begin
 697       TUITopWindow(ctl).centerInScreen();
 698     end;
 699
 700     // calculate full size
 701     ctl.calcFullClientSize();
 702
 703     // fix focus
 704     if (ctl.mParent = nil) then
 705     begin
 706       if (ctl.mFocused = nil) or (ctl.mFocused = ctl) or (not ctl.mFocused.enabled) then
 707       begin
 708         ctl.mFocused := ctl.findFirstFocus();
 709       end;
 710     end;
 711
 712   finally
 713     FreeAndNil(lay);
 714   end;
 715 end;
 716
 717
 718 // ////////////////////////////////////////////////////////////////////////// //
 719 var
 720   uiTopList: array of TUIControl = nil;
 721   uiGrabCtl: TUIControl = nil;
 722
 723
 724 procedure uiUpdateStyles ();
 725 var
 726   ctl: TUIControl;
 727 begin
 728   for ctl in uiTopList do ctl.updateStyle();
 729 end;
 730
 731
 732 procedure uiMouseEvent (var evt: THMouseEvent);
 733 var
 734   ev: THMouseEvent;
 735   f, c: Integer;
 736   lx, ly: Integer;
 737   ctmp: TUIControl;
 738 begin
 739   processKills();
 740   if (evt.eaten) or (evt.cancelled) then exit;
 741   ev := evt;
 742   ev.x := trunc(ev.x/fuiRenderScale);
 743   ev.y := trunc(ev.y/fuiRenderScale);
 744   ev.dx := trunc(ev.dx/fuiRenderScale); //FIXME
 745   ev.dy := trunc(ev.dy/fuiRenderScale); //FIXME
 746   try
 747     if (uiGrabCtl <> nil) then
 748     begin
 749       uiGrabCtl.mouseEvent(ev);
 750       if (ev.release) and ((ev.bstate and (not ev.but)) = 0) then uiGrabCtl := nil;
 751       ev.eat();
 752       exit;
 753     end;
 754     if (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)].enabled) then uiTopList[High(uiTopList)].mouseEvent(ev);
 755     if (not ev.eaten) and (not ev.cancelled) and (ev.press) then
 756     begin
 757       for f := High(uiTopList) downto 0 do
 758       begin
 759         if uiTopList[f].toLocal(ev.x, ev.y, lx, ly) then
 760         begin
 761           if (uiTopList[f].enabled) and (f <> High(uiTopList)) then
 762           begin
 763             uiTopList[High(uiTopList)].blurred();
 764             ctmp := uiTopList[f];
 765             uiGrabCtl := nil;
 766             for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
 767             uiTopList[High(uiTopList)] := ctmp;
 768             ctmp.activated();
 769             ctmp.mouseEvent(ev);
 770           end;
 771           ev.eat();
 772           exit;
 773         end;
 774       end;
 775     end;
 776   finally
 777     if (ev.eaten) then evt.eat();
 778     if (ev.cancelled) then evt.cancel();
 779   end;
 780 end;
 781
 782
 783 procedure uiKeyEvent (var evt: THKeyEvent);
 784 var
 785   ev: THKeyEvent;
 786 begin
 787   processKills();
 788   if (evt.eaten) or (evt.cancelled) then exit;
 789   ev := evt;
 790   ev.x := trunc(ev.x/fuiRenderScale);
 791   ev.y := trunc(ev.y/fuiRenderScale);
 792   try
 793     if (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)].enabled) then uiTopList[High(uiTopList)].keyEvent(ev);
 794     //if (ev.release) then begin ev.eat(); exit; end;
 795   finally
 796     if (ev.eaten) then evt.eat();
 797     if (ev.cancelled) then evt.cancel();
 798   end;
 799 end;
 800
 801
 802 procedure uiDraw ();
 803 var
 804   f, cidx: Integer;
 805   ctl: TUIControl;
 806 begin
 807   processKills();
 808   //if (uiContext = nil) then uiContext := TGxContext.Create();
 809   gxSetContext(uiContext, fuiRenderScale);
 810   uiContext.resetClip();
 811   try
 812     for f := 0 to High(uiTopList) do
 813     begin
 814       ctl := uiTopList[f];
 815       ctl.draw();
 816       if (f <> High(uiTopList)) then
 817       begin
 818         cidx := ctl.getColorIndex;
 819         uiContext.darkenRect(ctl.x0, ctl.y0, ctl.width, ctl.height, ctl.mDarken[cidx]);
 820       end;
 821     end;
 822   finally
 823     gxSetContext(nil);
 824   end;
 825 end;
 826
 827
 828 procedure uiAddWindow (ctl: TUIControl);
 829 var
 830   f, c: Integer;
 831 begin
 832   if (ctl = nil) then exit;
 833   ctl := ctl.topLevel;
 834   if not (ctl is TUITopWindow) then exit; // alas
 835   for f := 0 to High(uiTopList) do
 836   begin
 837     if (uiTopList[f] = ctl) then
 838     begin
 839       if (f <> High(uiTopList)) then
 840       begin
 841         uiTopList[High(uiTopList)].blurred();
 842         for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
 843         uiTopList[High(uiTopList)] := ctl;
 844         ctl.activated();
 845       end;
 846       exit;
 847     end;
 848   end;
 849   if (Length(uiTopList) > 0) then uiTopList[High(uiTopList)].blurred();
 850   SetLength(uiTopList, Length(uiTopList)+1);
 851   uiTopList[High(uiTopList)] := ctl;
 852   if (not ctl.mStyleLoaded) then ctl.updateStyle();
 853   ctl.activated();
 854 end;
 855
 856
 857 procedure uiRemoveWindow (ctl: TUIControl);
 858 var
 859   f, c: Integer;
 860 begin
 861   if (ctl = nil) then exit;
 862   ctl := ctl.topLevel;
 863   if not (ctl is TUITopWindow) then exit; // alas
 864   for f := 0 to High(uiTopList) do
 865   begin
 866     if (uiTopList[f] = ctl) then
 867     begin
 868       ctl.blurred();
 869       for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
 870       SetLength(uiTopList, Length(uiTopList)-1);
 871       if (ctl is TUITopWindow) then
 872       begin
 873         try
 874           if assigned(TUITopWindow(ctl).closeCB) then TUITopWindow(ctl).closeCB(ctl);
 875         finally
 876           if (TUITopWindow(ctl).mFreeOnClose) then scheduleKill(ctl);
 877         end;
 878       end;
 879       exit;
 880     end;
 881   end;
 882 end;
 883
 884
 885 function uiVisibleWindow (ctl: TUIControl): Boolean;
 886 var
 887   f: Integer;
 888 begin
 889   result := false;
 890   if (ctl = nil) then exit;
 891   ctl := ctl.topLevel;
 892   if not (ctl is TUITopWindow) then exit; // alas
 893   for f := 0 to High(uiTopList) do
 894   begin
 895     if (uiTopList[f] = ctl) then begin result := true; exit; end;
 896   end;
 897 end;
 898
 899
 900 // ////////////////////////////////////////////////////////////////////////// //
 901 constructor TUIControl.Create ();
 902 begin
 903 end;
 904
 905
 906 procedure TUIControl.AfterConstruction ();
 907 begin
 908   inherited;
 909   mParent := nil;
 910   mId := '';
 911   mX := 0;
 912   mY := 0;
 913   mWidth := 64;
 914   mHeight := uiContext.charHeight(' ');
 915   mFrameWidth := 0;
 916   mFrameHeight := 0;
 917   mEnabled := true;
 918   mCanFocus := true;
 919   mChildren := nil;
 920   mFocused := nil;
 921   mEscClose := false;
 922   mDrawShadow := false;
 923   actionCB := nil;
 924   // layouter interface
 925   //mDefSize := TLaySize.Create(64, uiContext.charHeight(' ')); // default size
 926   mDefSize := TLaySize.Create(0, 0); // default size: hidden control
 927   mMaxSize := TLaySize.Create(-1, -1); // maximum size
 928   mPadding := TLaySize.Create(0, 0);
 929   mNoPad := false;
 930   mFlex := 0;
 931   mHoriz := true;
 932   mHGroup := '';
 933   mVGroup := '';
 934   mStyleId := '';
 935   mCtl4Style := '';
 936   mAlign := -1; // left/top
 937   mExpand := false;
 938   mStyleLoaded := false;
 939 end;
 940
 941
 942 destructor TUIControl.Destroy ();
 943 var
 944   f, c: Integer;
 945 begin
 946   if (mParent <> nil) then
 947   begin
 948     setFocused(false);
 949     for f := 0 to High(mParent.mChildren) do
 950     begin
 951       if (mParent.mChildren[f] = self) then
 952       begin
 953         for c := f+1 to High(mParent.mChildren) do mParent.mChildren[c-1] := mParent.mChildren[c];
 954         SetLength(mParent.mChildren, Length(mParent.mChildren)-1);
 955       end;
 956     end;
 957   end;
 958   for f := 0 to High(mChildren) do
 959   begin
 960     mChildren[f].mParent := nil;
 961     mChildren[f].Free();
 962   end;
 963   mChildren := nil;
 964 end;
 965
 966
 967 function TUIControl.getColorIndex (): Integer; inline;
 968 begin
 969   if (not enabled) then begin result := ClrIdxDisabled; exit; end;
 970   // top windows: no focus hack
 971   if (self is TUITopWindow) then
 972   begin
 973     if (getActive) then begin result := ClrIdxActive; exit; end;
 974   end
 975   else
 976   begin
 977     // if control cannot be focused, take "active" color scheme for it (it is easier this way)
 978     if (not canFocus) or (getActive) then begin result := ClrIdxActive; exit; end;
 979   end;
 980   result := ClrIdxInactive;
 981 end;
 982
 983 procedure TUIControl.updateStyle ();
 984 var
 985   stl: TUIStyle = nil;
 986   ctl: TUIControl;
 987 begin
 988   ctl := self;
 989   while (ctl <> nil) do
 990   begin
 991     if (Length(ctl.mStyleId) <> 0) then begin stl := uiFindStyle(ctl.mStyleId); break; end;
 992     ctl := ctl.mParent;
 993   end;
 994   if (stl = nil) then stl := uiFindStyle(''); // default
 995   cacheStyle(stl);
 996   for ctl in mChildren do ctl.updateStyle();
 997   mStyleLoaded := true;
 998 end;
 999
1000 procedure TUIControl.cacheStyle (root: TUIStyle);
1001 var
1002   cst: AnsiString;
1003 begin
1004   //writeln('caching style for <', className, '> (', mCtl4Style, ')...');
1005   cst := mCtl4Style;
1006   // active
1007   mBackColor[ClrIdxActive] := root.get('back-color', 'active', cst).asRGBADef(TGxRGBA.Create(0, 0, 128));
1008   mTextColor[ClrIdxActive] := root.get('text-color', 'active', cst).asRGBADef(TGxRGBA.Create(255, 255, 255));
1009   mFrameColor[ClrIdxActive] := root.get('frame-color', 'active', cst).asRGBADef(TGxRGBA.Create(255, 255, 255));
1010   mFrameTextColor[ClrIdxActive] := root.get('frame-text-color', 'active', cst).asRGBADef(TGxRGBA.Create(255, 255, 255));
1011   mFrameIconColor[ClrIdxActive] := root.get('frame-icon-color', 'active', cst).asRGBADef(TGxRGBA.Create(0, 255, 0));
1012   mDarken[ClrIdxActive] := root.get('darken', 'active', cst).asInt(666);
1013   // disabled
1014   mBackColor[ClrIdxDisabled] := root.get('back-color', 'disabled', cst).asRGBADef(TGxRGBA.Create(0, 0, 128));
1015   mTextColor[ClrIdxDisabled] := root.get('text-color', 'disabled', cst).asRGBADef(TGxRGBA.Create(127, 127, 127));
1016   mFrameColor[ClrIdxDisabled] := root.get('frame-color', 'disabled', cst).asRGBADef(TGxRGBA.Create(127, 127, 127));
1017   mFrameTextColor[ClrIdxDisabled] := root.get('frame-text-color', 'disabled', cst).asRGBADef(TGxRGBA.Create(127, 127, 127));
1018   mFrameIconColor[ClrIdxDisabled] := root.get('frame-icon-color', 'disabled', cst).asRGBADef(TGxRGBA.Create(0, 127, 0));
1019   mDarken[ClrIdxDisabled] := root.get('darken', 'disabled', cst).asInt(666);
1020   // inactive
1021   mBackColor[ClrIdxInactive] := root.get('back-color', 'inactive', cst).asRGBADef(TGxRGBA.Create(0, 0, 128));
1022   mTextColor[ClrIdxInactive] := root.get('text-color', 'inactive', cst).asRGBADef(TGxRGBA.Create(255, 255, 255));
1023   mFrameColor[ClrIdxInactive] := root.get('frame-color', 'inactive', cst).asRGBADef(TGxRGBA.Create(255, 255, 255));
1024   mFrameTextColor[ClrIdxInactive] := root.get('frame-text-color', 'inactive', cst).asRGBADef(TGxRGBA.Create(255, 255, 255));
1025   mFrameIconColor[ClrIdxInactive] := root.get('frame-icon-color', 'inactive', cst).asRGBADef(TGxRGBA.Create(0, 255, 0));
1026   mDarken[ClrIdxInactive] := root.get('darken', 'inactive', cst).asInt(666);
1027 end;
1028
1029
1030 // ////////////////////////////////////////////////////////////////////////// //
1031 function TUIControl.getDefSize (): TLaySize; inline; begin result := mLayDefSize; end;
1032 function TUIControl.getMaxSize (): TLaySize; inline; begin result := mLayMaxSize; end;
1033 function TUIControl.getPadding (): TLaySize; inline; begin result := mPadding; end;
1034 function TUIControl.getFlex (): Integer; inline; begin result := mFlex; end;
1035 function TUIControl.isHorizBox (): Boolean; inline; begin result := mHoriz; end;
1036 function TUIControl.noPad (): Boolean; inline; begin result := mNoPad; end;
1037 function TUIControl.getAlign (): Integer; inline; begin result := mAlign; end;
1038 function TUIControl.getExpand (): Boolean; inline; begin result := mExpand; end;
1039 function TUIControl.getHGroup (): AnsiString; inline; begin result := mHGroup; end;
1040 function TUIControl.getVGroup (): AnsiString; inline; begin result := mVGroup; end;
1041 function TUIControl.getMargins (): TLayMargins; inline; begin result := TLayMargins.Create(mFrameHeight, mFrameWidth, mFrameHeight, mFrameWidth); end;
1042
1043 procedure TUIControl.setActualSizePos (constref apos: TLayPos; constref asize: TLaySize); inline;
1044 begin
1045   //writeln(self.className, '; pos=', apos.toString, '; size=', asize.toString);
1046   if (mParent <> nil) then
1047   begin
1048     mX := apos.x;
1049     mY := apos.y;
1050   end;
1051   mWidth := asize.w;
1052   mHeight := asize.h;
1053   if (mLayMaxSize.w >= 0) then mWidth := nmin(mWidth, mLayMaxSize.w);
1054   if (mLayMaxSize.h >= 0) then mHeight := nmin(mHeight, mLayMaxSize.h);
1055 end;
1056
1057 procedure TUIControl.layPrepare ();
1058 begin
1059   mLayDefSize := mDefSize;
1060   if (mLayDefSize.w <> 0) or (mLayDefSize.h <> 0) then
1061   begin
1062     mLayMaxSize := mMaxSize;
1063     if (mLayMaxSize.w >= 0) then begin mLayDefSize.w += mFrameWidth*2; mLayMaxSize.w += mFrameWidth*2; end;
1064     if (mLayMaxSize.h >= 0) then begin mLayDefSize.h += mFrameHeight*2; mLayMaxSize.h += mFrameHeight*2; end;
1065   end
1066   else
1067   begin
1068     mLayMaxSize := TLaySize.Create(0, 0);
1069   end;
1070 end;
1071
1072
1073 // ////////////////////////////////////////////////////////////////////////// //
1074 function TUIControl.parsePos (par: TTextParser): TLayPos;
1075 var
1076   ech: AnsiChar = ')';
1077 begin
1078   if (par.eatDelim('[')) then ech := ']' else par.expectDelim('(');
1079   result.x := par.expectInt();
1080   par.eatDelim(','); // optional comma
1081   result.y := par.expectInt();
1082   par.eatDelim(','); // optional comma
1083   par.expectDelim(ech);
1084 end;
1085
1086 function TUIControl.parseSize (par: TTextParser): TLaySize;
1087 var
1088   ech: AnsiChar = ')';
1089 begin
1090   if (par.eatDelim('[')) then ech := ']' else par.expectDelim('(');
1091   result.w := par.expectInt();
1092   par.eatDelim(','); // optional comma
1093   result.h := par.expectInt();
1094   par.eatDelim(','); // optional comma
1095   par.expectDelim(ech);
1096 end;
1097
1098 function TUIControl.parsePadding (par: TTextParser): TLaySize;
1099 begin
1100   result := parseSize(par);
1101 end;
1102
1103 function TUIControl.parseHPadding (par: TTextParser; def: Integer): TLaySize;
1104 begin
1105   if (par.isInt) then
1106   begin
1107     result.h := def;
1108     result.w := par.expectInt();
1109   end
1110   else
1111   begin
1112     result := parsePadding(par);
1113   end;
1114 end;
1115
1116 function TUIControl.parseVPadding (par: TTextParser; def: Integer): TLaySize;
1117 begin
1118   if (par.isInt) then
1119   begin
1120     result.w := def;
1121     result.h := par.expectInt();
1122   end
1123   else
1124   begin
1125     result := parsePadding(par);
1126   end;
1127 end;
1128
1129 function TUIControl.parseBool (par: TTextParser): Boolean;
1130 begin
1131   result :=
1132     par.eatIdOrStrCI('true') or
1133     par.eatIdOrStrCI('yes') or
1134     par.eatIdOrStrCI('tan');
1135   if not result then
1136   begin
1137     if (not par.eatIdOrStrCI('false')) and (not par.eatIdOrStrCI('no')) and (not par.eatIdOrStrCI('ona')) then
1138     begin
1139       par.error('boolean value expected');
1140     end;
1141   end;
1142 end;
1143
1144 function TUIControl.parseAnyAlign (par: TTextParser): Integer;
1145 begin
1146        if (par.eatIdOrStrCI('left')) or (par.eatIdOrStrCI('top')) then result := -1
1147   else if (par.eatIdOrStrCI('right')) or (par.eatIdOrStrCI('bottom')) then result := 1
1148   else if (par.eatIdOrStrCI('center')) then result := 0
1149   else par.error('invalid align value');
1150 end;
1151
1152 function TUIControl.parseHAlign (par: TTextParser): Integer;
1153 begin
1154        if (par.eatIdOrStrCI('left')) then result := -1
1155   else if (par.eatIdOrStrCI('right')) then result := 1
1156   else if (par.eatIdOrStrCI('center')) then result := 0
1157   else par.error('invalid horizontal align value');
1158 end;
1159
1160 function TUIControl.parseVAlign (par: TTextParser): Integer;
1161 begin
1162        if (par.eatIdOrStrCI('top')) then result := -1
1163   else if (par.eatIdOrStrCI('bottom')) then result := 1
1164   else if (par.eatIdOrStrCI('center')) then result := 0
1165   else par.error('invalid vertical align value');
1166 end;
1167
1168 procedure TUIControl.parseTextAlign (par: TTextParser; var h, v: Integer);
1169 var
1170   wasH: Boolean = false;
1171   wasV: Boolean = false;
1172 begin
1173   while true do
1174   begin
1175     if (par.eatIdOrStrCI('left')) then
1176     begin
1177       if wasH then par.error('too many align directives');
1178       wasH := true;
1179       h := -1;
1180       continue;
1181     end;
1182     if (par.eatIdOrStrCI('right')) then
1183     begin
1184       if wasH then par.error('too many align directives');
1185       wasH := true;
1186       h := 1;
1187       continue;
1188     end;
1189     if (par.eatIdOrStrCI('hcenter')) then
1190     begin
1191       if wasH then par.error('too many align directives');
1192       wasH := true;
1193       h := 0;
1194       continue;
1195     end;
1196     if (par.eatIdOrStrCI('top')) then
1197     begin
1198       if wasV then par.error('too many align directives');
1199       wasV := true;
1200       v := -1;
1201       continue;
1202     end;
1203     if (par.eatIdOrStrCI('bottom')) then
1204     begin
1205       if wasV then par.error('too many align directives');
1206       wasV := true;
1207       v := 1;
1208       continue;
1209     end;
1210     if (par.eatIdOrStrCI('vcenter')) then
1211     begin
1212       if wasV then par.error('too many align directives');
1213       wasV := true;
1214       v := 0;
1215       continue;
1216     end;
1217     if (par.eatIdOrStrCI('center')) then
1218     begin
1219       if wasV or wasH then par.error('too many align directives');
1220       wasV := true;
1221       wasH := true;
1222       h := 0;
1223       v := 0;
1224       continue;
1225     end;
1226     break;
1227   end;
1228   if not wasV and not wasH then par.error('invalid align value');
1229 end;
1230
1231 function TUIControl.parseOrientation (const prname: AnsiString; par: TTextParser): Boolean;
1232 begin
1233   if (strEquCI1251(prname, 'orientation')) or (strEquCI1251(prname, 'orient')) then
1234   begin
1235          if (par.eatIdOrStrCI('horizontal')) or (par.eatIdOrStrCI('horiz')) then mHoriz := true
1236     else if (par.eatIdOrStrCI('vertical')) or (par.eatIdOrStrCI('vert')) then mHoriz := false
1237     else par.error('`horizontal` or `vertical` expected');
1238     result := true;
1239   end
1240   else
1241   begin
1242     result := false;
1243   end;
1244 end;
1245
1246 // par should be on '{'; final '}' is eaten
1247 procedure TUIControl.parseProperties (par: TTextParser);
1248 var
1249   pn: AnsiString;
1250 begin
1251   if (not par.eatDelim('{')) then exit;
1252   while (not par.eatDelim('}')) do
1253   begin
1254     if (not par.isIdOrStr) then par.error('property name expected');
1255     pn := par.tokStr;
1256     par.skipToken();
1257     par.eatDelim(':'); // optional
1258     if not parseProperty(pn, par) then par.errorfmt('invalid property name ''%s''', [pn]);
1259     par.eatDelim(','); // optional
1260   end;
1261 end;
1262
1263 // par should be on '{'
1264 procedure TUIControl.parseChildren (par: TTextParser);
1265 var
1266   cc: TUIControlClass;
1267   ctl: TUIControl;
1268 begin
1269   par.expectDelim('{');
1270   while (not par.eatDelim('}')) do
1271   begin
1272     if (not par.isIdOrStr) then par.error('control name expected');
1273     cc := findCtlClass(par.tokStr);
1274     if (cc = nil) then par.errorfmt('unknown control name: ''%s''', [par.tokStr]);
1275     //writeln('children for <', par.tokStr, '>: <', cc.className, '>');
1276     par.skipToken();
1277     par.eatDelim(':'); // optional
1278     ctl := cc.Create();
1279     //writeln('  mHoriz=', ctl.mHoriz);
1280     try
1281       ctl.parseProperties(par);
1282     except
1283       FreeAndNil(ctl);
1284       raise;
1285     end;
1286     //writeln(': ', ctl.mDefSize.toString);
1287     appendChild(ctl);
1288     par.eatDelim(','); // optional
1289   end;
1290 end;
1291
1292
1293 function TUIControl.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
1294 begin
1295   result := true;
1296   if (strEquCI1251(prname, 'id')) then begin mId := par.expectIdOrStr(true); exit; end; // allow empty strings
1297   if (strEquCI1251(prname, 'style')) then begin mStyleId := par.expectIdOrStr(); exit; end; // no empty strings
1298   if (strEquCI1251(prname, 'flex')) then begin flex := par.expectInt(); exit; end;
1299   // sizes
1300   if (strEquCI1251(prname, 'defsize')) or (strEquCI1251(prname, 'size')) then begin mDefSize := parseSize(par); exit; end;
1301   if (strEquCI1251(prname, 'maxsize')) then begin mMaxSize := parseSize(par); exit; end;
1302   if (strEquCI1251(prname, 'defwidth')) or (strEquCI1251(prname, 'width')) then begin mDefSize.w := par.expectInt(); exit; end;
1303   if (strEquCI1251(prname, 'defheight')) or (strEquCI1251(prname, 'height')) then begin mDefSize.h := par.expectInt(); exit; end;
1304   if (strEquCI1251(prname, 'maxwidth')) then begin mMaxSize.w := par.expectInt(); exit; end;
1305   if (strEquCI1251(prname, 'maxheight')) then begin mMaxSize.h := par.expectInt(); exit; end;
1306   // padding
1307   if (strEquCI1251(prname, 'padding')) then begin mPadding := parsePadding(par); exit; end;
1308   if (strEquCI1251(prname, 'nopad')) then begin mNoPad := true; exit; end;
1309   // flags
1310   if (strEquCI1251(prname, 'expand')) then begin mExpand := parseBool(par); exit; end;
1311   // align
1312   if (strEquCI1251(prname, 'align')) then begin mAlign := parseAnyAlign(par); exit; end;
1313   if (strEquCI1251(prname, 'hgroup')) then begin mHGroup := par.expectIdOrStr(true); exit; end; // allow empty strings
1314   if (strEquCI1251(prname, 'vgroup')) then begin mVGroup := par.expectIdOrStr(true); exit; end; // allow empty strings
1315   // other
1316   if (strEquCI1251(prname, 'canfocus')) then begin mCanFocus := true; exit; end;
1317   if (strEquCI1251(prname, 'nofocus')) then begin mCanFocus := false; exit; end;
1318   if (strEquCI1251(prname, 'disabled')) then begin mEnabled := false; exit; end;
1319   if (strEquCI1251(prname, 'enabled')) then begin mEnabled := true; exit; end;
1320   if (strEquCI1251(prname, 'escclose')) then begin mEscClose := not parseBool(par); exit; end;
1321   if (strEquCI1251(prname, 'default')) then begin mDefault := true; exit; end;
1322   if (strEquCI1251(prname, 'cancel')) then begin mCancel := true; exit; end;
1323   result := false;
1324 end;
1325
1326
1327 // ////////////////////////////////////////////////////////////////////////// //
1328 procedure TUIControl.activated ();
1329 begin
1330   makeVisibleInParent();
1331 end;
1332
1333
1334 procedure TUIControl.blurred ();
1335 begin
1336   if (uiGrabCtl = self) then uiGrabCtl := nil;
1337 end;
1338
1339
1340 procedure TUIControl.calcFullClientSize ();
1341 var
1342   ctl: TUIControl;
1343 begin
1344   mFullSize := TLaySize.Create(0, 0);
1345   if (mWidth < 1) or (mHeight < 1) then exit;
1346   for ctl in mChildren do
1347   begin
1348     ctl.calcFullClientSize();
1349     mFullSize.w := nmax(mFullSize.w, ctl.mX-mFrameWidth+ctl.mFullSize.w);
1350     mFullSize.h := nmax(mFullSize.h, ctl.mY-mFrameHeight+ctl.mFullSize.h);
1351   end;
1352   mFullSize.w := nmax(mFullSize.w, mWidth-mFrameWidth*2);
1353   mFullSize.h := nmax(mFullSize.h, mHeight-mFrameHeight*2);
1354 end;
1355
1356
1357 function TUIControl.topLevel (): TUIControl; inline;
1358 begin
1359   result := self;
1360   while (result.mParent <> nil) do result := result.mParent;
1361 end;
1362
1363
1364 function TUIControl.getEnabled (): Boolean;
1365 var
1366   ctl: TUIControl;
1367 begin
1368   result := false;
1369   if (not mEnabled) then exit;
1370   ctl := mParent;
1371   while (ctl <> nil) do
1372   begin
1373     if (not ctl.mEnabled) then exit;
1374     ctl := ctl.mParent;
1375   end;
1376   result := true;
1377 end;
1378
1379
1380 procedure TUIControl.setEnabled (v: Boolean); inline;
1381 begin
1382   if (mEnabled = v) then exit;
1383   mEnabled := v;
1384   if (not v) and focused then setFocused(false);
1385 end;
1386
1387
1388 function TUIControl.getFocused (): Boolean; inline;
1389 begin
1390   if (mParent = nil) then
1391   begin
1392     result := (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)] = self);
1393   end
1394   else
1395   begin
1396     result := (topLevel.mFocused = self);
1397     if (result) then result := (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)] = topLevel);
1398   end;
1399 end;
1400
1401
1402 function TUIControl.getActive (): Boolean; inline;
1403 var
1404   ctl: TUIControl;
1405 begin
1406   if (mParent = nil) then
1407   begin
1408     result := (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)] = self);
1409   end
1410   else
1411   begin
1412     ctl := topLevel.mFocused;
1413     while (ctl <> nil) and (ctl <> self) do ctl := ctl.mParent;
1414     result := (ctl = self);
1415     if (result) then result := (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)] = topLevel);
1416   end;
1417 end;
1418
1419
1420 procedure TUIControl.setFocused (v: Boolean); inline;
1421 var
1422   tl: TUIControl;
1423 begin
1424   tl := topLevel;
1425   if (not v) then
1426   begin
1427     if (tl.mFocused = self) then
1428     begin
1429       blurred(); // this will reset grab, but still...
1430       if (uiGrabCtl = self) then uiGrabCtl := nil;
1431       tl.mFocused := tl.findNextFocus(self, true);
1432       if (tl.mFocused = self) then tl.mFocused := nil;
1433       if (tl.mFocused <> nil) then tl.mFocused.activated();
1434     end;
1435     exit;
1436   end;
1437   if (not canFocus) then exit;
1438   if (tl.mFocused <> self) then
1439   begin
1440     if (tl.mFocused <> nil) then tl.mFocused.blurred();
1441     tl.mFocused := self;
1442     if (uiGrabCtl <> self) then uiGrabCtl := nil;
1443     activated();
1444   end;
1445 end;
1446
1447
1448 function TUIControl.getCanFocus (): Boolean; inline;
1449 begin
1450   result := (getEnabled) and (mCanFocus) and (mWidth > 0) and (mHeight > 0);
1451 end;
1452
1453
1454 function TUIControl.isMyChild (ctl: TUIControl): Boolean;
1455 begin
1456   result := true;
1457   while (ctl <> nil) do
1458   begin
1459     if (ctl.mParent = self) then exit;
1460     ctl := ctl.mParent;
1461   end;
1462   result := false;
1463 end;
1464
1465
1466 // returns `true` if global coords are inside this control
1467 function TUIControl.toLocal (var x, y: Integer): Boolean;
1468 begin
1469   if (mParent = nil) then
1470   begin
1471     Dec(x, mX);
1472     Dec(y, mY);
1473     result := true; // hack
1474   end
1475   else
1476   begin
1477     result := mParent.toLocal(x, y);
1478     Inc(x, mParent.mScrollX);
1479     Inc(y, mParent.mScrollY);
1480     Dec(x, mX);
1481     Dec(y, mY);
1482     if result then result := (x >= 0) and (y >= 0) and (x < mParent.mWidth) and (y < mParent.mHeight);
1483   end;
1484   if result then result := (x >= 0) and (y >= 0) and (x < mWidth) and (y < mHeight);
1485 end;
1486
1487 function TUIControl.toLocal (gx, gy: Integer; out x, y: Integer): Boolean; inline;
1488 begin
1489   x := gx;
1490   y := gy;
1491   result := toLocal(x, y);
1492 end;
1493
1494
1495 procedure TUIControl.toGlobal (var x, y: Integer);
1496 begin
1497   Inc(x, mX);
1498   Inc(y, mY);
1499   if (mParent <> nil) then
1500   begin
1501     Dec(x, mParent.mScrollX);
1502     Dec(y, mParent.mScrollY);
1503     mParent.toGlobal(x, y);
1504   end;
1505 end;
1506
1507 procedure TUIControl.toGlobal (lx, ly: Integer; out x, y: Integer); inline;
1508 begin
1509   x := lx;
1510   y := ly;
1511   toGlobal(x, y);
1512 end;
1513
1514 procedure TUIControl.getDrawRect (out gx, gy, wdt, hgt: Integer);
1515 var
1516   cgx, cgy: Integer;
1517 begin
1518   if (mParent = nil) then
1519   begin
1520     gx := mX;
1521     gy := mY;
1522     wdt := mWidth;
1523     hgt := mHeight;
1524   end
1525   else
1526   begin
1527     toGlobal(0, 0, cgx, cgy);
1528     mParent.getDrawRect(gx, gy, wdt, hgt);
1529     if (wdt > 0) and (hgt > 0) then
1530     begin
1531       if (not intersectRect(gx, gy, wdt, hgt, cgx, cgy, mWidth, mHeight)) then
1532       begin
1533         wdt := 0;
1534         hgt := 0;
1535       end;
1536     end;
1537   end;
1538 end;
1539
1540
1541 // x and y are global coords
1542 function TUIControl.controlAtXY (x, y: Integer; allowDisabled: Boolean=false): TUIControl;
1543 var
1544   lx, ly: Integer;
1545   f: Integer;
1546 begin
1547   result := nil;
1548   if (not allowDisabled) and (not enabled) then exit;
1549   if (mWidth < 1) or (mHeight < 1) then exit;
1550   if not toLocal(x, y, lx, ly) then exit;
1551   for f := High(mChildren) downto 0 do
1552   begin
1553     result := mChildren[f].controlAtXY(x, y, allowDisabled);
1554     if (result <> nil) then exit;
1555   end;
1556   result := self;
1557 end;
1558
1559
1560 function TUIControl.parentScrollX (): Integer; inline; begin if (mParent <> nil) then result := mParent.mScrollX else result := 0; end;
1561 function TUIControl.parentScrollY (): Integer; inline; begin if (mParent <> nil) then result := mParent.mScrollY else result := 0; end;
1562
1563
1564 procedure TUIControl.makeVisibleInParent ();
1565 var
1566   sy, ey, cy: Integer;
1567   p: TUIControl;
1568 begin
1569   if (mWidth < 1) or (mHeight < 1) then exit;
1570   p := mParent;
1571   if (p = nil) then exit;
1572   if (p.mFullSize.w < 1) or (p.mFullSize.h < 1) then
1573   begin
1574     p.mScrollX := 0;
1575     p.mScrollY := 0;
1576     exit;
1577   end;
1578   p.makeVisibleInParent();
1579   cy := mY-p.mFrameHeight;
1580   sy := p.mScrollY;
1581   ey := sy+(p.mHeight-p.mFrameHeight*2);
1582   if (cy < sy) then
1583   begin
1584     p.mScrollY := nmax(0, cy);
1585   end
1586   else if (cy+mHeight > ey) then
1587   begin
1588     p.mScrollY := nmax(0, cy+mHeight-(p.mHeight-p.mFrameHeight*2));
1589   end;
1590 end;
1591
1592
1593 // ////////////////////////////////////////////////////////////////////////// //
1594 function TUIControl.prevSibling (): TUIControl;
1595 var
1596   f: Integer;
1597 begin
1598   if (mParent <> nil) then
1599   begin
1600     for f := 1 to High(mParent.mChildren) do
1601     begin
1602       if (mParent.mChildren[f] = self) then begin result := mParent.mChildren[f-1]; exit; end;
1603     end;
1604   end;
1605   result := nil;
1606 end;
1607
1608 function TUIControl.nextSibling (): TUIControl;
1609 var
1610   f: Integer;
1611 begin
1612   if (mParent <> nil) then
1613   begin
1614     for f := 0 to High(mParent.mChildren)-1 do
1615     begin
1616       if (mParent.mChildren[f] = self) then begin result := mParent.mChildren[f+1]; exit; end;
1617     end;
1618   end;
1619   result := nil;
1620 end;
1621
1622 function TUIControl.firstChild (): TUIControl; inline;
1623 begin
1624   if (Length(mChildren) <> 0) then result := mChildren[0] else result := nil;
1625 end;
1626
1627 function TUIControl.lastChild (): TUIControl; inline;
1628 begin
1629   if (Length(mChildren) <> 0) then result := mChildren[High(mChildren)] else result := nil;
1630 end;
1631
1632
1633 function TUIControl.findFirstFocus (): TUIControl;
1634 var
1635   f: Integer;
1636 begin
1637   result := nil;
1638   if enabled then
1639   begin
1640     for f := 0 to High(mChildren) do
1641     begin
1642       result := mChildren[f].findFirstFocus();
1643       if (result <> nil) then exit;
1644     end;
1645     if (canFocus) then result := self;
1646   end;
1647 end;
1648
1649
1650 function TUIControl.findLastFocus (): TUIControl;
1651 var
1652   f: Integer;
1653 begin
1654   result := nil;
1655   if enabled then
1656   begin
1657     for f := High(mChildren) downto 0 do
1658     begin
1659       result := mChildren[f].findLastFocus();
1660       if (result <> nil) then exit;
1661     end;
1662     if (canFocus) then result := self;
1663   end;
1664 end;
1665
1666
1667 function TUIControl.findNextFocus (cur: TUIControl; wrap: Boolean): TUIControl;
1668 var
1669   curHit: Boolean = false;
1670
1671   function checkFocus (ctl: TUIControl): Boolean;
1672   begin
1673     if curHit then
1674     begin
1675       result := (ctl.canFocus);
1676     end
1677     else
1678     begin
1679       curHit := (ctl = cur);
1680       result := false; // don't stop
1681     end;
1682   end;
1683
1684 begin
1685   result := nil;
1686   if enabled then
1687   begin
1688     if not isMyChild(cur) then
1689     begin
1690       result := findFirstFocus();
1691     end
1692     else
1693     begin
1694       result := forEachControl(checkFocus);
1695       if (result = nil) and (wrap) then result := findFirstFocus();
1696     end;
1697   end;
1698 end;
1699
1700
1701 function TUIControl.findPrevFocus (cur: TUIControl; wrap: Boolean): TUIControl;
1702 var
1703   lastCtl: TUIControl = nil;
1704
1705   function checkFocus (ctl: TUIControl): Boolean;
1706   begin
1707     if (ctl = cur) then
1708     begin
1709       result := true;
1710     end
1711     else
1712     begin
1713       result := false;
1714       if (ctl.canFocus) then lastCtl := ctl;
1715     end;
1716   end;
1717
1718 begin
1719   result := nil;
1720   if enabled then
1721   begin
1722     if not isMyChild(cur) then
1723     begin
1724       result := findLastFocus();
1725     end
1726     else
1727     begin
1728       forEachControl(checkFocus);
1729       if (lastCtl = nil) and (wrap) then lastCtl := findLastFocus();
1730       result := lastCtl;
1731       //if (lastCtl <> nil) then writeln('ctl<', lastCtl.className, '>: {', lastCtl.id, '}');
1732     end;
1733   end;
1734 end;
1735
1736
1737 function TUIControl.findDefaulControl (): TUIControl;
1738 var
1739   ctl: TUIControl;
1740 begin
1741   if (enabled) then
1742   begin
1743     if (mDefault) then begin result := self; exit; end;
1744     for ctl in mChildren do
1745     begin
1746       result := ctl.findDefaulControl();
1747       if (result <> nil) then exit;
1748     end;
1749   end;
1750   result := nil;
1751 end;
1752
1753 function TUIControl.findCancelControl (): TUIControl;
1754 var
1755   ctl: TUIControl;
1756 begin
1757   if (enabled) then
1758   begin
1759     if (mCancel) then begin result := self; exit; end;
1760     for ctl in mChildren do
1761     begin
1762       result := ctl.findCancelControl();
1763       if (result <> nil) then exit;
1764     end;
1765   end;
1766   result := nil;
1767 end;
1768
1769
1770 function TUIControl.findControlById (const aid: AnsiString): TUIControl;
1771 var
1772   ctl: TUIControl;
1773 begin
1774   if (strEquCI1251(aid, mId)) then begin result := self; exit; end;
1775   for ctl in mChildren do
1776   begin
1777     result := ctl.findControlById(aid);
1778     if (result <> nil) then exit;
1779   end;
1780   result := nil;
1781 end;
1782
1783
1784 procedure TUIControl.appendChild (ctl: TUIControl);
1785 begin
1786   if (ctl = nil) then exit;
1787   if (ctl.mParent <> nil) then exit;
1788   SetLength(mChildren, Length(mChildren)+1);
1789   mChildren[High(mChildren)] := ctl;
1790   ctl.mParent := self;
1791   Inc(ctl.mX, mFrameWidth);
1792   Inc(ctl.mY, mFrameHeight);
1793   if (ctl.mWidth > 0) and (ctl.mHeight > 0) and
1794      (ctl.mX+ctl.mWidth > mFrameWidth) and (ctl.mY+ctl.mHeight > mFrameHeight) then
1795   begin
1796     if (mWidth+mFrameWidth < ctl.mX+ctl.mWidth) then mWidth := ctl.mX+ctl.mWidth+mFrameWidth;
1797     if (mHeight+mFrameHeight < ctl.mY+ctl.mHeight) then mHeight := ctl.mY+ctl.mHeight+mFrameHeight;
1798   end;
1799 end;
1800
1801
1802 function TUIControl.setActionCBFor (const aid: AnsiString; cb: TActionCB): TActionCB;
1803 var
1804   ctl: TUIControl;
1805 begin
1806   ctl := self[aid];
1807   if (ctl <> nil) then
1808   begin
1809     result := ctl.actionCB;
1810     ctl.actionCB := cb;
1811   end
1812   else
1813   begin
1814     result := nil;
1815   end;
1816 end;
1817
1818
1819 function TUIControl.forEachChildren (cb: TCtlEnumCB): TUIControl;
1820 var
1821   ctl: TUIControl;
1822 begin
1823   result := nil;
1824   if (not assigned(cb)) then exit;
1825   for ctl in mChildren do
1826   begin
1827     if cb(ctl) then begin result := ctl; exit; end;
1828   end;
1829 end;
1830
1831
1832 function TUIControl.forEachControl (cb: TCtlEnumCB; includeSelf: Boolean=true): TUIControl;
1833
1834   function forChildren (p: TUIControl; incSelf: Boolean): TUIControl;
1835   var
1836     ctl: TUIControl;
1837   begin
1838     result := nil;
1839     if (p = nil) then exit;
1840     if (incSelf) and (cb(p)) then begin result := p; exit; end;
1841     for ctl in p.mChildren do
1842     begin
1843       result := forChildren(ctl, true);
1844       if (result <> nil) then break;
1845     end;
1846   end;
1847
1848 begin
1849   result := nil;
1850   if (not assigned(cb)) then exit;
1851   result := forChildren(self, includeSelf);
1852 end;
1853
1854
1855 procedure TUIControl.close (); // this closes *top-level* control
1856 var
1857   ctl: TUIControl;
1858 begin
1859   ctl := topLevel;
1860   uiRemoveWindow(ctl);
1861   if (ctl is TUITopWindow) and (TUITopWindow(ctl).mFreeOnClose) then scheduleKill(ctl); // just in case
1862 end;
1863
1864
1865 procedure TUIControl.doAction ();
1866 begin
1867   if assigned(actionCB) then actionCB(self);
1868 end;
1869
1870
1871 // ////////////////////////////////////////////////////////////////////////// //
1872 procedure TUIControl.setScissor (lx, ly, lw, lh: Integer);
1873 var
1874   gx, gy, wdt, hgt, cgx, cgy: Integer;
1875 begin
1876   if (not intersectRect(lx, ly, lw, lh, 0, 0, mWidth, mHeight)) then
1877   begin
1878     uiContext.clip := TGxRect.Create(0, 0, 0, 0);
1879     exit;
1880   end;
1881
1882   getDrawRect(gx, gy, wdt, hgt);
1883
1884   toGlobal(lx, ly, cgx, cgy);
1885   if (not intersectRect(gx, gy, wdt, hgt, cgx, cgy, lw, lh)) then
1886   begin
1887     uiContext.clip := TGxRect.Create(0, 0, 0, 0);
1888     exit;
1889   end;
1890
1891   uiContext.clip := savedClip;
1892   uiContext.combineClip(TGxRect.Create(gx, gy, wdt, hgt));
1893   //uiContext.clip := TGxRect.Create(gx, gy, wdt, hgt);
1894 end;
1895
1896
1897
1898 // ////////////////////////////////////////////////////////////////////////// //
1899 procedure TUIControl.drawFrame (gx, gy, resx, thalign: Integer; const text: AnsiString; dbl: Boolean);
1900 var
1901   cidx, tx, tw: Integer;
1902 begin
1903   if (mFrameWidth < 1) or (mFrameHeight < 1) then exit;
1904   cidx := getColorIndex;
1905   uiContext.color := mFrameColor[cidx];
1906   case mFrameHeight of
1907     8:
1908       begin
1909         if dbl then
1910         begin
1911           uiContext.rect(gx+3, gy+3, mWidth-6, mHeight-6);
1912           uiContext.rect(gx+5, gy+5, mWidth-10, mHeight-10);
1913         end
1914         else
1915         begin
1916           uiContext.rect(gx+4, gy+4, mWidth-8, mHeight-8);
1917         end;
1918       end;
1919     14:
1920       begin
1921         if dbl then
1922         begin
1923           uiContext.rect(gx+3, gy+3+3, mWidth-6, mHeight-6-6);
1924           uiContext.rect(gx+5, gy+5+3, mWidth-10, mHeight-10-6);
1925         end
1926         else
1927         begin
1928           uiContext.rect(gx+4, gy+4+3, mWidth-8, mHeight-8-6);
1929         end;
1930       end;
1931     16:
1932       begin
1933         if dbl then
1934         begin
1935           uiContext.rect(gx+3, gy+3+4, mWidth-6, mHeight-6-8);
1936           uiContext.rect(gx+5, gy+5+4, mWidth-10, mHeight-10-8);
1937         end
1938         else
1939         begin
1940           uiContext.rect(gx+4, gy+4+4, mWidth-8, mHeight-8-8);
1941         end;
1942       end;
1943     else
1944       begin
1945         //TODO!
1946         if dbl then
1947         begin
1948         end
1949         else
1950         begin
1951         end;
1952       end;
1953   end;
1954
1955   // title
1956   if (Length(text) > 0) then
1957   begin
1958     if (resx < 0) then resx := 0;
1959     tw := uiContext.textWidth(text);
1960     setScissor(mFrameWidth+resx, 0, mWidth-mFrameWidth*2-resx, mFrameHeight);
1961          if (thalign < 0) then tx := gx+resx+mFrameWidth+2
1962     else if (thalign > 0) then tx := gx+mWidth-mFrameWidth-1-tw
1963     else tx := (gx+resx+mFrameWidth)+(mWidth-mFrameWidth*2-resx-tw) div 2;
1964     uiContext.color := mBackColor[cidx];
1965     uiContext.fillRect(tx-2, gy, tw+4, mFrameHeight);
1966     uiContext.color := mFrameTextColor[cidx];
1967     uiContext.drawText(tx, gy, text);
1968   end;
1969 end;
1970
1971
1972 procedure TUIControl.draw ();
1973 var
1974   f: Integer;
1975   gx, gy: Integer;
1976
1977   procedure resetScissor (fullArea: Boolean); inline;
1978   begin
1979     uiContext.clip := savedClip;
1980     if (fullArea) or ((mFrameWidth = 0) and (mFrameHeight = 0)) then
1981     begin
1982       setScissor(0, 0, mWidth, mHeight);
1983     end
1984     else
1985     begin
1986       //writeln('frm: (', mFrameWidth, 'x', mFrameHeight, ')');
1987       setScissor(mFrameWidth, mFrameHeight, mWidth-mFrameWidth*2, mHeight-mFrameHeight*2);
1988     end;
1989   end;
1990
1991 begin
1992   if (mWidth < 1) or (mHeight < 1) or (uiContext = nil) or (not uiContext.active) then exit;
1993   toGlobal(0, 0, gx, gy);
1994
1995   savedClip := uiContext.clip;
1996   try
1997     resetScissor(true); // full area
1998     drawControl(gx, gy);
1999     resetScissor(false); // client area
2000     for f := 0 to High(mChildren) do mChildren[f].draw();
2001     resetScissor(true); // full area
2002     if (self is TUISwitchBox) then
2003     begin
2004       uiContext.color := TGxRGBA.Create(255, 0, 0, 255);
2005       //uiContext.fillRect(gx, gy, mWidth, mHeight);
2006       //writeln('frm: (', mFrameWidth, 'x', mFrameHeight, '); sz=(', mWidth, 'x', mHeight, '); clip=', uiContext.clip.toString);
2007     end;
2008     if false and (mId = 'cbtest') then
2009     begin
2010       uiContext.color := TGxRGBA.Create(255, 127, 0, 96);
2011       uiContext.fillRect(gx, gy, mWidth, mHeight);
2012       if (mFrameWidth > 0) and (mFrameHeight > 0) then
2013       begin
2014         uiContext.color := TGxRGBA.Create(255, 255, 0, 96);
2015         uiContext.fillRect(gx+mFrameWidth, gy+mFrameHeight, mWidth-mFrameWidth*2, mHeight-mFrameHeight*2);
2016       end;
2017     end
2018     else if false and (self is TUISwitchBox) then
2019     begin
2020       uiContext.color := TGxRGBA.Create(255, 0, 0, 255);
2021       uiContext.fillRect(gx, gy, mWidth, mHeight);
2022       //writeln('frm: (', mFrameWidth, 'x', mFrameHeight, ')');
2023     end;
2024     drawControlPost(gx, gy);
2025   finally
2026     uiContext.clip := savedClip;
2027   end;
2028 end;
2029
2030 procedure TUIControl.drawControl (gx, gy: Integer);
2031 begin
2032   //if (mParent = nil) then darkenRect(gx, gy, mWidth, mHeight, 64);
2033 end;
2034
2035 procedure TUIControl.drawControlPost (gx, gy: Integer);
2036 begin
2037   // shadow
2038   if (mParent = nil) and (mDrawShadow) and (mWidth > 0) and (mHeight > 0) then
2039   begin
2040     //setScissorGLInternal(gx+8, gy+8, mWidth, mHeight);
2041     uiContext.resetClip();
2042     uiContext.darkenRect(gx+mWidth, gy+8, 8, mHeight, 128);
2043     uiContext.darkenRect(gx+8, gy+mHeight, mWidth-8, 8, 128);
2044   end;
2045 end;
2046
2047
2048 // ////////////////////////////////////////////////////////////////////////// //
2049 procedure TUIControl.mouseEvent (var ev: THMouseEvent);
2050 var
2051   ctl: TUIControl;
2052 begin
2053   if (not enabled) then exit;
2054   if (mWidth < 1) or (mHeight < 1) then exit;
2055   ctl := controlAtXY(ev.x, ev.y);
2056   if (ctl = nil) then exit;
2057   if (ctl.canFocus) and (ev.press) then
2058   begin
2059     if (ctl <> topLevel.mFocused) then ctl.setFocused(true);
2060     uiGrabCtl := ctl;
2061   end;
2062   if (ctl <> self) then ctl.mouseEvent(ev);
2063   //ev.eat();
2064 end;
2065
2066
2067 procedure TUIControl.keyEvent (var ev: THKeyEvent);
2068
2069   function doPreKey (ctl: TUIControl): Boolean;
2070   begin
2071     if (not ctl.enabled) then begin result := false; exit; end;
2072     ctl.keyEventPre(ev);
2073     result := (ev.eaten) or (ev.cancelled); // stop if event was consumed
2074   end;
2075
2076   function doPostKey (ctl: TUIControl): Boolean;
2077   begin
2078     if (not ctl.enabled) then begin result := false; exit; end;
2079     ctl.keyEventPost(ev);
2080     result := (ev.eaten) or (ev.cancelled); // stop if event was consumed
2081   end;
2082
2083 var
2084   ctl: TUIControl;
2085 begin
2086   if (not enabled) then exit;
2087   if (ev.eaten) or (ev.cancelled) then exit;
2088   // call pre-key
2089   if (mParent = nil) then
2090   begin
2091     forEachControl(doPreKey);
2092     if (ev.eaten) or (ev.cancelled) then exit;
2093   end;
2094   // focused control should process keyboard first
2095   if (topLevel.mFocused <> self) and isMyChild(topLevel.mFocused) and (topLevel.mFocused.enabled) then
2096   begin
2097     // bubble keyboard event
2098     ctl := topLevel.mFocused;
2099     while (ctl <> nil) and (ctl <> self) do
2100     begin
2101       ctl.keyEvent(ev);
2102       if (ev.eaten) or (ev.cancelled) then exit;
2103       ctl := ctl.mParent;
2104     end;
2105   end;
2106   // for top-level controls
2107   if (mParent = nil) then
2108   begin
2109     if (ev = 'S-Tab') then
2110     begin
2111       ctl := findPrevFocus(mFocused, true);
2112       if (ctl <> nil) and (ctl <> mFocused) then ctl.setFocused(true);
2113       ev.eat();
2114       exit;
2115     end;
2116     if (ev = 'Tab') then
2117     begin
2118       ctl := findNextFocus(mFocused, true);
2119       if (ctl <> nil) and (ctl <> mFocused) then ctl.setFocused(true);
2120       ev.eat();
2121       exit;
2122     end;
2123     if (ev = 'Enter') or (ev = 'C-Enter') then
2124     begin
2125       ctl := findDefaulControl();
2126       if (ctl <> nil) then
2127       begin
2128         ev.eat();
2129         ctl.doAction();
2130         exit;
2131       end;
2132     end;
2133     if (ev = 'Escape') then
2134     begin
2135       ctl := findCancelControl();
2136       if (ctl <> nil) then
2137       begin
2138         ev.eat();
2139         ctl.doAction();
2140         exit;
2141       end;
2142     end;
2143     if mEscClose and (ev = 'Escape') then
2144     begin
2145       if (not assigned(closeRequestCB)) or (closeRequestCB(self)) then
2146       begin
2147         uiRemoveWindow(self);
2148       end;
2149       ev.eat();
2150       exit;
2151     end;
2152     // call post-keys
2153     if (ev.eaten) or (ev.cancelled) then exit;
2154     forEachControl(doPostKey);
2155   end;
2156 end;
2157
2158
2159 procedure TUIControl.keyEventPre (var ev: THKeyEvent);
2160 begin
2161 end;
2162
2163
2164 procedure TUIControl.keyEventPost (var ev: THKeyEvent);
2165 begin
2166 end;
2167
2168
2169 // ////////////////////////////////////////////////////////////////////////// //
2170 constructor TUITopWindow.Create (const atitle: AnsiString);
2171 begin
2172   inherited Create();
2173   mTitle := atitle;
2174 end;
2175
2176
2177 procedure TUITopWindow.AfterConstruction ();
2178 begin
2179   inherited;
2180   mFitToScreen := true;
2181   mFrameWidth := 8;
2182   mFrameHeight := uiContext.charHeight(#184);
2183   if (mWidth < mFrameWidth*2+uiContext.iconWinWidth(TGxContext.TWinIcon.Close)) then mWidth := mFrameWidth*2+uiContext.iconWinWidth(TGxContext.TWinIcon.Close);
2184   if (mHeight < mFrameHeight*2) then mHeight := mFrameHeight*2;
2185   if (Length(mTitle) > 0) then
2186   begin
2187     if (mWidth < uiContext.textWidth(mTitle)+mFrameWidth*2+uiContext.iconWinWidth(TGxContext.TWinIcon.Close)) then
2188     begin
2189       mWidth := uiContext.textWidth(mTitle)+mFrameWidth*2+uiContext.iconWinWidth(TGxContext.TWinIcon.Close);
2190     end;
2191   end;
2192   mCanFocus := false;
2193   mDragScroll := TXMode.None;
2194   mDrawShadow := true;
2195   mWaitingClose := false;
2196   mInClose := false;
2197   closeCB := nil;
2198   mCtl4Style := 'window';
2199   mDefSize.w := nmax(1, mDefSize.w);
2200   mDefSize.h := nmax(1, mDefSize.h);
2201 end;
2202
2203
2204 function TUITopWindow.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
2205 begin
2206   if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) then
2207   begin
2208     mTitle := par.expectIdOrStr(true);
2209     result := true;
2210     exit;
2211   end;
2212   if (strEquCI1251(prname, 'children')) then
2213   begin
2214     parseChildren(par);
2215     result := true;
2216     exit;
2217   end;
2218   if (strEquCI1251(prname, 'position')) then
2219   begin
2220          if (par.eatIdOrStrCI('default')) then mDoCenter := false
2221     else if (par.eatIdOrStrCI('center')) then mDoCenter := true
2222     else par.error('`center` or `default` expected');
2223     result := true;
2224     exit;
2225   end;
2226   if (parseOrientation(prname, par)) then begin result := true; exit; end;
2227   result := inherited parseProperty(prname, par);
2228 end;
2229
2230
2231 procedure TUITopWindow.flFitToScreen ();
2232 var
2233   nsz: TLaySize;
2234 begin
2235   nsz := TLaySize.Create(trunc(fuiScrWdt/fuiRenderScale)-mFrameWidth*2-6, trunc(fuiScrHgt/fuiRenderScale)-mFrameHeight*2-6);
2236   if (mMaxSize.w < 1) then mMaxSize.w := nsz.w;
2237   if (mMaxSize.h < 1) then mMaxSize.h := nsz.h;
2238 end;
2239
2240
2241 procedure TUITopWindow.centerInScreen ();
2242 begin
2243   if (mWidth > 0) and (mHeight > 0) then
2244   begin
2245     mX := trunc((fuiScrWdt/fuiRenderScale-mWidth)/2);
2246     mY := trunc((fuiScrHgt/fuiRenderScale-mHeight)/2);
2247   end;
2248 end;
2249
2250
2251 procedure TUITopWindow.drawControl (gx, gy: Integer);
2252 begin
2253   uiContext.color := mBackColor[getColorIndex];
2254   uiContext.fillRect(gx, gy, mWidth, mHeight);
2255 end;
2256
2257 procedure TUITopWindow.drawControlPost (gx, gy: Integer);
2258 var
2259   cidx: Integer;
2260   hgt, sbhgt, iwdt, ihgt: Integer;
2261 begin
2262   cidx := getColorIndex;
2263   iwdt := uiContext.iconWinWidth(TGxContext.TWinIcon.Close);
2264   if (mDragScroll = TXMode.Drag) then
2265   begin
2266     //uiContext.color := mFrameColor[cidx];
2267     drawFrame(gx, gy, iwdt, 0, mTitle, false);
2268   end
2269   else
2270   begin
2271     ihgt := uiContext.iconWinHeight(TGxContext.TWinIcon.Close);
2272     //uiContext.color := mFrameColor[cidx];
2273     drawFrame(gx, gy, iwdt, 0, mTitle, true);
2274     // vertical scroll bar
2275     hgt := mHeight-mFrameHeight*2;
2276     if (hgt > 0) and (mFullSize.h > hgt) then
2277     begin
2278       //writeln(mTitle, ': height=', mHeight-mFrameHeight*2, '; fullsize=', mFullSize.toString);
2279       sbhgt := mHeight-mFrameHeight*2+2;
2280       uiContext.fillRect(gx+mWidth-mFrameWidth+1, gy+mFrameHeight-1, mFrameWidth-3, sbhgt);
2281       hgt += mScrollY;
2282       if (hgt > mFullSize.h) then hgt := mFullSize.h;
2283       hgt := sbhgt*hgt div mFullSize.h;
2284       if (hgt > 0) then
2285       begin
2286         setScissor(mWidth-mFrameWidth+1, mFrameHeight-1, mFrameWidth-3, sbhgt);
2287         uiContext.darkenRect(gx+mWidth-mFrameWidth+1, gy+mFrameHeight-1+hgt, mFrameWidth-3, sbhgt, 128);
2288       end;
2289     end;
2290     // frame icon
2291     setScissor(mFrameWidth, 0, iwdt, ihgt);
2292     uiContext.color := mBackColor[cidx];
2293     uiContext.fillRect(gx+mFrameWidth, gy, iwdt, ihgt);
2294     uiContext.color := mFrameIconColor[cidx];
2295     uiContext.drawIconWin(TGxContext.TWinIcon.Close, gx+mFrameWidth, gy, mInClose);
2296   end;
2297   // shadow
2298   inherited drawControlPost(gx, gy);
2299 end;
2300
2301
2302 procedure TUITopWindow.activated ();
2303 begin
2304   if (mFocused = nil) or (mFocused = self) then
2305   begin
2306     mFocused := findFirstFocus();
2307   end;
2308   if (mFocused <> nil) and (mFocused <> self) then mFocused.activated();
2309   inherited;
2310 end;
2311
2312
2313 procedure TUITopWindow.blurred ();
2314 begin
2315   mDragScroll := TXMode.None;
2316   mWaitingClose := false;
2317   mInClose := false;
2318   if (mFocused <> nil) and (mFocused <> self) then mFocused.blurred();
2319   inherited;
2320 end;
2321
2322
2323 procedure TUITopWindow.keyEvent (var ev: THKeyEvent);
2324 begin
2325   inherited keyEvent(ev);
2326   if (ev.eaten) or (ev.cancelled) or (not enabled) {or (not getFocused)} then exit;
2327   if (ev = 'M-F3') then
2328   begin
2329     if (not assigned(closeRequestCB)) or (closeRequestCB(self)) then
2330     begin
2331       uiRemoveWindow(self);
2332     end;
2333     ev.eat();
2334     exit;
2335   end;
2336 end;
2337
2338
2339 procedure TUITopWindow.mouseEvent (var ev: THMouseEvent);
2340 var
2341   lx, ly: Integer;
2342   hgt, sbhgt: Integer;
2343 begin
2344   if (not enabled) then exit;
2345   if (mWidth < 1) or (mHeight < 1) then exit;
2346
2347   if (mDragScroll = TXMode.Drag) then
2348   begin
2349     mX += ev.x-mDragStartX;
2350     mY += ev.y-mDragStartY;
2351     mDragStartX := ev.x;
2352     mDragStartY := ev.y;
2353     if (ev.release) and (ev.but = ev.Left) then mDragScroll := TXMode.None;
2354     ev.eat();
2355     exit;
2356   end;
2357
2358   if (mDragScroll = TXMode.Scroll) then
2359   begin
2360     // check for vertical scrollbar
2361     ly := ev.y-mY;
2362     if (ly < 7) then
2363     begin
2364       mScrollY := 0;
2365     end
2366     else
2367     begin
2368       sbhgt := mHeight-mFrameHeight*2+2;
2369       hgt := mHeight-mFrameHeight*2;
2370       if (hgt > 0) and (mFullSize.h > hgt) then
2371       begin
2372         hgt := (mFullSize.h*(ly-7) div (sbhgt-1))-(mHeight-mFrameHeight*2);
2373         mScrollY := nmax(0, hgt);
2374         hgt := mHeight-mFrameHeight*2;
2375         if (mScrollY+hgt > mFullSize.h) then mScrollY := nmax(0, mFullSize.h-hgt);
2376       end;
2377     end;
2378     if (ev.release) and (ev.but = ev.Left) then mDragScroll := TXMode.None;
2379     ev.eat();
2380     exit;
2381   end;
2382
2383   if toLocal(ev.x, ev.y, lx, ly) then
2384   begin
2385     if (ev.press) then
2386     begin
2387       if (ly < mFrameHeight) then
2388       begin
2389         uiGrabCtl := self;
2390         if (lx >= mFrameWidth) and (lx < mFrameWidth+uiContext.iconWinWidth(TGxContext.TWinIcon.Close)) then
2391         begin
2392           //uiRemoveWindow(self);
2393           mWaitingClose := true;
2394           mInClose := true;
2395         end
2396         else
2397         begin
2398           mDragScroll := TXMode.Drag;
2399           mDragStartX := ev.x;
2400           mDragStartY := ev.y;
2401         end;
2402         ev.eat();
2403         exit;
2404       end;
2405       // check for vertical scrollbar
2406       if (lx >= mWidth-mFrameWidth+1) and (ly >= 7) and (ly < mHeight-mFrameHeight+1) then
2407       begin
2408         sbhgt := mHeight-mFrameHeight*2+2;
2409         hgt := mHeight-mFrameHeight*2;
2410         if (hgt > 0) and (mFullSize.h > hgt) then
2411         begin
2412           hgt := (mFullSize.h*(ly-7) div (sbhgt-1))-(mHeight-mFrameHeight*2);
2413           mScrollY := nmax(0, hgt);
2414           uiGrabCtl := self;
2415           mDragScroll := TXMode.Scroll;
2416           ev.eat();
2417           exit;
2418         end;
2419       end;
2420       // drag
2421       if (lx < mFrameWidth) or (lx >= mWidth-mFrameWidth) or (ly >= mHeight-mFrameHeight) then
2422       begin
2423         uiGrabCtl := self;
2424         mDragScroll := TXMode.Drag;
2425         mDragStartX := ev.x;
2426         mDragStartY := ev.y;
2427         ev.eat();
2428         exit;
2429       end;
2430     end;
2431
2432     if (ev.release) then
2433     begin
2434       if mWaitingClose then
2435       begin
2436         if (lx >= mFrameWidth) and (lx < mFrameWidth+uiContext.iconWinWidth(TGxContext.TWinIcon.Close)) then
2437         begin
2438           if (not assigned(closeRequestCB)) or (closeRequestCB(self)) then
2439           begin
2440             uiRemoveWindow(self);
2441           end;
2442         end;
2443         mWaitingClose := false;
2444         mInClose := false;
2445         ev.eat();
2446         exit;
2447       end;
2448     end;
2449
2450     if (ev.motion) then
2451     begin
2452       if mWaitingClose then
2453       begin
2454         mInClose := (lx >= mFrameWidth) and (lx < mFrameWidth+uiContext.iconWinWidth(TGxContext.TWinIcon.Close));
2455         ev.eat();
2456         exit;
2457       end;
2458     end;
2459
2460     inherited mouseEvent(ev);
2461   end
2462   else
2463   begin
2464     mInClose := false;
2465     if (not ev.motion) and (mWaitingClose) then begin ev.eat(); mWaitingClose := false; exit; end;
2466   end;
2467 end;
2468
2469
2470 // ////////////////////////////////////////////////////////////////////////// //
2471 constructor TUIBox.Create (ahoriz: Boolean);
2472 begin
2473   inherited Create();
2474   mHoriz := ahoriz;
2475 end;
2476
2477
2478 procedure TUIBox.AfterConstruction ();
2479 begin
2480   inherited;
2481   mCanFocus := false;
2482   mHAlign := -1; // left
2483   mCtl4Style := 'box';
2484   mDefSize := TLaySize.Create(-1, -1);
2485 end;
2486
2487
2488 procedure TUIBox.setCaption (const acap: AnsiString);
2489 begin
2490   mCaption := acap;
2491   mDefSize := TLaySize.Create(uiContext.textWidth(mCaption)+3, uiContext.textHeight(mCaption));
2492 end;
2493
2494
2495 procedure TUIBox.setHasFrame (v: Boolean);
2496 begin
2497   mHasFrame := v;
2498   if (mHasFrame) then begin mFrameWidth := 8; mFrameHeight := uiContext.charHeight(#184); end else begin mFrameWidth := 0; mFrameHeight := 0; end;
2499   if (mHasFrame) then mNoPad := true;
2500 end;
2501
2502
2503 function TUIBox.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
2504 begin
2505   if (parseOrientation(prname, par)) then begin result := true; exit; end;
2506   if (strEquCI1251(prname, 'padding')) then
2507   begin
2508     if (mHoriz) then mPadding := parseHPadding(par, 0) else mPadding := parseVPadding(par, 0);
2509     result := true;
2510     exit;
2511   end;
2512   if (strEquCI1251(prname, 'frame')) then
2513   begin
2514     setHasFrame(parseBool(par));
2515     result := true;
2516     exit;
2517   end;
2518   if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) then
2519   begin
2520     setCaption(par.expectIdOrStr(true));
2521     result := true;
2522     exit;
2523   end;
2524   if (strEquCI1251(prname, 'textalign')) or (strEquCI1251(prname, 'text-align')) then
2525   begin
2526     mHAlign := parseHAlign(par);
2527     result := true;
2528     exit;
2529   end;
2530   if (strEquCI1251(prname, 'children')) then
2531   begin
2532     parseChildren(par);
2533     result := true;
2534     exit;
2535   end;
2536   result := inherited parseProperty(prname, par);
2537 end;
2538
2539
2540 procedure TUIBox.drawControl (gx, gy: Integer);
2541 var
2542   cidx: Integer;
2543   xpos: Integer;
2544 begin
2545   cidx := getColorIndex;
2546   uiContext.color := mBackColor[cidx];
2547   uiContext.fillRect(gx, gy, mWidth, mHeight);
2548   if (mHasFrame) then
2549   begin
2550     // draw frame
2551     drawFrame(gx, gy, 0, -1, mCaption, false);
2552     //uiContext.color := mFrameColor[cidx];
2553     //uiContext.rect(gx+3, gy+3, mWidth-6, mHeight-6);
2554   end
2555   else if (Length(mCaption) > 0) then
2556   begin
2557     // draw caption
2558          if (mHAlign < 0) then xpos := 3
2559     else if (mHAlign > 0) then xpos := mWidth-mFrameWidth*2-uiContext.textWidth(mCaption)
2560     else xpos := (mWidth-mFrameWidth*2-uiContext.textWidth(mCaption)) div 2;
2561     xpos += gx+mFrameWidth;
2562
2563     setScissor(mFrameWidth+1, 0, mWidth-mFrameWidth-2, uiContext.textHeight(mCaption));
2564     {
2565     if (mHasFrame) then
2566     begin
2567       uiContext.color := mBackColor[cidx];
2568       uiContext.fillRect(xpos-3, gy, uiContext.textWidth(mCaption)+4, 8);
2569     end;
2570     }
2571     uiContext.color := mFrameTextColor[cidx];
2572     uiContext.drawText(xpos, gy, mCaption);
2573   end;
2574 end;
2575
2576
2577 procedure TUIBox.mouseEvent (var ev: THMouseEvent);
2578 var
2579   lx, ly: Integer;
2580 begin
2581   inherited mouseEvent(ev);
2582   if (not ev.eaten) and (not ev.cancelled) and (enabled) and toLocal(ev.x, ev.y, lx, ly) then
2583   begin
2584     ev.eat();
2585   end;
2586 end;
2587
2588
2589 procedure TUIBox.keyEvent (var ev: THKeyEvent);
2590 var
2591   dir: Integer = 0;
2592   cur, ctl: TUIControl;
2593 begin
2594   inherited keyEvent(ev);
2595   if (ev.eaten) or (ev.cancelled) or (not ev.press) or (not enabled) or (not getActive) then exit;
2596   if (Length(mChildren) = 0) then exit;
2597        if (mHoriz) and (ev = 'Left') then dir := -1
2598   else if (mHoriz) and (ev = 'Right') then dir := 1
2599   else if (not mHoriz) and (ev = 'Up') then dir := -1
2600   else if (not mHoriz) and (ev = 'Down') then dir := 1;
2601   if (dir = 0) then exit;
2602   ev.eat();
2603   cur := topLevel.mFocused;
2604   while (cur <> nil) and (cur.mParent <> self) do cur := cur.mParent;
2605   //if (cur = nil) then writeln('CUR: nil') else writeln('CUR: ', cur.className, '#', cur.id);
2606   if (dir < 0) then ctl := findPrevFocus(cur, true) else ctl := findNextFocus(cur, true);
2607   //if (ctl = nil) then writeln('CTL: nil') else writeln('CTL: ', ctl.className, '#', ctl.id);
2608   if (ctl <> nil) and (ctl <> self) then
2609   begin
2610     ctl.focused := true;
2611   end;
2612 end;
2613
2614
2615 // ////////////////////////////////////////////////////////////////////////// //
2616 constructor TUIHBox.Create ();
2617 begin
2618 end;
2619
2620
2621 procedure TUIHBox.AfterConstruction ();
2622 begin
2623   inherited;
2624   mHoriz := true;
2625 end;
2626
2627
2628 // ////////////////////////////////////////////////////////////////////////// //
2629 constructor TUIVBox.Create ();
2630 begin
2631 end;
2632
2633
2634 procedure TUIVBox.AfterConstruction ();
2635 begin
2636   inherited;
2637   mHoriz := false;
2638 end;
2639
2640
2641 // ////////////////////////////////////////////////////////////////////////// //
2642 procedure TUISpan.AfterConstruction ();
2643 begin
2644   inherited;
2645   mExpand := true;
2646   mCanFocus := false;
2647   mNoPad := true;
2648   mCtl4Style := 'span';
2649   mDefSize := TLaySize.Create(-1, -1);
2650 end;
2651
2652
2653 function TUISpan.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
2654 begin
2655   if (parseOrientation(prname, par)) then begin result := true; exit; end;
2656   result := inherited parseProperty(prname, par);
2657 end;
2658
2659
2660 procedure TUISpan.drawControl (gx, gy: Integer);
2661 begin
2662 end;
2663
2664
2665 // ////////////////////////////////////////////////////////////////////// //
2666 procedure TUILine.AfterConstruction ();
2667 begin
2668   inherited;
2669   mCanFocus := false;
2670   mExpand := true;
2671   mCanFocus := false;
2672   mCtl4Style := 'line';
2673   mDefSize := TLaySize.Create(-1, -1);
2674 end;
2675
2676
2677 function TUILine.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
2678 begin
2679   if (parseOrientation(prname, par)) then begin result := true; exit; end;
2680   result := inherited parseProperty(prname, par);
2681 end;
2682
2683
2684 procedure TUILine.layPrepare ();
2685 begin
2686   inherited layPrepare();
2687   if (mParent <> nil) then mHoriz := not mParent.mHoriz;
2688   if (mHoriz) then
2689   begin
2690     if (mLayDefSize.w < 0) then mLayDefSize.w := 1;
2691     if (mLayDefSize.h < 0) then mLayDefSize.h := 7;
2692   end
2693   else
2694   begin
2695     if (mLayDefSize.w < 0) then mLayDefSize.w := 7;
2696     if (mLayDefSize.h < 0) then mLayDefSize.h := 1;
2697   end;
2698 end;
2699
2700
2701 procedure TUILine.drawControl (gx, gy: Integer);
2702 var
2703   cidx: Integer;
2704 begin
2705   cidx := getColorIndex;
2706   uiContext.color := mTextColor[cidx];
2707   if mHoriz then uiContext.hline(gx, gy+(mHeight div 2), mWidth)
2708   else uiContext.vline(gx+(mWidth div 2), gy, mHeight);
2709 end;
2710
2711
2712 // ////////////////////////////////////////////////////////////////////////// //
2713 procedure TUIStaticText.AfterConstruction ();
2714 begin
2715   inherited;
2716   mCanFocus := false;
2717   mHAlign := -1;
2718   mVAlign := 0;
2719   mHoriz := true; // nobody cares
2720   mHeader := false;
2721   mLine := false;
2722   mCtl4Style := 'static';
2723 end;
2724
2725
2726 procedure TUIStaticText.setText (const atext: AnsiString);
2727 begin
2728   mText := atext;
2729   mDefSize := TLaySize.Create(uiContext.textWidth(mText), uiContext.textHeight(mText));
2730 end;
2731
2732
2733 function TUIStaticText.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
2734 begin
2735   if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) or (strEquCI1251(prname, 'text')) then
2736   begin
2737     setText(par.expectIdOrStr(true));
2738     result := true;
2739     exit;
2740   end;
2741   if (strEquCI1251(prname, 'textalign')) or (strEquCI1251(prname, 'text-align')) then
2742   begin
2743     parseTextAlign(par, mHAlign, mVAlign);
2744     result := true;
2745     exit;
2746   end;
2747   if (strEquCI1251(prname, 'header')) then
2748   begin
2749     mHeader := true;
2750     result := true;
2751     exit;
2752   end;
2753   if (strEquCI1251(prname, 'line')) then
2754   begin
2755     mLine := true;
2756     result := true;
2757     exit;
2758   end;
2759   result := inherited parseProperty(prname, par);
2760 end;
2761
2762
2763 procedure TUIStaticText.drawControl (gx, gy: Integer);
2764 var
2765   xpos, ypos: Integer;
2766   cidx: Integer;
2767 begin
2768   cidx := getColorIndex;
2769   uiContext.color := mBackColor[cidx];
2770   uiContext.fillRect(gx, gy, mWidth, mHeight);
2771
2772        if (mHAlign < 0) then xpos := 0
2773   else if (mHAlign > 0) then xpos := mWidth-uiContext.textWidth(mText)
2774   else xpos := (mWidth-uiContext.textWidth(mText)) div 2;
2775
2776   if (Length(mText) > 0) then
2777   begin
2778     if (mHeader) then uiContext.color := mFrameTextColor[cidx] else uiContext.color := mTextColor[cidx];
2779
2780          if (mVAlign < 0) then ypos := 0
2781     else if (mVAlign > 0) then ypos := mHeight-uiContext.textHeight(mText)
2782     else ypos := (mHeight-uiContext.textHeight(mText)) div 2;
2783
2784     uiContext.drawText(gx+xpos, gy+ypos, mText);
2785   end;
2786
2787   if (mLine) then
2788   begin
2789     if (mHeader) then uiContext.color := mFrameColor[cidx] else uiContext.color := mTextColor[cidx];
2790
2791          if (mVAlign < 0) then ypos := 0
2792     else if (mVAlign > 0) then ypos := mHeight-1
2793     else ypos := (mHeight div 2);
2794     ypos += gy;
2795
2796     if (Length(mText) = 0) then
2797     begin
2798       uiContext.hline(gx, ypos, mWidth);
2799     end
2800     else
2801     begin
2802       uiContext.hline(gx, ypos, xpos-1);
2803       uiContext.hline(gx+xpos+uiContext.textWidth(mText), ypos, mWidth);
2804     end;
2805   end;
2806 end;
2807
2808
2809 // ////////////////////////////////////////////////////////////////////////// //
2810 procedure TUITextLabel.AfterConstruction ();
2811 begin
2812   inherited;
2813   mHAlign := -1;
2814   mVAlign := 0;
2815   mCanFocus := false;
2816   mCtl4Style := 'label';
2817   mLinkId := '';
2818 end;
2819
2820
2821 procedure TUITextLabel.cacheStyle (root: TUIStyle);
2822 begin
2823   inherited cacheStyle(root);
2824   // active
2825   mHotColor[ClrIdxActive] := root.get('hot-color', 'active', mCtl4Style).asRGBADef(TGxRGBA.Create(0, 128, 0));
2826   // disabled
2827   mHotColor[ClrIdxDisabled] := root.get('hot-color', 'disabled', mCtl4Style).asRGBADef(TGxRGBA.Create(0, 64, 0));
2828   // inactive
2829   mHotColor[ClrIdxInactive] := root.get('hot-color', 'inactive', mCtl4Style).asRGBADef(TGxRGBA.Create(0, 64, 0));
2830 end;
2831
2832
2833 procedure TUITextLabel.setText (const s: AnsiString);
2834 var
2835   f: Integer;
2836 begin
2837   mText := '';
2838   mHotChar := #0;
2839   mHotOfs := 0;
2840   f := 1;
2841   while (f <= Length(s)) do
2842   begin
2843     if (s[f] = '\\') then
2844     begin
2845       Inc(f);
2846       if (f <= Length(s)) then mText += s[f];
2847       Inc(f);
2848     end
2849     else if (s[f] = '~') then
2850     begin
2851       Inc(f);
2852       if (f <= Length(s)) then
2853       begin
2854         if (mHotChar = #0) then
2855         begin
2856           mHotChar := s[f];
2857           mHotOfs := Length(mText);
2858         end;
2859         mText += s[f];
2860       end;
2861       Inc(f);
2862     end
2863     else
2864     begin
2865       mText += s[f];
2866       Inc(f);
2867     end;
2868   end;
2869   // fix hotchar offset
2870   if (mHotChar <> #0) and (mHotOfs > 0) then
2871   begin
2872     mHotOfs := uiContext.textWidth(Copy(mText, 1, mHotOfs+1))-uiContext.charWidth(mText[mHotOfs+1]);
2873   end;
2874   // fix size
2875   mDefSize := TLaySize.Create(uiContext.textWidth(mText), uiContext.textHeight(mText));
2876 end;
2877
2878
2879 function TUITextLabel.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
2880 begin
2881   if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) or (strEquCI1251(prname, 'text')) then
2882   begin
2883     setText(par.expectIdOrStr(true));
2884     result := true;
2885     exit;
2886   end;
2887   if (strEquCI1251(prname, 'link')) then
2888   begin
2889     mLinkId := par.expectIdOrStr(true);
2890     result := true;
2891     exit;
2892   end;
2893   if (strEquCI1251(prname, 'textalign')) or (strEquCI1251(prname, 'text-align')) then
2894   begin
2895     parseTextAlign(par, mHAlign, mVAlign);
2896     result := true;
2897     exit;
2898   end;
2899   result := inherited parseProperty(prname, par);
2900 end;
2901
2902
2903 procedure TUITextLabel.drawControl (gx, gy: Integer);
2904 var
2905   xpos, ypos: Integer;
2906   cidx: Integer;
2907 begin
2908   cidx := getColorIndex;
2909   uiContext.color := mBackColor[cidx];
2910   uiContext.fillRect(gx, gy, mWidth, mHeight);
2911   if (Length(mText) > 0) then
2912   begin
2913          if (mHAlign < 0) then xpos := 0
2914     else if (mHAlign > 0) then xpos := mWidth-uiContext.textWidth(mText)
2915     else xpos := (mWidth-uiContext.textWidth(mText)) div 2;
2916
2917          if (mVAlign < 0) then ypos := 0
2918     else if (mVAlign > 0) then ypos := mHeight-uiContext.textHeight(mText)
2919     else ypos := (mHeight-uiContext.textHeight(mText)) div 2;
2920
2921     uiContext.color := mTextColor[cidx];
2922     uiContext.drawText(gx+xpos, gy+ypos, mText);
2923
2924     if (Length(mLinkId) > 0) and (mHotChar <> #0) and (mHotChar <> ' ') then
2925     begin
2926       uiContext.color := mHotColor[cidx];
2927       uiContext.drawChar(gx+xpos+mHotOfs, gy+ypos, mHotChar);
2928     end;
2929   end;
2930 end;
2931
2932
2933 procedure TUITextLabel.mouseEvent (var ev: THMouseEvent);
2934 var
2935   lx, ly: Integer;
2936 begin
2937   inherited mouseEvent(ev);
2938   if (not ev.eaten) and (not ev.cancelled) and (enabled) and toLocal(ev.x, ev.y, lx, ly) then
2939   begin
2940     ev.eat();
2941   end;
2942 end;
2943
2944
2945 procedure TUITextLabel.doAction ();
2946 var
2947   ctl: TUIControl;
2948 begin
2949   if (assigned(actionCB)) then
2950   begin
2951     actionCB(self);
2952   end
2953   else
2954   begin
2955     ctl := topLevel[mLinkId];
2956     if (ctl <> nil) then
2957     begin
2958       if (ctl.canFocus) then ctl.focused := true;
2959     end;
2960   end;
2961 end;
2962
2963
2964 procedure TUITextLabel.keyEventPost (var ev: THKeyEvent);
2965 begin
2966   if (not enabled) then exit;
2967   if (mHotChar = #0) then exit;
2968   if (ev.eaten) or (ev.cancelled) or (not ev.press) then exit;
2969   if (ev.kstate <> ev.ModAlt) then exit;
2970   if (not ev.isHot(mHotChar)) then exit;
2971   ev.eat();
2972   if (canFocus) then focused := true;
2973   doAction();
2974 end;
2975
2976
2977 // ////////////////////////////////////////////////////////////////////////// //
2978 procedure TUIButton.AfterConstruction ();
2979 begin
2980   inherited;
2981   mHAlign := 0;
2982   mVAlign := 0;
2983   mShadowSize := 0;
2984   mCanFocus := true;
2985   mDefSize := TLaySize.Create(uiContext.textWidth(mText)+uiContext.textWidth('[  ]'), uiContext.textHeight(mText));
2986   mCtl4Style := 'button';
2987   mSkipLayPrepare := false;
2988   mAddMarkers := false;
2989   mHideMarkers := false;
2990 end;
2991
2992
2993 procedure TUIButton.cacheStyle (root: TUIStyle);
2994 var
2995   sz: Integer = 0;
2996 begin
2997   inherited cacheStyle(root);
2998   // shadow size
2999   sz := nmax(0, root.get('shadow-size', 'active', mCtl4Style).asInt(0));
3000   sz := nmax(sz, root.get('shadow-size', 'disabled', mCtl4Style).asInt(0));
3001   sz := nmax(sz, root.get('shadow-size', 'inactive', mCtl4Style).asInt(0));
3002   mShadowSize := sz;
3003   // markers mode
3004   mAddMarkers := root.get('add-markers', 'active', mCtl4Style).asBool(false);
3005   mAddMarkers := mAddMarkers or root.get('add-markers', 'disabled', mCtl4Style).asBool(false);
3006   mAddMarkers := mAddMarkers or root.get('add-markers', 'inactive', mCtl4Style).asBool(false);
3007   // hide markers?
3008   mHideMarkers := root.get('hide-markers', 'active', mCtl4Style).asBool(false);
3009   mHideMarkers := mHideMarkers or root.get('hide-markers', 'disabled', mCtl4Style).asBool(false);
3010   mHideMarkers := mHideMarkers or root.get('hide-markers', 'inactive', mCtl4Style).asBool(false);
3011 end;
3012
3013
3014 procedure TUIButton.setText (const s: AnsiString);
3015 begin
3016   inherited setText(s);
3017   if (mHideMarkers) then
3018   begin
3019     mDefSize := TLaySize.Create(uiContext.textWidth(mText)+10, uiContext.textHeight(mText));
3020   end
3021   else if (mAddMarkers) then
3022   begin
3023     mDefSize := TLaySize.Create(uiContext.textWidth(mText)+uiContext.textWidth('[<>]'), uiContext.textHeight(mText));
3024   end
3025   else
3026   begin
3027     mDefSize := TLaySize.Create(uiContext.textWidth(mText)+uiContext.textWidth('<>'), uiContext.textHeight(mText));
3028   end;
3029 end;
3030
3031
3032 procedure TUIButton.layPrepare ();
3033 var
3034   ods: TLaySize;
3035   ww: Integer;
3036 begin
3037   if (not mSkipLayPrepare) then
3038   begin
3039     ods := mDefSize;
3040     if (ods.w <> 0) or (ods.h <> 0) then
3041     begin
3042       mDefSize := TLaySize.Create(uiContext.textWidth(mText), uiContext.textHeight(mText));
3043       if (mHideMarkers) then
3044       begin
3045         ww := 10;
3046       end
3047       else if (mAddMarkers) then
3048       begin
3049              if (mDefault) then ww := uiContext.textWidth('[<  >]')
3050         else if (mCancel) then ww := uiContext.textWidth('[{  }]')
3051         else ww := uiContext.textWidth('[  ]');
3052       end
3053       else
3054       begin
3055         ww := nmax(0, uiContext.textWidth('<  >'));
3056         ww := nmax(ww, uiContext.textWidth('{  }'));
3057         ww := nmax(ww, uiContext.textWidth('[  ]'));
3058       end;
3059       mDefSize.w += ww+mShadowSize;
3060       mDefSize.h += mShadowSize;
3061     end;
3062   end
3063   else
3064   begin
3065     ods := TLaySize.Create(0, 0); // fpc is dumb!
3066   end;
3067   inherited layPrepare();
3068   if (not mSkipLayPrepare) then mDefSize := ods;
3069 end;
3070
3071
3072 procedure TUIButton.drawControl (gx, gy: Integer);
3073 var
3074   wdt, hgt: Integer;
3075   xpos, ypos, xofsl, xofsr{, sofs}: Integer;
3076   cidx: Integer;
3077   lch, rch: AnsiChar;
3078   lstr, rstr: AnsiString;
3079 begin
3080   cidx := getColorIndex;
3081
3082   wdt := mWidth-mShadowSize;
3083   hgt := mHeight-mShadowSize;
3084   if (mPushed) {or (cidx = ClrIdxActive)} then
3085   begin
3086     //sofs := mShadowSize;
3087     gx += mShadowSize;
3088     gy += mShadowSize;
3089   end
3090   else
3091   begin
3092     //sofs := 0;
3093     if (mShadowSize > 0) then
3094     begin
3095       uiContext.darkenRect(gx+mShadowSize, gy+hgt, wdt, mShadowSize, 96);
3096       uiContext.darkenRect(gx+wdt, gy+mShadowSize, mShadowSize, hgt-mShadowSize, 96);
3097     end;
3098   end;
3099
3100   uiContext.color := mBackColor[cidx];
3101   //setScissor(sofs, sofs, wdt, hgt);
3102   uiContext.fillRect(gx, gy, wdt, hgt);
3103
3104        if (mVAlign < 0) then ypos := 0
3105   else if (mVAlign > 0) then ypos := hgt-uiContext.textHeight(mText)
3106   else ypos := (hgt-uiContext.textHeight(mText)) div 2;
3107   ypos += gy;
3108
3109   uiContext.color := mTextColor[cidx];
3110
3111   if (mHideMarkers) then
3112   begin
3113     xofsl := 5;
3114     xofsr := 5;
3115   end
3116   else
3117   begin
3118     if (mAddMarkers) then
3119     begin
3120            if (mDefault) then begin lstr := '[< '; rstr := ' >]'; end
3121       else if (mCancel) then begin lstr := '[{ '; rstr := ' }]'; end
3122       else begin lstr := '[ '; rstr := ' ]'; end;
3123       xofsl := uiContext.textWidth(lstr);
3124       xofsr := uiContext.textWidth(rstr);
3125       uiContext.drawText(gx, ypos, lstr);
3126       uiContext.drawText(gx+wdt-uiContext.textWidth(rstr), ypos, rstr);
3127     end
3128     else
3129     begin
3130       xofsl := nmax(0, uiContext.textWidth('< '));
3131       xofsl := nmax(xofsl, uiContext.textWidth('{ '));
3132       xofsl := nmax(xofsl, uiContext.textWidth('[ '));
3133       xofsr := nmax(0, uiContext.textWidth(' >'));
3134       xofsr := nmax(xofsr, uiContext.textWidth(' }'));
3135       xofsr := nmax(xofsr, uiContext.textWidth(' ]'));
3136            if (mDefault) then begin lch := '<'; rch := '>'; end
3137       else if (mCancel) then begin lch := '{'; rch := '}'; end
3138       else begin lch := '['; rch := ']'; end;
3139       uiContext.drawChar(gx, ypos, lch);
3140       uiContext.drawChar(gx+wdt-uiContext.charWidth(rch), ypos, rch);
3141     end;
3142   end;
3143
3144   if (Length(mText) > 0) then
3145   begin
3146     if (mHAlign < 0) then xpos := 0
3147     else begin xpos := wdt-xofsl-xofsr-uiContext.textWidth(mText); if (mHAlign = 0) then xpos := xpos div 2; end;
3148     xpos += xofsl;
3149
3150     //setScissor(xofsl+sofs, sofs, wdt-xofsl-xofsr, hgt);
3151     uiContext.drawText(gx+xpos, ypos, mText);
3152
3153     if (mHotChar <> #0) and (mHotChar <> ' ') then
3154     begin
3155       uiContext.color := mHotColor[cidx];
3156       uiContext.drawChar(gx+xpos+mHotOfs, ypos, mHotChar);
3157     end;
3158   end;
3159 end;
3160
3161
3162 procedure TUIButton.mouseEvent (var ev: THMouseEvent);
3163 var
3164   lx, ly: Integer;
3165 begin
3166   inherited mouseEvent(ev);
3167   if (uiGrabCtl = self) then
3168   begin
3169     ev.eat();
3170     mPushed := toLocal(ev.x, ev.y, lx, ly);
3171     if (ev = '-lmb') and focused and mPushed then
3172     begin
3173       mPushed := false;
3174       doAction();
3175     end;
3176     exit;
3177   end;
3178   if (ev.eaten) or (ev.cancelled) or (not enabled) or not focused then exit;
3179   mPushed := true;
3180   ev.eat();
3181 end;
3182
3183
3184 procedure TUIButton.keyEvent (var ev: THKeyEvent);
3185 begin
3186   inherited keyEvent(ev);
3187   if (not ev.eaten) and (not ev.cancelled) and (enabled) then
3188   begin
3189     if (ev = 'Enter') or (ev = 'Space') then
3190     begin
3191       ev.eat();
3192       doAction();
3193       exit;
3194     end;
3195   end;
3196 end;
3197
3198
3199 // ////////////////////////////////////////////////////////////////////////// //
3200 procedure TUIButtonRound.AfterConstruction ();
3201 begin
3202   inherited;
3203   mHAlign := -1;
3204   mVAlign := 0;
3205   mCanFocus := true;
3206   mDefSize := TLaySize.Create(uiContext.textWidth(mText)+8*2, uiContext.textHeight(mText)+2);
3207   mCtl4Style := 'button-round';
3208   mSkipLayPrepare := true;
3209 end;
3210
3211
3212 procedure TUIButtonRound.setText (const s: AnsiString);
3213 begin
3214   inherited setText(s);
3215   mDefSize := TLaySize.Create(uiContext.textWidth(mText)+8*2, uiContext.textHeight(mText)+2);
3216 end;
3217
3218
3219 procedure TUIButtonRound.layPrepare ();
3220 var
3221   ods: TLaySize;
3222 begin
3223   ods := mDefSize;
3224   if (ods.w <> 0) or (ods.h <> 0) then
3225   begin
3226     mDefSize := TLaySize.Create(uiContext.textWidth(mText)+8*2, uiContext.textHeight(mText)+2);
3227   end;
3228   inherited layPrepare();
3229   mDefSize := ods;
3230 end;
3231
3232
3233 procedure TUIButtonRound.drawControl (gx, gy: Integer);
3234 var
3235   xpos, ypos: Integer;
3236   cidx: Integer;
3237 begin
3238   cidx := getColorIndex;
3239
3240   uiContext.color := mBackColor[cidx];
3241   uiContext.fillRect(gx+1, gy, mWidth-2, mHeight);
3242   uiContext.fillRect(gx, gy+1, 1, mHeight-2);
3243   uiContext.fillRect(gx+mWidth-1, gy+1, 1, mHeight-2);
3244
3245   if (Length(mText) > 0) then
3246   begin
3247          if (mHAlign < 0) then xpos := 0
3248     else if (mHAlign > 0) then xpos := mWidth-uiContext.textWidth(mText)
3249     else xpos := (mWidth-uiContext.textWidth(mText)) div 2;
3250
3251          if (mVAlign < 0) then ypos := 0
3252     else if (mVAlign > 0) then ypos := mHeight-uiContext.textHeight(mText)
3253     else ypos := (mHeight-uiContext.textHeight(mText)) div 2;
3254
3255     setScissor(8, 0, mWidth-16, mHeight);
3256     uiContext.color := mTextColor[cidx];
3257     uiContext.drawText(gx+xpos+8, gy+ypos, mText);
3258
3259     if (mHotChar <> #0) and (mHotChar <> ' ') then
3260     begin
3261       uiContext.color := mHotColor[cidx];
3262       uiContext.drawChar(gx+xpos+8+mHotOfs, gy+ypos, mHotChar);
3263     end;
3264   end;
3265 end;
3266
3267
3268 // ////////////////////////////////////////////////////////////////////////// //
3269 procedure TUISwitchBox.AfterConstruction ();
3270 begin
3271   inherited;
3272   mHAlign := -1;
3273   mVAlign := 0;
3274   mCanFocus := true;
3275   mIcon := TGxContext.TMarkIcon.Checkbox;
3276   mDefSize := TLaySize.Create(uiContext.textWidth(mText)+3+uiContext.iconMarkWidth(mIcon), nmax(uiContext.iconMarkHeight(mIcon), uiContext.textHeight(mText)));
3277   mCtl4Style := 'switchbox';
3278   mChecked := false;
3279   mBoolVar := @mChecked;
3280 end;
3281
3282
3283 procedure TUISwitchBox.cacheStyle (root: TUIStyle);
3284 begin
3285   inherited cacheStyle(root);
3286   // active
3287   mSwitchColor[ClrIdxActive] := root.get('switch-color', 'active', mCtl4Style).asRGBADef(TGxRGBA.Create(255, 255, 255));
3288   // disabled
3289   mSwitchColor[ClrIdxDisabled] := root.get('switch-color', 'disabled', mCtl4Style).asRGBADef(TGxRGBA.Create(255, 255, 255));
3290   // inactive
3291   mSwitchColor[ClrIdxInactive] := root.get('switch-color', 'inactive', mCtl4Style).asRGBADef(TGxRGBA.Create(255, 255, 255));
3292 end;
3293
3294
3295 procedure TUISwitchBox.setText (const s: AnsiString);
3296 begin
3297   inherited setText(s);
3298   mDefSize := TLaySize.Create(uiContext.textWidth(mText)+3+uiContext.iconMarkWidth(mIcon), nmax(uiContext.iconMarkHeight(mIcon), uiContext.textHeight(mText)));
3299 end;
3300
3301
3302 function TUISwitchBox.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
3303 begin
3304   if (strEquCI1251(prname, 'checked')) then
3305   begin
3306     result := true;
3307     setChecked(true);
3308     exit;
3309   end;
3310   result := inherited parseProperty(prname, par);
3311 end;
3312
3313
3314 function TUISwitchBox.getChecked (): Boolean;
3315 begin
3316   if (mBoolVar <> nil) then result := mBoolVar^ else result := false;
3317 end;
3318
3319
3320 procedure TUISwitchBox.setVar (pvar: PBoolean);
3321 begin
3322   if (pvar = nil) then pvar := @mChecked;
3323   if (pvar <> mBoolVar) then
3324   begin
3325     mBoolVar := pvar;
3326     setChecked(mBoolVar^);
3327   end;
3328 end;
3329
3330
3331 procedure TUISwitchBox.drawControl (gx, gy: Integer);
3332 var
3333   xpos, ypos, iwdt, dy: Integer;
3334   cidx: Integer;
3335 begin
3336   cidx := getColorIndex;
3337
3338   iwdt := uiContext.iconMarkWidth(mIcon);
3339        if (mHAlign < 0) then xpos := 0
3340   else if (mHAlign > 0) then xpos := mWidth-(uiContext.textWidth(mText)+3+iwdt)
3341   else xpos := (mWidth-(uiContext.textWidth(mText)+3+iwdt)) div 2;
3342
3343        if (mVAlign < 0) then ypos := 0
3344   else if (mVAlign > 0) then ypos := mHeight-uiContext.textHeight(mText)
3345   else ypos := (mHeight-uiContext.textHeight(mText)) div 2;
3346
3347   uiContext.color := mBackColor[cidx];
3348   uiContext.fillRect(gx, gy, mWidth, mHeight);
3349
3350   uiContext.color := mSwitchColor[cidx];
3351   if (uiContext.iconMarkHeight(mIcon) < uiContext.textHeight(mText)) then
3352   begin
3353     case uiContext.textHeight(mText) of
3354       14: dy := 2;
3355       16: dy := 3;
3356       else dy := 1;
3357     end;
3358     uiContext.drawIconMark(mIcon, gx, gy+ypos+uiContext.textHeight(mText)-uiContext.iconMarkHeight(mIcon)-dy, checked);
3359   end
3360   else
3361   begin
3362     uiContext.drawIconMark(mIcon, gx, gy, checked);
3363   end;
3364
3365   uiContext.color := mTextColor[cidx];
3366   uiContext.drawText(gx+xpos+3+iwdt, gy+ypos, mText);
3367
3368   if (mHotChar <> #0) and (mHotChar <> ' ') then
3369   begin
3370     uiContext.color := mHotColor[cidx];
3371     uiContext.drawChar(gx+xpos+3+iwdt+mHotOfs, gy+ypos, mHotChar);
3372   end;
3373 end;
3374
3375
3376 procedure TUISwitchBox.mouseEvent (var ev: THMouseEvent);
3377 var
3378   lx, ly: Integer;
3379 begin
3380   inherited mouseEvent(ev);
3381   if (uiGrabCtl = self) then
3382   begin
3383     ev.eat();
3384     if (ev = '-lmb') and focused and toLocal(ev.x, ev.y, lx, ly) then
3385     begin
3386       doAction();
3387     end;
3388     exit;
3389   end;
3390   if (ev.eaten) or (ev.cancelled) or (not enabled) or not focused then exit;
3391   ev.eat();
3392 end;
3393
3394
3395 procedure TUISwitchBox.keyEvent (var ev: THKeyEvent);
3396 begin
3397   inherited keyEvent(ev);
3398   if (not ev.eaten) and (not ev.cancelled) and (enabled) then
3399   begin
3400     if (ev = 'Space') then
3401     begin
3402       ev.eat();
3403       doAction();
3404       exit;
3405     end;
3406   end;
3407 end;
3408
3409
3410 // ////////////////////////////////////////////////////////////////////////// //
3411 procedure TUICheckBox.AfterConstruction ();
3412 begin
3413   inherited;
3414   mChecked := false;
3415   mBoolVar := @mChecked;
3416   mIcon := TGxContext.TMarkIcon.Checkbox;
3417   setText('');
3418 end;
3419
3420
3421 procedure TUICheckBox.setChecked (v: Boolean);
3422 begin
3423   mBoolVar^ := v;
3424 end;
3425
3426
3427 procedure TUICheckBox.doAction ();
3428 begin
3429   if (assigned(actionCB)) then
3430   begin
3431     actionCB(self);
3432   end
3433   else
3434   begin
3435     setChecked(not getChecked);
3436   end;
3437 end;
3438
3439
3440 // ////////////////////////////////////////////////////////////////////////// //
3441 procedure TUIRadioBox.AfterConstruction ();
3442 begin
3443   inherited;
3444   mChecked := false;
3445   mBoolVar := @mChecked;
3446   mRadioGroup := '';
3447   mIcon := TGxContext.TMarkIcon.Radiobox;
3448   setText('');
3449 end;
3450
3451
3452 function TUIRadioBox.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
3453 begin
3454   if (strEquCI1251(prname, 'group')) then
3455   begin
3456     mRadioGroup := par.expectIdOrStr(true);
3457     if (getChecked) then setChecked(true);
3458     result := true;
3459     exit;
3460   end;
3461   if (strEquCI1251(prname, 'checked')) then
3462   begin
3463     result := true;
3464     setChecked(true);
3465     exit;
3466   end;
3467   result := inherited parseProperty(prname, par);
3468 end;
3469
3470
3471 procedure TUIRadioBox.setChecked (v: Boolean);
3472
3473   function resetGroup (ctl: TUIControl): Boolean;
3474   begin
3475     result := false;
3476     if (ctl <> self) and (ctl is TUIRadioBox) and (TUIRadioBox(ctl).mRadioGroup = mRadioGroup) then
3477     begin
3478       TUIRadioBox(ctl).mBoolVar^ := false;
3479     end;
3480   end;
3481
3482 begin
3483   mBoolVar^ := v;
3484   if v then topLevel.forEachControl(resetGroup);
3485 end;
3486
3487
3488 procedure TUIRadioBox.doAction ();
3489 begin
3490   if (assigned(actionCB)) then
3491   begin
3492     actionCB(self);
3493   end
3494   else
3495   begin
3496     setChecked(true);
3497   end;
3498 end;
3499
3500
3501 // ////////////////////////////////////////////////////////////////////////// //
3502 initialization
3503   registerCtlClass(TUIHBox, 'hbox');
3504   registerCtlClass(TUIVBox, 'vbox');
3505   registerCtlClass(TUISpan, 'span');
3506   registerCtlClass(TUILine, 'line');
3507   registerCtlClass(TUITextLabel, 'label');
3508   registerCtlClass(TUIStaticText, 'static');
3509   registerCtlClass(TUIButtonRound, 'round-button');
3510   registerCtlClass(TUIButton, 'button');
3511   registerCtlClass(TUICheckBox, 'checkbox');
3512   registerCtlClass(TUIRadioBox, 'radiobox');
3513 end.