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