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