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 = nil;
 579
 580
 581 implementation
 582
 583 uses
 584   fui_flexlay,
 585   utils;
 586
 587
 588 var
 589   uiInsideDispatcher: Boolean = false;
 590   uiTopList: array of TUIControl = nil;
 591   uiGrabCtl: TUIControl = nil;
 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') or
1294     par.eatIdOrStrCI('tan');
1295   if not result then
1296   begin
1297     if (not par.eatIdOrStrCI('false')) and (not par.eatIdOrStrCI('no')) and (not par.eatIdOrStrCI('ona')) then
1298     begin
1299       par.error('boolean value expected');
1300     end;
1301   end;
1302 end;
1303
1304 function TUIControl.parseAnyAlign (par: TTextParser): Integer;
1305 begin
1306        if (par.eatIdOrStrCI('left')) or (par.eatIdOrStrCI('top')) then result := -1
1307   else if (par.eatIdOrStrCI('right')) or (par.eatIdOrStrCI('bottom')) then result := 1
1308   else if (par.eatIdOrStrCI('center')) then result := 0
1309   else par.error('invalid align value');
1310 end;
1311
1312 function TUIControl.parseHAlign (par: TTextParser): Integer;
1313 begin
1314        if (par.eatIdOrStrCI('left')) then result := -1
1315   else if (par.eatIdOrStrCI('right')) then result := 1
1316   else if (par.eatIdOrStrCI('center')) then result := 0
1317   else par.error('invalid horizontal align value');
1318 end;
1319
1320 function TUIControl.parseVAlign (par: TTextParser): Integer;
1321 begin
1322        if (par.eatIdOrStrCI('top')) then result := -1
1323   else if (par.eatIdOrStrCI('bottom')) then result := 1
1324   else if (par.eatIdOrStrCI('center')) then result := 0
1325   else par.error('invalid vertical align value');
1326 end;
1327
1328 procedure TUIControl.parseTextAlign (par: TTextParser; var h, v: Integer);
1329 var
1330   wasH: Boolean = false;
1331   wasV: Boolean = false;
1332 begin
1333   while true do
1334   begin
1335     if (par.eatIdOrStrCI('left')) then
1336     begin
1337       if wasH then par.error('too many align directives');
1338       wasH := true;
1339       h := -1;
1340       continue;
1341     end;
1342     if (par.eatIdOrStrCI('right')) then
1343     begin
1344       if wasH then par.error('too many align directives');
1345       wasH := true;
1346       h := 1;
1347       continue;
1348     end;
1349     if (par.eatIdOrStrCI('hcenter')) then
1350     begin
1351       if wasH then par.error('too many align directives');
1352       wasH := true;
1353       h := 0;
1354       continue;
1355     end;
1356     if (par.eatIdOrStrCI('top')) then
1357     begin
1358       if wasV then par.error('too many align directives');
1359       wasV := true;
1360       v := -1;
1361       continue;
1362     end;
1363     if (par.eatIdOrStrCI('bottom')) then
1364     begin
1365       if wasV then par.error('too many align directives');
1366       wasV := true;
1367       v := 1;
1368       continue;
1369     end;
1370     if (par.eatIdOrStrCI('vcenter')) then
1371     begin
1372       if wasV then par.error('too many align directives');
1373       wasV := true;
1374       v := 0;
1375       continue;
1376     end;
1377     if (par.eatIdOrStrCI('center')) then
1378     begin
1379       if wasV or wasH then par.error('too many align directives');
1380       wasV := true;
1381       wasH := true;
1382       h := 0;
1383       v := 0;
1384       continue;
1385     end;
1386     break;
1387   end;
1388   if not wasV and not wasH then par.error('invalid align value');
1389 end;
1390
1391 function TUIControl.parseOrientation (const prname: AnsiString; par: TTextParser): Boolean;
1392 begin
1393   if (strEquCI1251(prname, 'orientation')) or (strEquCI1251(prname, 'orient')) then
1394   begin
1395          if (par.eatIdOrStrCI('horizontal')) or (par.eatIdOrStrCI('horiz')) then mHoriz := true
1396     else if (par.eatIdOrStrCI('vertical')) or (par.eatIdOrStrCI('vert')) then mHoriz := false
1397     else par.error('`horizontal` or `vertical` expected');
1398     result := true;
1399   end
1400   else
1401   begin
1402     result := false;
1403   end;
1404 end;
1405
1406 // par should be on '{'; final '}' is eaten
1407 procedure TUIControl.parseProperties (par: TTextParser);
1408 var
1409   pn: AnsiString;
1410 begin
1411   if (not par.eatDelim('{')) then exit;
1412   while (not par.eatDelim('}')) do
1413   begin
1414     if (not par.isIdOrStr) then par.error('property name expected');
1415     pn := par.tokStr;
1416     par.skipToken();
1417     par.eatDelim(':'); // optional
1418     if not parseProperty(pn, par) then par.errorfmt('invalid property name ''%s''', [pn]);
1419     par.eatDelim(','); // optional
1420   end;
1421 end;
1422
1423 // par should be on '{'
1424 procedure TUIControl.parseChildren (par: TTextParser);
1425 var
1426   cc: TUIControlClass;
1427   ctl: TUIControl;
1428 begin
1429   par.expectDelim('{');
1430   while (not par.eatDelim('}')) do
1431   begin
1432     if (not par.isIdOrStr) then par.error('control name expected');
1433     cc := findCtlClass(par.tokStr);
1434     if (cc = nil) then par.errorfmt('unknown control name: ''%s''', [par.tokStr]);
1435     //writeln('children for <', par.tokStr, '>: <', cc.className, '>');
1436     par.skipToken();
1437     par.eatDelim(':'); // optional
1438     ctl := cc.Create();
1439     //writeln('  mHoriz=', ctl.mHoriz);
1440     try
1441       ctl.parseProperties(par);
1442     except
1443       FreeAndNil(ctl);
1444       raise;
1445     end;
1446     //writeln(': ', ctl.mDefSize.toString);
1447     appendChild(ctl);
1448     par.eatDelim(','); // optional
1449   end;
1450 end;
1451
1452
1453 function TUIControl.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
1454 begin
1455   result := true;
1456   if (strEquCI1251(prname, 'id')) then begin mId := par.expectIdOrStr(true); exit; end; // allow empty strings
1457   if (strEquCI1251(prname, 'style')) then begin mStyleId := par.expectIdOrStr(); exit; end; // no empty strings
1458   if (strEquCI1251(prname, 'flex')) then begin flex := par.expectInt(); exit; end;
1459   // sizes
1460   if (strEquCI1251(prname, 'defsize')) or (strEquCI1251(prname, 'size')) then begin mDefSize := parseSize(par); exit; end;
1461   if (strEquCI1251(prname, 'maxsize')) then begin mMaxSize := parseSize(par); exit; end;
1462   if (strEquCI1251(prname, 'defwidth')) or (strEquCI1251(prname, 'width')) then begin mDefSize.w := par.expectInt(); exit; end;
1463   if (strEquCI1251(prname, 'defheight')) or (strEquCI1251(prname, 'height')) then begin mDefSize.h := par.expectInt(); exit; end;
1464   if (strEquCI1251(prname, 'maxwidth')) then begin mMaxSize.w := par.expectInt(); exit; end;
1465   if (strEquCI1251(prname, 'maxheight')) then begin mMaxSize.h := par.expectInt(); exit; end;
1466   // padding
1467   if (strEquCI1251(prname, 'padding')) then begin mPadding := parsePadding(par); exit; end;
1468   if (strEquCI1251(prname, 'nopad')) then begin mNoPad := true; exit; end;
1469   // flags
1470   if (strEquCI1251(prname, 'expand')) then begin mExpand := parseBool(par); exit; end;
1471   // align
1472   if (strEquCI1251(prname, 'align')) then begin mAlign := parseAnyAlign(par); exit; end;
1473   if (strEquCI1251(prname, 'hgroup')) then begin mHGroup := par.expectIdOrStr(true); exit; end; // allow empty strings
1474   if (strEquCI1251(prname, 'vgroup')) then begin mVGroup := par.expectIdOrStr(true); exit; end; // allow empty strings
1475   // other
1476   if (strEquCI1251(prname, 'canfocus')) then begin mCanFocus := true; exit; end;
1477   if (strEquCI1251(prname, 'nofocus')) then begin mCanFocus := false; exit; end;
1478   if (strEquCI1251(prname, 'disabled')) then begin mEnabled := false; exit; end;
1479   if (strEquCI1251(prname, 'enabled')) then begin mEnabled := true; exit; end;
1480   if (strEquCI1251(prname, 'escclose')) then begin mEscClose := not parseBool(par); exit; end;
1481   if (strEquCI1251(prname, 'default')) then begin mDefault := true; exit; end;
1482   if (strEquCI1251(prname, 'cancel')) then begin mCancel := true; exit; end;
1483   result := false;
1484 end;
1485
1486
1487 // ////////////////////////////////////////////////////////////////////////// //
1488 procedure TUIControl.activated ();
1489 begin
1490   makeVisibleInParent();
1491 end;
1492
1493
1494 procedure TUIControl.blurred ();
1495 begin
1496   if (uiGrabCtl = self) then uiGrabCtl := nil;
1497 end;
1498
1499
1500 procedure TUIControl.calcFullClientSize ();
1501 var
1502   ctl: TUIControl;
1503 begin
1504   mFullSize := TLaySize.Create(0, 0);
1505   if (mWidth < 1) or (mHeight < 1) then exit;
1506   for ctl in mChildren do
1507   begin
1508     ctl.calcFullClientSize();
1509     mFullSize.w := nmax(mFullSize.w, ctl.mX-mFrameWidth+ctl.mFullSize.w);
1510     mFullSize.h := nmax(mFullSize.h, ctl.mY-mFrameHeight+ctl.mFullSize.h);
1511   end;
1512   mFullSize.w := nmax(mFullSize.w, mWidth-mFrameWidth*2);
1513   mFullSize.h := nmax(mFullSize.h, mHeight-mFrameHeight*2);
1514 end;
1515
1516
1517 function TUIControl.topLevel (): TUIControl; inline;
1518 begin
1519   result := self;
1520   while (result.mParent <> nil) do result := result.mParent;
1521 end;
1522
1523
1524 function TUIControl.getEnabled (): Boolean;
1525 var
1526   ctl: TUIControl;
1527 begin
1528   result := false;
1529   if (not mEnabled) then exit;
1530   ctl := mParent;
1531   while (ctl <> nil) do
1532   begin
1533     if (not ctl.mEnabled) then exit;
1534     ctl := ctl.mParent;
1535   end;
1536   result := true;
1537 end;
1538
1539
1540 procedure TUIControl.setEnabled (v: Boolean); inline;
1541 begin
1542   if (mEnabled = v) then exit;
1543   mEnabled := v;
1544   if (not v) and focused then setFocused(false);
1545 end;
1546
1547
1548 function TUIControl.getFocused (): Boolean; inline;
1549 begin
1550   if (mParent = nil) then
1551   begin
1552     result := (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)] = self);
1553   end
1554   else
1555   begin
1556     result := (topLevel.mFocused = self);
1557     if (result) then result := (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)] = topLevel);
1558   end;
1559 end;
1560
1561
1562 function TUIControl.getActive (): Boolean; inline;
1563 var
1564   ctl: TUIControl;
1565 begin
1566   if (mParent = nil) then
1567   begin
1568     result := (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)] = self);
1569   end
1570   else
1571   begin
1572     ctl := topLevel.mFocused;
1573     while (ctl <> nil) and (ctl <> self) do ctl := ctl.mParent;
1574     result := (ctl = self);
1575     if (result) then result := (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)] = topLevel);
1576   end;
1577 end;
1578
1579
1580 procedure TUIControl.setFocused (v: Boolean); inline;
1581 var
1582   tl: TUIControl;
1583 begin
1584   tl := topLevel;
1585   if (not v) then
1586   begin
1587     if (tl.mFocused = self) then
1588     begin
1589       blurred(); // this will reset grab, but still...
1590       if (uiGrabCtl = self) then uiGrabCtl := nil;
1591       tl.mFocused := tl.findNextFocus(self, true);
1592       if (tl.mFocused = self) then tl.mFocused := nil;
1593       if (tl.mFocused <> nil) then tl.mFocused.activated();
1594     end;
1595     exit;
1596   end;
1597   if (not canFocus) then exit;
1598   if (tl.mFocused <> self) then
1599   begin
1600     if (tl.mFocused <> nil) then tl.mFocused.blurred();
1601     tl.mFocused := self;
1602     if (uiGrabCtl <> self) then uiGrabCtl := nil;
1603     activated();
1604   end;
1605 end;
1606
1607
1608 function TUIControl.getCanFocus (): Boolean; inline;
1609 begin
1610   result := (getEnabled) and (mCanFocus) and (mWidth > 0) and (mHeight > 0);
1611 end;
1612
1613
1614 function TUIControl.isMyChild (ctl: TUIControl): Boolean;
1615 begin
1616   result := true;
1617   while (ctl <> nil) do
1618   begin
1619     if (ctl.mParent = self) then exit;
1620     ctl := ctl.mParent;
1621   end;
1622   result := false;
1623 end;
1624
1625
1626 // returns `true` if global coords are inside this control
1627 function TUIControl.toLocal (var x, y: Integer): Boolean;
1628 begin
1629   if (mParent = nil) then
1630   begin
1631     Dec(x, mX);
1632     Dec(y, mY);
1633     result := true; // hack
1634   end
1635   else
1636   begin
1637     result := mParent.toLocal(x, y);
1638     Inc(x, mParent.mScrollX);
1639     Inc(y, mParent.mScrollY);
1640     Dec(x, mX);
1641     Dec(y, mY);
1642     if result then result := (x >= 0) and (y >= 0) and (x < mParent.mWidth) and (y < mParent.mHeight);
1643   end;
1644   if result then result := (x >= 0) and (y >= 0) and (x < mWidth) and (y < mHeight);
1645 end;
1646
1647 function TUIControl.toLocal (gx, gy: Integer; out x, y: Integer): Boolean; inline;
1648 begin
1649   x := gx;
1650   y := gy;
1651   result := toLocal(x, y);
1652 end;
1653
1654
1655 procedure TUIControl.toGlobal (var x, y: Integer);
1656 begin
1657   Inc(x, mX);
1658   Inc(y, mY);
1659   if (mParent <> nil) then
1660   begin
1661     Dec(x, mParent.mScrollX);
1662     Dec(y, mParent.mScrollY);
1663     mParent.toGlobal(x, y);
1664   end;
1665 end;
1666
1667 procedure TUIControl.toGlobal (lx, ly: Integer; out x, y: Integer); inline;
1668 begin
1669   x := lx;
1670   y := ly;
1671   toGlobal(x, y);
1672 end;
1673
1674 procedure TUIControl.getDrawRect (out gx, gy, wdt, hgt: Integer);
1675 var
1676   cgx, cgy: Integer;
1677 begin
1678   if (mParent = nil) then
1679   begin
1680     gx := mX;
1681     gy := mY;
1682     wdt := mWidth;
1683     hgt := mHeight;
1684   end
1685   else
1686   begin
1687     toGlobal(0, 0, cgx, cgy);
1688     mParent.getDrawRect(gx, gy, wdt, hgt);
1689     if (wdt > 0) and (hgt > 0) then
1690     begin
1691       if (not intersectRect(gx, gy, wdt, hgt, cgx, cgy, mWidth, mHeight)) then
1692       begin
1693         wdt := 0;
1694         hgt := 0;
1695       end;
1696     end;
1697   end;
1698 end;
1699
1700
1701 // x and y are global coords
1702 function TUIControl.controlAtXY (x, y: Integer; allowDisabled: Boolean=false): TUIControl;
1703 var
1704   lx, ly: Integer;
1705   f: Integer;
1706 begin
1707   result := nil;
1708   if (not allowDisabled) and (not enabled) then exit;
1709   if (mWidth < 1) or (mHeight < 1) then exit;
1710   if not toLocal(x, y, lx, ly) then exit;
1711   for f := High(mChildren) downto 0 do
1712   begin
1713     result := mChildren[f].controlAtXY(x, y, allowDisabled);
1714     if (result <> nil) then exit;
1715   end;
1716   result := self;
1717 end;
1718
1719
1720 function TUIControl.parentScrollX (): Integer; inline; begin if (mParent <> nil) then result := mParent.mScrollX else result := 0; end;
1721 function TUIControl.parentScrollY (): Integer; inline; begin if (mParent <> nil) then result := mParent.mScrollY else result := 0; end;
1722
1723
1724 procedure TUIControl.makeVisibleInParent ();
1725 var
1726   sy, ey, cy: Integer;
1727   p: TUIControl;
1728 begin
1729   if (mWidth < 1) or (mHeight < 1) then exit;
1730   p := mParent;
1731   if (p = nil) then exit;
1732   if (p.mFullSize.w < 1) or (p.mFullSize.h < 1) then
1733   begin
1734     p.mScrollX := 0;
1735     p.mScrollY := 0;
1736     exit;
1737   end;
1738   p.makeVisibleInParent();
1739   cy := mY-p.mFrameHeight;
1740   sy := p.mScrollY;
1741   ey := sy+(p.mHeight-p.mFrameHeight*2);
1742   if (cy < sy) then
1743   begin
1744     p.mScrollY := nmax(0, cy);
1745   end
1746   else if (cy+mHeight > ey) then
1747   begin
1748     p.mScrollY := nmax(0, cy+mHeight-(p.mHeight-p.mFrameHeight*2));
1749   end;
1750 end;
1751
1752
1753 // ////////////////////////////////////////////////////////////////////////// //
1754 function TUIControl.prevSibling (): TUIControl;
1755 var
1756   f: Integer;
1757 begin
1758   if (mParent <> nil) then
1759   begin
1760     for f := 1 to High(mParent.mChildren) do
1761     begin
1762       if (mParent.mChildren[f] = self) then begin result := mParent.mChildren[f-1]; exit; end;
1763     end;
1764   end;
1765   result := nil;
1766 end;
1767
1768 function TUIControl.nextSibling (): TUIControl;
1769 var
1770   f: Integer;
1771 begin
1772   if (mParent <> nil) then
1773   begin
1774     for f := 0 to High(mParent.mChildren)-1 do
1775     begin
1776       if (mParent.mChildren[f] = self) then begin result := mParent.mChildren[f+1]; exit; end;
1777     end;
1778   end;
1779   result := nil;
1780 end;
1781
1782 function TUIControl.firstChild (): TUIControl; inline;
1783 begin
1784   if (Length(mChildren) <> 0) then result := mChildren[0] else result := nil;
1785 end;
1786
1787 function TUIControl.lastChild (): TUIControl; inline;
1788 begin
1789   if (Length(mChildren) <> 0) then result := mChildren[High(mChildren)] else result := nil;
1790 end;
1791
1792
1793 function TUIControl.findFirstFocus (): TUIControl;
1794 var
1795   f: Integer;
1796 begin
1797   result := nil;
1798   if enabled then
1799   begin
1800     for f := 0 to High(mChildren) do
1801     begin
1802       result := mChildren[f].findFirstFocus();
1803       if (result <> nil) then exit;
1804     end;
1805     if (canFocus) then result := self;
1806   end;
1807 end;
1808
1809
1810 function TUIControl.findLastFocus (): TUIControl;
1811 var
1812   f: Integer;
1813 begin
1814   result := nil;
1815   if enabled then
1816   begin
1817     for f := High(mChildren) downto 0 do
1818     begin
1819       result := mChildren[f].findLastFocus();
1820       if (result <> nil) then exit;
1821     end;
1822     if (canFocus) then result := self;
1823   end;
1824 end;
1825
1826
1827 function TUIControl.findNextFocus (cur: TUIControl; wrap: Boolean): TUIControl;
1828 var
1829   curHit: Boolean = false;
1830
1831   function checkFocus (ctl: TUIControl): Boolean;
1832   begin
1833     if curHit then
1834     begin
1835       result := (ctl.canFocus);
1836     end
1837     else
1838     begin
1839       curHit := (ctl = cur);
1840       result := false; // don't stop
1841     end;
1842   end;
1843
1844 begin
1845   result := nil;
1846   if enabled then
1847   begin
1848     if not isMyChild(cur) then
1849     begin
1850       result := findFirstFocus();
1851     end
1852     else
1853     begin
1854       result := forEachControl(checkFocus);
1855       if (result = nil) and (wrap) then result := findFirstFocus();
1856     end;
1857   end;
1858 end;
1859
1860
1861 function TUIControl.findPrevFocus (cur: TUIControl; wrap: Boolean): TUIControl;
1862 var
1863   lastCtl: TUIControl = nil;
1864
1865   function checkFocus (ctl: TUIControl): Boolean;
1866   begin
1867     if (ctl = cur) then
1868     begin
1869       result := true;
1870     end
1871     else
1872     begin
1873       result := false;
1874       if (ctl.canFocus) then lastCtl := ctl;
1875     end;
1876   end;
1877
1878 begin
1879   result := nil;
1880   if enabled then
1881   begin
1882     if not isMyChild(cur) then
1883     begin
1884       result := findLastFocus();
1885     end
1886     else
1887     begin
1888       forEachControl(checkFocus);
1889       if (lastCtl = nil) and (wrap) then lastCtl := findLastFocus();
1890       result := lastCtl;
1891       //if (lastCtl <> nil) then writeln('ctl<', lastCtl.className, '>: {', lastCtl.id, '}');
1892     end;
1893   end;
1894 end;
1895
1896
1897 function TUIControl.findDefaulControl (): TUIControl;
1898 var
1899   ctl: TUIControl;
1900 begin
1901   if (enabled) then
1902   begin
1903     if (mDefault) then begin result := self; exit; end;
1904     for ctl in mChildren do
1905     begin
1906       result := ctl.findDefaulControl();
1907       if (result <> nil) then exit;
1908     end;
1909   end;
1910   result := nil;
1911 end;
1912
1913 function TUIControl.findCancelControl (): TUIControl;
1914 var
1915   ctl: TUIControl;
1916 begin
1917   if (enabled) then
1918   begin
1919     if (mCancel) then begin result := self; exit; end;
1920     for ctl in mChildren do
1921     begin
1922       result := ctl.findCancelControl();
1923       if (result <> nil) then exit;
1924     end;
1925   end;
1926   result := nil;
1927 end;
1928
1929
1930 function TUIControl.findControlById (const aid: AnsiString): TUIControl;
1931 var
1932   ctl: TUIControl;
1933 begin
1934   if (strEquCI1251(aid, mId)) then begin result := self; exit; end;
1935   for ctl in mChildren do
1936   begin
1937     result := ctl.findControlById(aid);
1938     if (result <> nil) then exit;
1939   end;
1940   result := nil;
1941 end;
1942
1943
1944 procedure TUIControl.appendChild (ctl: TUIControl);
1945 begin
1946   if (ctl = nil) then exit;
1947   if (ctl.mParent <> nil) then exit;
1948   SetLength(mChildren, Length(mChildren)+1);
1949   mChildren[High(mChildren)] := ctl;
1950   ctl.mParent := self;
1951   Inc(ctl.mX, mFrameWidth);
1952   Inc(ctl.mY, mFrameHeight);
1953   if (ctl.mWidth > 0) and (ctl.mHeight > 0) and
1954      (ctl.mX+ctl.mWidth > mFrameWidth) and (ctl.mY+ctl.mHeight > mFrameHeight) then
1955   begin
1956     if (mWidth+mFrameWidth < ctl.mX+ctl.mWidth) then mWidth := ctl.mX+ctl.mWidth+mFrameWidth;
1957     if (mHeight+mFrameHeight < ctl.mY+ctl.mHeight) then mHeight := ctl.mY+ctl.mHeight+mFrameHeight;
1958   end;
1959 end;
1960
1961
1962 function TUIControl.setActionCBFor (const aid: AnsiString; cb: TActionCB): TActionCB;
1963 var
1964   ctl: TUIControl;
1965 begin
1966   ctl := self[aid];
1967   if (ctl <> nil) then
1968   begin
1969     result := ctl.actionCB;
1970     ctl.actionCB := cb;
1971   end
1972   else
1973   begin
1974     result := nil;
1975   end;
1976 end;
1977
1978
1979 function TUIControl.forEachChildren (cb: TCtlEnumCB): TUIControl;
1980 var
1981   ctl: TUIControl;
1982 begin
1983   result := nil;
1984   if (not assigned(cb)) then exit;
1985   for ctl in mChildren do
1986   begin
1987     if cb(ctl) then begin result := ctl; exit; end;
1988   end;
1989 end;
1990
1991
1992 function TUIControl.forEachControl (cb: TCtlEnumCB; includeSelf: Boolean=true): TUIControl;
1993
1994   function forChildren (p: TUIControl; incSelf: Boolean): TUIControl;
1995   var
1996     ctl: TUIControl;
1997   begin
1998     result := nil;
1999     if (p = nil) then exit;
2000     if (incSelf) and (cb(p)) then begin result := p; exit; end;
2001     for ctl in p.mChildren do
2002     begin
2003       result := forChildren(ctl, true);
2004       if (result <> nil) then break;
2005     end;
2006   end;
2007
2008 begin
2009   result := nil;
2010   if (not assigned(cb)) then exit;
2011   result := forChildren(self, includeSelf);
2012 end;
2013
2014
2015 procedure TUIControl.close (); // this closes *top-level* control
2016 var
2017   ctl: TUIControl;
2018 begin
2019   ctl := topLevel;
2020   uiRemoveWindow(ctl);
2021   if (ctl is TUITopWindow) and (TUITopWindow(ctl).mFreeOnClose) then scheduleKill(ctl); // just in case
2022 end;
2023
2024
2025 procedure TUIControl.doAction ();
2026 begin
2027   if assigned(actionCB) then actionCB(self);
2028 end;
2029
2030
2031 // ////////////////////////////////////////////////////////////////////////// //
2032 procedure TUIControl.setScissor (lx, ly, lw, lh: Integer);
2033 var
2034   gx, gy, wdt, hgt, cgx, cgy: Integer;
2035 begin
2036   if (not intersectRect(lx, ly, lw, lh, 0, 0, mWidth, mHeight)) then
2037   begin
2038     uiContext.clip := TGxRect.Create(0, 0, 0, 0);
2039     exit;
2040   end;
2041
2042   getDrawRect(gx, gy, wdt, hgt);
2043
2044   toGlobal(lx, ly, cgx, cgy);
2045   if (not intersectRect(gx, gy, wdt, hgt, cgx, cgy, lw, lh)) then
2046   begin
2047     uiContext.clip := TGxRect.Create(0, 0, 0, 0);
2048     exit;
2049   end;
2050
2051   uiContext.clip := savedClip;
2052   uiContext.combineClip(TGxRect.Create(gx, gy, wdt, hgt));
2053   //uiContext.clip := TGxRect.Create(gx, gy, wdt, hgt);
2054 end;
2055
2056 procedure TUIControl.resetScissorNC (); inline;
2057 begin
2058   setScissor(0, 0, mWidth, mHeight);
2059 end;
2060
2061 procedure TUIControl.resetScissor (); inline;
2062 begin
2063   if ((mFrameWidth <= 0) and (mFrameHeight <= 0)) then
2064   begin
2065     resetScissorNC();
2066   end
2067   else
2068   begin
2069     setScissor(mFrameWidth, mFrameHeight, mWidth-mFrameWidth*2, mHeight-mFrameHeight*2);
2070   end;
2071 end;
2072
2073
2074 // ////////////////////////////////////////////////////////////////////////// //
2075 procedure TUIControl.drawFrame (gx, gy, resx, thalign: Integer; const text: AnsiString; dbl: Boolean);
2076 var
2077   cidx, tx, tw: Integer;
2078 begin
2079   if (mFrameWidth < 1) or (mFrameHeight < 1) then exit;
2080   cidx := getColorIndex;
2081   uiContext.color := mFrameColor[cidx];
2082   case mFrameHeight of
2083     8:
2084       begin
2085         if dbl then
2086         begin
2087           uiContext.rect(gx+3, gy+3, mWidth-6, mHeight-6);
2088           uiContext.rect(gx+5, gy+5, mWidth-10, mHeight-10);
2089         end
2090         else
2091         begin
2092           uiContext.rect(gx+4, gy+4, mWidth-8, mHeight-8);
2093         end;
2094       end;
2095     14:
2096       begin
2097         if dbl then
2098         begin
2099           uiContext.rect(gx+3, gy+3+3, mWidth-6, mHeight-6-6);
2100           uiContext.rect(gx+5, gy+5+3, mWidth-10, mHeight-10-6);
2101         end
2102         else
2103         begin
2104           uiContext.rect(gx+4, gy+4+3, mWidth-8, mHeight-8-6);
2105         end;
2106       end;
2107     16:
2108       begin
2109         if dbl then
2110         begin
2111           uiContext.rect(gx+3, gy+3+4, mWidth-6, mHeight-6-8);
2112           uiContext.rect(gx+5, gy+5+4, mWidth-10, mHeight-10-8);
2113         end
2114         else
2115         begin
2116           uiContext.rect(gx+4, gy+4+4, mWidth-8, mHeight-8-8);
2117         end;
2118       end;
2119     else
2120       begin
2121         //TODO!
2122         if dbl then
2123         begin
2124         end
2125         else
2126         begin
2127         end;
2128       end;
2129   end;
2130
2131   // title
2132   if (Length(text) > 0) then
2133   begin
2134     if (resx < 0) then resx := 0;
2135     tw := uiContext.textWidth(text);
2136     setScissor(mFrameWidth+resx, 0, mWidth-mFrameWidth*2-resx, mFrameHeight);
2137          if (thalign < 0) then tx := gx+resx+mFrameWidth+2
2138     else if (thalign > 0) then tx := gx+mWidth-mFrameWidth-1-tw
2139     else tx := (gx+resx+mFrameWidth)+(mWidth-mFrameWidth*2-resx-tw) div 2;
2140     uiContext.color := mBackColor[cidx];
2141     uiContext.fillRect(tx-2, gy, tw+4, mFrameHeight);
2142     uiContext.color := mFrameTextColor[cidx];
2143     uiContext.drawText(tx, gy, text);
2144   end;
2145 end;
2146
2147
2148 procedure TUIControl.draw ();
2149 var
2150   f: Integer;
2151   gx, gy: Integer;
2152
2153 begin
2154   if (mWidth < 1) or (mHeight < 1) or (uiContext = nil) or (not uiContext.active) then exit;
2155   toGlobal(0, 0, gx, gy);
2156
2157   savedClip := uiContext.clip;
2158   try
2159     resetScissorNC();
2160     drawControl(gx, gy);
2161     resetScissor();
2162     for f := 0 to High(mChildren) do mChildren[f].draw();
2163     resetScissorNC();
2164     drawControlPost(gx, gy);
2165   finally
2166     uiContext.clip := savedClip;
2167   end;
2168 end;
2169
2170 procedure TUIControl.drawControl (gx, gy: Integer);
2171 begin
2172 end;
2173
2174 procedure TUIControl.drawControlPost (gx, gy: Integer);
2175 begin
2176   // shadow for top-level controls
2177   if (mParent = nil) and (mDrawShadow) and (mWidth > 0) and (mHeight > 0) then
2178   begin
2179     uiContext.resetClip();
2180     uiContext.darkenRect(gx+mWidth, gy+8, 8, mHeight, 128);
2181     uiContext.darkenRect(gx+8, gy+mHeight, mWidth-8, 8, 128);
2182   end;
2183 end;
2184
2185
2186 // ////////////////////////////////////////////////////////////////////////// //
2187 procedure TUIControl.onEvent (var ev: TFUIEvent);
2188 begin
2189   if (not ev.alive) or (not enabled) then exit;
2190   //if (ev.mine) then writeln(' MINE: <', className, '>');
2191   if (ev.key) then
2192   begin
2193          if (ev.sinking) then keyEventSink(ev)
2194     else if (ev.bubbling) then keyEventBubble(ev)
2195     else if (ev.mine) then keyEvent(ev);
2196   end
2197   else if (ev.mouse) then
2198   begin
2199          if (ev.sinking) then mouseEventSink(ev)
2200     else if (ev.bubbling) then mouseEventBubble(ev)
2201     else if (ev.mine) then mouseEvent(ev);
2202   end;
2203 end;
2204
2205
2206 procedure TUIControl.mouseEventSink (var ev: TFUIEvent);
2207 begin
2208 end;
2209
2210 procedure TUIControl.mouseEventBubble (var ev: TFUIEvent);
2211 begin
2212 end;
2213
2214 procedure TUIControl.mouseEvent (var ev: TFUIEvent);
2215 begin
2216 end;
2217
2218
2219 procedure TUIControl.keyEventSink (var ev: TFUIEvent);
2220 var
2221   ctl: TUIControl;
2222 begin
2223   if (not enabled) then exit;
2224   if (not ev.alive) then exit;
2225   // for top-level controls
2226   if (mParent <> nil) then exit;
2227   if (mEscClose) and (ev = 'Escape') then
2228   begin
2229     if (not assigned(closeRequestCB)) or (closeRequestCB(self)) then
2230     begin
2231       uiRemoveWindow(self);
2232     end;
2233     ev.eat();
2234     exit;
2235   end;
2236   if (ev = 'Enter') or (ev = 'C-Enter') then
2237   begin
2238     ctl := findDefaulControl();
2239     if (ctl <> nil) then
2240     begin
2241       ev.eat();
2242       ctl.doAction();
2243       exit;
2244     end;
2245   end;
2246   if (ev = 'Escape') then
2247   begin
2248     ctl := findCancelControl();
2249     if (ctl <> nil) then
2250     begin
2251       ev.eat();
2252       ctl.doAction();
2253       exit;
2254     end;
2255   end;
2256 end;
2257
2258 procedure TUIControl.keyEventBubble (var ev: TFUIEvent);
2259 var
2260   ctl: TUIControl;
2261 begin
2262   if (not enabled) then exit;
2263   if (not ev.alive) then exit;
2264   // for top-level controls
2265   if (mParent <> nil) then exit;
2266   if (ev = 'S-Tab') then
2267   begin
2268     ctl := findPrevFocus(mFocused, true);
2269     if (ctl <> nil) and (ctl <> mFocused) then ctl.setFocused(true);
2270     ev.eat();
2271     exit;
2272   end;
2273   if (ev = 'Tab') then
2274   begin
2275     ctl := findNextFocus(mFocused, true);
2276     if (ctl <> nil) and (ctl <> mFocused) then ctl.setFocused(true);
2277     ev.eat();
2278     exit;
2279   end;
2280 end;
2281
2282 procedure TUIControl.keyEvent (var ev: TFUIEvent);
2283 begin
2284 end;
2285
2286
2287 // ////////////////////////////////////////////////////////////////////////// //
2288 constructor TUITopWindow.Create (const atitle: AnsiString);
2289 begin
2290   inherited Create();
2291   mTitle := atitle;
2292 end;
2293
2294
2295 procedure TUITopWindow.AfterConstruction ();
2296 begin
2297   inherited;
2298   mFitToScreen := true;
2299   mFrameWidth := 8;
2300   mFrameHeight := uiContext.charHeight(#184);
2301   if (mWidth < mFrameWidth*2+uiContext.iconWinWidth(TGxContext.TWinIcon.Close)) then mWidth := mFrameWidth*2+uiContext.iconWinWidth(TGxContext.TWinIcon.Close);
2302   if (mHeight < mFrameHeight*2) then mHeight := mFrameHeight*2;
2303   if (Length(mTitle) > 0) then
2304   begin
2305     if (mWidth < uiContext.textWidth(mTitle)+mFrameWidth*2+uiContext.iconWinWidth(TGxContext.TWinIcon.Close)) then
2306     begin
2307       mWidth := uiContext.textWidth(mTitle)+mFrameWidth*2+uiContext.iconWinWidth(TGxContext.TWinIcon.Close);
2308     end;
2309   end;
2310   mCanFocus := false;
2311   mDragScroll := TXMode.None;
2312   mDrawShadow := true;
2313   mWaitingClose := false;
2314   mInClose := false;
2315   closeCB := nil;
2316   mCtl4Style := 'window';
2317   mDefSize.w := nmax(1, mDefSize.w);
2318   mDefSize.h := nmax(1, mDefSize.h);
2319 end;
2320
2321
2322 function TUITopWindow.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
2323 begin
2324   if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) then
2325   begin
2326     mTitle := par.expectIdOrStr(true);
2327     result := true;
2328     exit;
2329   end;
2330   if (strEquCI1251(prname, 'children')) then
2331   begin
2332     parseChildren(par);
2333     result := true;
2334     exit;
2335   end;
2336   if (strEquCI1251(prname, 'position')) then
2337   begin
2338          if (par.eatIdOrStrCI('default')) then mDoCenter := false
2339     else if (par.eatIdOrStrCI('center')) then mDoCenter := true
2340     else par.error('`center` or `default` expected');
2341     result := true;
2342     exit;
2343   end;
2344   if (parseOrientation(prname, par)) then begin result := true; exit; end;
2345   result := inherited parseProperty(prname, par);
2346 end;
2347
2348
2349 procedure TUITopWindow.flFitToScreen ();
2350 var
2351   nsz: TLaySize;
2352 begin
2353   nsz := TLaySize.Create(trunc(fuiScrWdt/fuiRenderScale)-mFrameWidth*2-6, trunc(fuiScrHgt/fuiRenderScale)-mFrameHeight*2-6);
2354   if (mMaxSize.w < 1) then mMaxSize.w := nsz.w;
2355   if (mMaxSize.h < 1) then mMaxSize.h := nsz.h;
2356 end;
2357
2358
2359 procedure TUITopWindow.centerInScreen ();
2360 begin
2361   if (mWidth > 0) and (mHeight > 0) then
2362   begin
2363     mX := trunc((fuiScrWdt/fuiRenderScale-mWidth)/2);
2364     mY := trunc((fuiScrHgt/fuiRenderScale-mHeight)/2);
2365   end;
2366 end;
2367
2368
2369 // ////////////////////////////////////////////////////////////////////////// //
2370 procedure TUITopWindow.drawControl (gx, gy: Integer);
2371 begin
2372   uiContext.color := mBackColor[getColorIndex];
2373   uiContext.fillRect(gx, gy, mWidth, mHeight);
2374 end;
2375
2376 procedure TUITopWindow.drawControlPost (gx, gy: Integer);
2377 var
2378   cidx, iwdt, ihgt: Integer;
2379   ybot, xend, vhgt, vwdt: Integer;
2380 begin
2381   cidx := getColorIndex;
2382   iwdt := uiContext.iconWinWidth(TGxContext.TWinIcon.Close);
2383   if (mDragScroll = TXMode.Drag) then
2384   begin
2385     drawFrame(gx, gy, iwdt, 0, mTitle, false);
2386   end
2387   else
2388   begin
2389     ihgt := uiContext.iconWinHeight(TGxContext.TWinIcon.Close);
2390     drawFrame(gx, gy, iwdt, 0, mTitle, true);
2391     // vertical scroll bar
2392     vhgt := mHeight-mFrameHeight*2;
2393     if (mFullSize.h > vhgt) then
2394     begin
2395       ybot := mScrollY+vhgt;
2396       resetScissorNC();
2397       uiContext.drawVSBar(gx+mWidth-mFrameWidth+1, gy+mFrameHeight-1, mFrameWidth-3, vhgt+2, ybot, 0, mFullSize.h, mSBarFullColor[cidx], mSBarEmptyColor[cidx]);
2398     end;
2399     // horizontal scroll bar
2400     vwdt := mWidth-mFrameWidth*2;
2401     if (mFullSize.w > vwdt) then
2402     begin
2403       xend := mScrollX+vwdt;
2404       resetScissorNC();
2405       uiContext.drawHSBar(gx+mFrameWidth+1, gy+mHeight-mFrameHeight+1, vwdt-2, mFrameHeight-3, xend, 0, mFullSize.w, mSBarFullColor[cidx], mSBarEmptyColor[cidx]);
2406     end;
2407     // frame icon
2408     setScissor(mFrameWidth, 0, iwdt, ihgt);
2409     uiContext.color := mBackColor[cidx];
2410     uiContext.fillRect(gx+mFrameWidth, gy, iwdt, ihgt);
2411     uiContext.color := mFrameIconColor[cidx];
2412     uiContext.drawIconWin(TGxContext.TWinIcon.Close, gx+mFrameWidth, gy, mInClose);
2413   end;
2414   // shadow (no need to reset scissor, as draw should do it)
2415   inherited drawControlPost(gx, gy);
2416 end;
2417
2418
2419 // ////////////////////////////////////////////////////////////////////////// //
2420 procedure TUITopWindow.activated ();
2421 begin
2422   if (mFocused = nil) or (mFocused = self) then
2423   begin
2424     mFocused := findFirstFocus();
2425   end;
2426   if (mFocused <> nil) and (mFocused <> self) then mFocused.activated();
2427   inherited;
2428 end;
2429
2430
2431 procedure TUITopWindow.blurred ();
2432 begin
2433   mDragScroll := TXMode.None;
2434   mWaitingClose := false;
2435   mInClose := false;
2436   if (mFocused <> nil) and (mFocused <> self) then mFocused.blurred();
2437   inherited;
2438 end;
2439
2440
2441 procedure TUITopWindow.keyEventBubble (var ev: TFUIEvent);
2442 begin
2443   inherited keyEvent(ev);
2444   if (not ev.alive) or (not enabled) {or (not getFocused)} then exit;
2445   if (ev = 'M-F3') then
2446   begin
2447     if (not assigned(closeRequestCB)) or (closeRequestCB(self)) then
2448     begin
2449       uiRemoveWindow(self);
2450     end;
2451     ev.eat();
2452     exit;
2453   end;
2454 end;
2455
2456
2457 procedure TUITopWindow.mouseEvent (var ev: TFUIEvent);
2458 var
2459   lx, ly: Integer;
2460   vhgt, ytop: Integer;
2461   vwdt, xend: Integer;
2462 begin
2463   if (not enabled) then exit;
2464   if (mWidth < 1) or (mHeight < 1) then exit;
2465
2466   if (mDragScroll = TXMode.Drag) then
2467   begin
2468     mX += ev.x-mDragStartX;
2469     mY += ev.y-mDragStartY;
2470     mDragStartX := ev.x;
2471     mDragStartY := ev.y;
2472     if (ev.release) and (ev.but = ev.Left) then mDragScroll := TXMode.None;
2473     ev.eat();
2474     exit;
2475   end;
2476
2477   if (mDragScroll = TXMode.VScroll) then
2478   begin
2479     ly := ev.y-mY;
2480     vhgt := mHeight-mFrameHeight*2;
2481     ytop := uiContext.sbarPos(ly, mFrameHeight-1, vhgt+2, 0, mFullSize.h)-vhgt;
2482     mScrollY := nmax(0, ytop);
2483     if (ev.release) and (ev.but = ev.Left) then mDragScroll := TXMode.None;
2484     ev.eat();
2485     exit;
2486   end;
2487
2488   if (mDragScroll = TXMode.HScroll) then
2489   begin
2490     lx := ev.x-mX;
2491     vwdt := mWidth-mFrameWidth*2;
2492     xend := uiContext.sbarPos(lx, mFrameWidth+1, vwdt-2, 0, mFullSize.w)-vwdt;
2493     mScrollX := nmax(0, xend);
2494     if (ev.release) and (ev.but = ev.Left) then mDragScroll := TXMode.None;
2495     ev.eat();
2496     exit;
2497   end;
2498
2499   if toLocal(ev.x, ev.y, lx, ly) then
2500   begin
2501     if (ev.press) then
2502     begin
2503       if (ly < mFrameHeight) then
2504       begin
2505         uiGrabCtl := self;
2506         if (lx >= mFrameWidth) and (lx < mFrameWidth+uiContext.iconWinWidth(TGxContext.TWinIcon.Close)) then
2507         begin
2508           //uiRemoveWindow(self);
2509           mWaitingClose := true;
2510           mInClose := true;
2511         end
2512         else
2513         begin
2514           mDragScroll := TXMode.Drag;
2515           mDragStartX := ev.x;
2516           mDragStartY := ev.y;
2517         end;
2518         ev.eat();
2519         exit;
2520       end;
2521       // check for vertical scrollbar
2522       if (lx >= mWidth-mFrameWidth+1) and (ly >= mFrameHeight-1) and (ly < mHeight-mFrameHeight+2) then
2523       begin
2524         vhgt := mHeight-mFrameHeight*2;
2525         if (mFullSize.h > vhgt) then
2526         begin
2527           uiGrabCtl := self;
2528           mDragScroll := TXMode.VScroll;
2529           ev.eat();
2530           ytop := uiContext.sbarPos(ly, mFrameHeight-1, vhgt+2, 0, mFullSize.h)-vhgt;
2531           mScrollY := nmax(0, ytop);
2532           exit;
2533         end;
2534       end;
2535       // check for horizontal scrollbar
2536       if (ly >= mHeight-mFrameHeight+1) and (lx >= mFrameWidth+1) and (lx < mWidth-mFrameWidth-1) then
2537       begin
2538         vwdt := mWidth-mFrameWidth*2;
2539         if (mFullSize.w > vwdt) then
2540         begin
2541           uiGrabCtl := self;
2542           mDragScroll := TXMode.HScroll;
2543           ev.eat();
2544           xend := uiContext.sbarPos(lx, mFrameWidth+1, vwdt-2, 0, mFullSize.w)-vwdt;
2545           mScrollX := nmax(0, xend);
2546           exit;
2547         end;
2548       end;
2549       // drag
2550       if (lx < mFrameWidth) or (lx >= mWidth-mFrameWidth) or (ly >= mHeight-mFrameHeight) then
2551       begin
2552         uiGrabCtl := self;
2553         mDragScroll := TXMode.Drag;
2554         mDragStartX := ev.x;
2555         mDragStartY := ev.y;
2556         ev.eat();
2557         exit;
2558       end;
2559     end;
2560
2561     if (ev.release) then
2562     begin
2563       if mWaitingClose then
2564       begin
2565         if (lx >= mFrameWidth) and (lx < mFrameWidth+uiContext.iconWinWidth(TGxContext.TWinIcon.Close)) then
2566         begin
2567           if (not assigned(closeRequestCB)) or (closeRequestCB(self)) then
2568           begin
2569             uiRemoveWindow(self);
2570           end;
2571         end;
2572         mWaitingClose := false;
2573         mInClose := false;
2574         ev.eat();
2575         exit;
2576       end;
2577     end;
2578
2579     if (ev.motion) then
2580     begin
2581       if mWaitingClose then
2582       begin
2583         mInClose := (lx >= mFrameWidth) and (lx < mFrameWidth+uiContext.iconWinWidth(TGxContext.TWinIcon.Close));
2584         ev.eat();
2585         exit;
2586       end;
2587     end;
2588
2589     inherited mouseEvent(ev);
2590   end
2591   else
2592   begin
2593     mInClose := false;
2594     if (not ev.motion) and (mWaitingClose) then begin ev.eat(); mWaitingClose := false; exit; end;
2595   end;
2596 end;
2597
2598
2599 // ////////////////////////////////////////////////////////////////////////// //
2600 constructor TUIBox.Create (ahoriz: Boolean);
2601 begin
2602   inherited Create();
2603   mHoriz := ahoriz;
2604 end;
2605
2606
2607 procedure TUIBox.AfterConstruction ();
2608 begin
2609   inherited;
2610   mCanFocus := false;
2611   mHAlign := -1; // left
2612   mCtl4Style := 'box';
2613   mDefSize := TLaySize.Create(-1, -1);
2614 end;
2615
2616
2617 procedure TUIBox.setCaption (const acap: AnsiString);
2618 begin
2619   mCaption := acap;
2620   mDefSize := TLaySize.Create(uiContext.textWidth(mCaption)+3, uiContext.textHeight(mCaption));
2621 end;
2622
2623
2624 procedure TUIBox.setHasFrame (v: Boolean);
2625 begin
2626   mHasFrame := v;
2627   if (mHasFrame) then begin mFrameWidth := 8; mFrameHeight := uiContext.charHeight(#184); end else begin mFrameWidth := 0; mFrameHeight := 0; end;
2628   if (mHasFrame) then mNoPad := true;
2629 end;
2630
2631
2632 function TUIBox.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
2633 begin
2634   if (parseOrientation(prname, par)) then begin result := true; exit; end;
2635   if (strEquCI1251(prname, 'padding')) then
2636   begin
2637     if (mHoriz) then mPadding := parseHPadding(par, 0) else mPadding := parseVPadding(par, 0);
2638     result := true;
2639     exit;
2640   end;
2641   if (strEquCI1251(prname, 'frame')) then
2642   begin
2643     setHasFrame(parseBool(par));
2644     result := true;
2645     exit;
2646   end;
2647   if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) then
2648   begin
2649     setCaption(par.expectIdOrStr(true));
2650     result := true;
2651     exit;
2652   end;
2653   if (strEquCI1251(prname, 'textalign')) or (strEquCI1251(prname, 'text-align')) then
2654   begin
2655     mHAlign := parseHAlign(par);
2656     result := true;
2657     exit;
2658   end;
2659   if (strEquCI1251(prname, 'children')) then
2660   begin
2661     parseChildren(par);
2662     result := true;
2663     exit;
2664   end;
2665   result := inherited parseProperty(prname, par);
2666 end;
2667
2668
2669 procedure TUIBox.drawControl (gx, gy: Integer);
2670 var
2671   cidx: Integer;
2672   //xpos: Integer;
2673 begin
2674   cidx := getColorIndex;
2675   uiContext.color := mBackColor[cidx];
2676   uiContext.fillRect(gx, gy, mWidth, mHeight);
2677   if (mHasFrame) then
2678   begin
2679     // draw frame
2680     drawFrame(gx, gy, 0, mHAlign, mCaption, false);
2681   end;
2682   // no frame -- no caption
2683   {
2684   else if (Length(mCaption) > 0) then
2685   begin
2686     // draw caption
2687          if (mHAlign < 0) then xpos := 3
2688     else if (mHAlign > 0) then xpos := mWidth-mFrameWidth*2-uiContext.textWidth(mCaption)
2689     else xpos := (mWidth-mFrameWidth*2-uiContext.textWidth(mCaption)) div 2;
2690     xpos += gx+mFrameWidth;
2691
2692     setScissor(mFrameWidth+1, 0, mWidth-mFrameWidth-2, uiContext.textHeight(mCaption));
2693     uiContext.color := mFrameTextColor[cidx];
2694     uiContext.drawText(xpos, gy, mCaption);
2695   end;
2696   }
2697 end;
2698
2699
2700 procedure TUIBox.mouseEvent (var ev: TFUIEvent);
2701 var
2702   lx, ly: Integer;
2703 begin
2704   inherited mouseEvent(ev);
2705   if (ev.alive) and (enabled) and toLocal(ev.x, ev.y, lx, ly) then
2706   begin
2707     ev.eat();
2708   end;
2709 end;
2710
2711
2712 procedure TUIBox.keyEvent (var ev: TFUIEvent);
2713 var
2714   dir: Integer = 0;
2715   cur, ctl: TUIControl;
2716 begin
2717   inherited keyEvent(ev);
2718   if (not ev.alive) or (not ev.press) or (not enabled) or (not getActive) then exit;
2719   if (Length(mChildren) = 0) then exit;
2720        if (mHoriz) and (ev = 'Left') then dir := -1
2721   else if (mHoriz) and (ev = 'Right') then dir := 1
2722   else if (not mHoriz) and (ev = 'Up') then dir := -1
2723   else if (not mHoriz) and (ev = 'Down') then dir := 1;
2724   if (dir = 0) then exit;
2725   ev.eat();
2726   cur := topLevel.mFocused;
2727   while (cur <> nil) and (cur.mParent <> self) do cur := cur.mParent;
2728   //if (cur = nil) then writeln('CUR: nil') else writeln('CUR: ', cur.className, '#', cur.id);
2729   if (dir < 0) then ctl := findPrevFocus(cur, true) else ctl := findNextFocus(cur, true);
2730   //if (ctl = nil) then writeln('CTL: nil') else writeln('CTL: ', ctl.className, '#', ctl.id);
2731   if (ctl <> nil) and (ctl <> self) then
2732   begin
2733     ctl.focused := true;
2734   end;
2735 end;
2736
2737
2738 // ////////////////////////////////////////////////////////////////////////// //
2739 constructor TUIHBox.Create ();
2740 begin
2741 end;
2742
2743
2744 procedure TUIHBox.AfterConstruction ();
2745 begin
2746   inherited;
2747   mHoriz := true;
2748 end;
2749
2750
2751 // ////////////////////////////////////////////////////////////////////////// //
2752 constructor TUIVBox.Create ();
2753 begin
2754 end;
2755
2756
2757 procedure TUIVBox.AfterConstruction ();
2758 begin
2759   inherited;
2760   mHoriz := false;
2761 end;
2762
2763
2764 // ////////////////////////////////////////////////////////////////////////// //
2765 procedure TUISpan.AfterConstruction ();
2766 begin
2767   inherited;
2768   mExpand := true;
2769   mCanFocus := false;
2770   mNoPad := true;
2771   mCtl4Style := 'span';
2772   mDefSize := TLaySize.Create(-1, -1);
2773 end;
2774
2775
2776 function TUISpan.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
2777 begin
2778   if (parseOrientation(prname, par)) then begin result := true; exit; end;
2779   result := inherited parseProperty(prname, par);
2780 end;
2781
2782
2783 // ////////////////////////////////////////////////////////////////////// //
2784 procedure TUILine.AfterConstruction ();
2785 begin
2786   inherited;
2787   mCanFocus := false;
2788   mExpand := true;
2789   mCanFocus := false;
2790   mCtl4Style := 'line';
2791   mDefSize := TLaySize.Create(-1, -1);
2792 end;
2793
2794
2795 function TUILine.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
2796 begin
2797   if (parseOrientation(prname, par)) then begin result := true; exit; end;
2798   result := inherited parseProperty(prname, par);
2799 end;
2800
2801
2802 procedure TUILine.layPrepare ();
2803 begin
2804   inherited layPrepare();
2805   if (mParent <> nil) then mHoriz := not mParent.mHoriz;
2806   if (mHoriz) then
2807   begin
2808     if (mLayDefSize.w < 0) then mLayDefSize.w := 1;
2809     if (mLayDefSize.h < 0) then mLayDefSize.h := 7;
2810   end
2811   else
2812   begin
2813     if (mLayDefSize.w < 0) then mLayDefSize.w := 7;
2814     if (mLayDefSize.h < 0) then mLayDefSize.h := 1;
2815   end;
2816 end;
2817
2818
2819 procedure TUILine.drawControl (gx, gy: Integer);
2820 var
2821   cidx: Integer;
2822 begin
2823   cidx := getColorIndex;
2824   uiContext.color := mTextColor[cidx];
2825   if mHoriz then uiContext.hline(gx, gy+(mHeight div 2), mWidth)
2826   else uiContext.vline(gx+(mWidth div 2), gy, mHeight);
2827 end;
2828
2829
2830 // ////////////////////////////////////////////////////////////////////////// //
2831 procedure TUIStaticText.AfterConstruction ();
2832 begin
2833   inherited;
2834   mCanFocus := false;
2835   mHAlign := -1;
2836   mVAlign := 0;
2837   mHoriz := true; // nobody cares
2838   mHeader := false;
2839   mLine := false;
2840   mCtl4Style := 'static';
2841 end;
2842
2843
2844 procedure TUIStaticText.setText (const atext: AnsiString);
2845 begin
2846   mText := atext;
2847   mDefSize := TLaySize.Create(uiContext.textWidth(mText), uiContext.textHeight(mText));
2848 end;
2849
2850
2851 function TUIStaticText.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
2852 begin
2853   if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) or (strEquCI1251(prname, 'text')) then
2854   begin
2855     setText(par.expectIdOrStr(true));
2856     result := true;
2857     exit;
2858   end;
2859   if (strEquCI1251(prname, 'textalign')) or (strEquCI1251(prname, 'text-align')) then
2860   begin
2861     parseTextAlign(par, mHAlign, mVAlign);
2862     result := true;
2863     exit;
2864   end;
2865   if (strEquCI1251(prname, 'header')) then
2866   begin
2867     mHeader := true;
2868     result := true;
2869     exit;
2870   end;
2871   if (strEquCI1251(prname, 'line')) then
2872   begin
2873     mLine := true;
2874     result := true;
2875     exit;
2876   end;
2877   result := inherited parseProperty(prname, par);
2878 end;
2879
2880
2881 procedure TUIStaticText.drawControl (gx, gy: Integer);
2882 var
2883   xpos, ypos: Integer;
2884   cidx: Integer;
2885 begin
2886   cidx := getColorIndex;
2887   uiContext.color := mBackColor[cidx];
2888   uiContext.fillRect(gx, gy, mWidth, mHeight);
2889
2890        if (mHAlign < 0) then xpos := 0
2891   else if (mHAlign > 0) then xpos := mWidth-uiContext.textWidth(mText)
2892   else xpos := (mWidth-uiContext.textWidth(mText)) div 2;
2893
2894   if (Length(mText) > 0) then
2895   begin
2896     if (mHeader) then uiContext.color := mFrameTextColor[cidx] else uiContext.color := mTextColor[cidx];
2897
2898          if (mVAlign < 0) then ypos := 0
2899     else if (mVAlign > 0) then ypos := mHeight-uiContext.textHeight(mText)
2900     else ypos := (mHeight-uiContext.textHeight(mText)) div 2;
2901
2902     uiContext.drawText(gx+xpos, gy+ypos, mText);
2903   end;
2904
2905   if (mLine) then
2906   begin
2907     if (mHeader) then uiContext.color := mFrameColor[cidx] else uiContext.color := mTextColor[cidx];
2908
2909          if (mVAlign < 0) then ypos := 0
2910     else if (mVAlign > 0) then ypos := mHeight-1
2911     else ypos := (mHeight div 2);
2912     ypos += gy;
2913
2914     if (Length(mText) = 0) then
2915     begin
2916       uiContext.hline(gx, ypos, mWidth);
2917     end
2918     else
2919     begin
2920       uiContext.hline(gx, ypos, xpos-1);
2921       uiContext.hline(gx+xpos+uiContext.textWidth(mText), ypos, mWidth);
2922     end;
2923   end;
2924 end;
2925
2926
2927 // ////////////////////////////////////////////////////////////////////////// //
2928 procedure TUITextLabel.AfterConstruction ();
2929 begin
2930   inherited;
2931   mHAlign := -1;
2932   mVAlign := 0;
2933   mCanFocus := false;
2934   mCtl4Style := 'label';
2935   mLinkId := '';
2936 end;
2937
2938
2939 procedure TUITextLabel.cacheStyle (root: TUIStyle);
2940 begin
2941   inherited cacheStyle(root);
2942   // active
2943   mHotColor[ClrIdxActive] := root.get('hot-color', 'active', mCtl4Style).asRGBADef(TGxRGBA.Create(0, 128, 0));
2944   // disabled
2945   mHotColor[ClrIdxDisabled] := root.get('hot-color', 'disabled', mCtl4Style).asRGBADef(TGxRGBA.Create(0, 64, 0));
2946   // inactive
2947   mHotColor[ClrIdxInactive] := root.get('hot-color', 'inactive', mCtl4Style).asRGBADef(TGxRGBA.Create(0, 64, 0));
2948 end;
2949
2950
2951 procedure TUITextLabel.setText (const s: AnsiString);
2952 var
2953   f: Integer;
2954 begin
2955   mText := '';
2956   mHotChar := #0;
2957   mHotOfs := 0;
2958   f := 1;
2959   while (f <= Length(s)) do
2960   begin
2961     if (s[f] = '\\') then
2962     begin
2963       Inc(f);
2964       if (f <= Length(s)) then mText += s[f];
2965       Inc(f);
2966     end
2967     else if (s[f] = '~') then
2968     begin
2969       Inc(f);
2970       if (f <= Length(s)) then
2971       begin
2972         if (mHotChar = #0) then
2973         begin
2974           mHotChar := s[f];
2975           mHotOfs := Length(mText);
2976         end;
2977         mText += s[f];
2978       end;
2979       Inc(f);
2980     end
2981     else
2982     begin
2983       mText += s[f];
2984       Inc(f);
2985     end;
2986   end;
2987   // fix hotchar offset
2988   if (mHotChar <> #0) and (mHotOfs > 0) then
2989   begin
2990     mHotOfs := uiContext.textWidth(Copy(mText, 1, mHotOfs+1))-uiContext.charWidth(mText[mHotOfs+1]);
2991   end;
2992   // fix size
2993   mDefSize := TLaySize.Create(uiContext.textWidth(mText), uiContext.textHeight(mText));
2994 end;
2995
2996
2997 function TUITextLabel.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
2998 begin
2999   if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) or (strEquCI1251(prname, 'text')) then
3000   begin
3001     setText(par.expectIdOrStr(true));
3002     result := true;
3003     exit;
3004   end;
3005   if (strEquCI1251(prname, 'link')) then
3006   begin
3007     mLinkId := par.expectIdOrStr(true);
3008     result := true;
3009     exit;
3010   end;
3011   if (strEquCI1251(prname, 'textalign')) or (strEquCI1251(prname, 'text-align')) then
3012   begin
3013     parseTextAlign(par, mHAlign, mVAlign);
3014     result := true;
3015     exit;
3016   end;
3017   result := inherited parseProperty(prname, par);
3018 end;
3019
3020
3021 procedure TUITextLabel.drawControl (gx, gy: Integer);
3022 var
3023   xpos, ypos: Integer;
3024   cidx: Integer;
3025 begin
3026   cidx := getColorIndex;
3027   uiContext.color := mBackColor[cidx];
3028   uiContext.fillRect(gx, gy, mWidth, mHeight);
3029   if (Length(mText) > 0) then
3030   begin
3031          if (mHAlign < 0) then xpos := 0
3032     else if (mHAlign > 0) then xpos := mWidth-uiContext.textWidth(mText)
3033     else xpos := (mWidth-uiContext.textWidth(mText)) div 2;
3034
3035          if (mVAlign < 0) then ypos := 0
3036     else if (mVAlign > 0) then ypos := mHeight-uiContext.textHeight(mText)
3037     else ypos := (mHeight-uiContext.textHeight(mText)) div 2;
3038
3039     uiContext.color := mTextColor[cidx];
3040     uiContext.drawText(gx+xpos, gy+ypos, mText);
3041
3042     if (Length(mLinkId) > 0) and (mHotChar <> #0) and (mHotChar <> ' ') then
3043     begin
3044       uiContext.color := mHotColor[cidx];
3045       uiContext.drawChar(gx+xpos+mHotOfs, gy+ypos, mHotChar);
3046     end;
3047   end;
3048 end;
3049
3050
3051 procedure TUITextLabel.mouseEvent (var ev: TFUIEvent);
3052 var
3053   lx, ly: Integer;
3054 begin
3055   inherited mouseEvent(ev);
3056   if (ev.alive) and (enabled) and toLocal(ev.x, ev.y, lx, ly) then
3057   begin
3058     ev.eat();
3059   end;
3060 end;
3061
3062
3063 procedure TUITextLabel.doAction ();
3064 var
3065   ctl: TUIControl;
3066 begin
3067   if (assigned(actionCB)) then
3068   begin
3069     actionCB(self);
3070   end
3071   else
3072   begin
3073     ctl := topLevel[mLinkId];
3074     if (ctl <> nil) then
3075     begin
3076       if (ctl.canFocus) then ctl.focused := true;
3077     end;
3078   end;
3079 end;
3080
3081
3082 procedure TUITextLabel.keyEventBubble (var ev: TFUIEvent);
3083 begin
3084   if (not enabled) then exit;
3085   if (mHotChar = #0) then exit;
3086   if (not ev.alive) or (not ev.press) then exit;
3087   if (ev.kstate <> ev.ModAlt) then exit;
3088   if (not ev.isHot(mHotChar)) then exit;
3089   ev.eat();
3090   if (canFocus) then focused := true;
3091   doAction();
3092 end;
3093
3094
3095 // ////////////////////////////////////////////////////////////////////////// //
3096 procedure TUIButton.AfterConstruction ();
3097 begin
3098   inherited;
3099   mHAlign := 0;
3100   mVAlign := 0;
3101   mShadowSize := 0;
3102   mCanFocus := true;
3103   mDefSize := TLaySize.Create(uiContext.textWidth(mText)+uiContext.textWidth('[  ]'), uiContext.textHeight(mText));
3104   mCtl4Style := 'button';
3105   mSkipLayPrepare := false;
3106   mAddMarkers := false;
3107   mHideMarkers := false;
3108 end;
3109
3110
3111 procedure TUIButton.cacheStyle (root: TUIStyle);
3112 var
3113   sz: Integer = 0;
3114 begin
3115   inherited cacheStyle(root);
3116   // shadow size
3117   sz := nmax(0, root.get('shadow-size', 'active', mCtl4Style).asInt(0));
3118   sz := nmax(sz, root.get('shadow-size', 'disabled', mCtl4Style).asInt(0));
3119   sz := nmax(sz, root.get('shadow-size', 'inactive', mCtl4Style).asInt(0));
3120   mShadowSize := sz;
3121   // markers mode
3122   mAddMarkers := root.get('add-markers', 'active', mCtl4Style).asBool(false);
3123   mAddMarkers := mAddMarkers or root.get('add-markers', 'disabled', mCtl4Style).asBool(false);
3124   mAddMarkers := mAddMarkers or root.get('add-markers', 'inactive', mCtl4Style).asBool(false);
3125   // hide markers?
3126   mHideMarkers := root.get('hide-markers', 'active', mCtl4Style).asBool(false);
3127   mHideMarkers := mHideMarkers or root.get('hide-markers', 'disabled', mCtl4Style).asBool(false);
3128   mHideMarkers := mHideMarkers or root.get('hide-markers', 'inactive', mCtl4Style).asBool(false);
3129 end;
3130
3131
3132 procedure TUIButton.setText (const s: AnsiString);
3133 begin
3134   inherited setText(s);
3135   if (mHideMarkers) then
3136   begin
3137     mDefSize := TLaySize.Create(uiContext.textWidth(mText)+10, uiContext.textHeight(mText));
3138   end
3139   else if (mAddMarkers) then
3140   begin
3141     mDefSize := TLaySize.Create(uiContext.textWidth(mText)+uiContext.textWidth('[<>]'), uiContext.textHeight(mText));
3142   end
3143   else
3144   begin
3145     mDefSize := TLaySize.Create(uiContext.textWidth(mText)+uiContext.textWidth('<>'), uiContext.textHeight(mText));
3146   end;
3147 end;
3148
3149
3150 procedure TUIButton.layPrepare ();
3151 var
3152   ods: TLaySize;
3153   ww: Integer;
3154 begin
3155   if (not mSkipLayPrepare) then
3156   begin
3157     ods := mDefSize;
3158     if (ods.w <> 0) or (ods.h <> 0) then
3159     begin
3160       mDefSize := TLaySize.Create(uiContext.textWidth(mText), uiContext.textHeight(mText));
3161       if (mHideMarkers) then
3162       begin
3163         ww := 10;
3164       end
3165       else if (mAddMarkers) then
3166       begin
3167              if (mDefault) then ww := uiContext.textWidth('[<  >]')
3168         else if (mCancel) then ww := uiContext.textWidth('[{  }]')
3169         else ww := uiContext.textWidth('[  ]');
3170       end
3171       else
3172       begin
3173         ww := nmax(0, uiContext.textWidth('<  >'));
3174         ww := nmax(ww, uiContext.textWidth('{  }'));
3175         ww := nmax(ww, uiContext.textWidth('[  ]'));
3176       end;
3177       mDefSize.w += ww+mShadowSize;
3178       mDefSize.h += mShadowSize;
3179     end;
3180   end
3181   else
3182   begin
3183     ods := TLaySize.Create(0, 0); // fpc is dumb!
3184   end;
3185   inherited layPrepare();
3186   if (not mSkipLayPrepare) then mDefSize := ods;
3187 end;
3188
3189
3190 procedure TUIButton.blurred ();
3191 begin
3192   mPushed := false;
3193 end;
3194
3195
3196 procedure TUIButton.drawControl (gx, gy: Integer);
3197 var
3198   wdt, hgt: Integer;
3199   xpos, ypos, xofsl, xofsr, sofs: Integer;
3200   cidx: Integer;
3201   lch, rch: AnsiChar;
3202   lstr, rstr: AnsiString;
3203 begin
3204   cidx := getColorIndex;
3205
3206   wdt := mWidth-mShadowSize;
3207   hgt := mHeight-mShadowSize;
3208   if (mPushed) {or (cidx = ClrIdxActive)} then
3209   begin
3210     sofs := mShadowSize;
3211     gx += mShadowSize;
3212     gy += mShadowSize;
3213   end
3214   else
3215   begin
3216     sofs := 0;
3217     if (mShadowSize > 0) then
3218     begin
3219       uiContext.darkenRect(gx+mShadowSize, gy+hgt, wdt, mShadowSize, 96);
3220       uiContext.darkenRect(gx+wdt, gy+mShadowSize, mShadowSize, hgt-mShadowSize, 96);
3221     end;
3222   end;
3223
3224   uiContext.color := mBackColor[cidx];
3225   uiContext.fillRect(gx, gy, wdt, hgt);
3226
3227        if (mVAlign < 0) then ypos := 0
3228   else if (mVAlign > 0) then ypos := hgt-uiContext.textHeight(mText)
3229   else ypos := (hgt-uiContext.textHeight(mText)) div 2;
3230   ypos += gy;
3231
3232   uiContext.color := mTextColor[cidx];
3233
3234   if (mHideMarkers) then
3235   begin
3236     xofsl := 5;
3237     xofsr := 5;
3238   end
3239   else
3240   begin
3241     if (mAddMarkers) then
3242     begin
3243            if (mDefault) then begin lstr := '[< '; rstr := ' >]'; end
3244       else if (mCancel) then begin lstr := '[{ '; rstr := ' }]'; end
3245       else begin lstr := '[ '; rstr := ' ]'; end;
3246       xofsl := uiContext.textWidth(lstr);
3247       xofsr := uiContext.textWidth(rstr);
3248       uiContext.drawText(gx, ypos, lstr);
3249       uiContext.drawText(gx+wdt-uiContext.textWidth(rstr), ypos, rstr);
3250     end
3251     else
3252     begin
3253       xofsl := nmax(0, uiContext.textWidth('< '));
3254       xofsl := nmax(xofsl, uiContext.textWidth('{ '));
3255       xofsl := nmax(xofsl, uiContext.textWidth('[ '));
3256       xofsr := nmax(0, uiContext.textWidth(' >'));
3257       xofsr := nmax(xofsr, uiContext.textWidth(' }'));
3258       xofsr := nmax(xofsr, uiContext.textWidth(' ]'));
3259            if (mDefault) then begin lch := '<'; rch := '>'; end
3260       else if (mCancel) then begin lch := '{'; rch := '}'; end
3261       else begin lch := '['; rch := ']'; end;
3262       uiContext.drawChar(gx, ypos, lch);
3263       uiContext.drawChar(gx+wdt-uiContext.charWidth(rch), ypos, rch);
3264     end;
3265   end;
3266
3267   if (Length(mText) > 0) then
3268   begin
3269     if (mHAlign < 0) then xpos := 0
3270     else begin xpos := wdt-xofsl-xofsr-uiContext.textWidth(mText); if (mHAlign = 0) then xpos := xpos div 2; end;
3271     xpos += xofsl;
3272
3273     setScissor(sofs+xofsl, sofs, wdt-xofsl-xofsr, hgt);
3274     uiContext.drawText(gx+xpos, ypos, mText);
3275
3276     if (mHotChar <> #0) and (mHotChar <> ' ') then
3277     begin
3278       uiContext.color := mHotColor[cidx];
3279       uiContext.drawChar(gx+xpos+mHotOfs, ypos, mHotChar);
3280     end;
3281   end;
3282 end;
3283
3284
3285 procedure TUIButton.mouseEvent (var ev: TFUIEvent);
3286 var
3287   lx, ly: Integer;
3288 begin
3289   inherited mouseEvent(ev);
3290   if (uiGrabCtl = self) then
3291   begin
3292     ev.eat();
3293     mPushed := toLocal(ev.x, ev.y, lx, ly);
3294     if (ev = '-lmb') and (focused) and (mPushed) then
3295     begin
3296       mPushed := false;
3297       doAction();
3298     end;
3299     exit;
3300   end;
3301   if (not ev.alive) or (not enabled) or (not focused) then exit;
3302   mPushed := true;
3303   ev.eat();
3304 end;
3305
3306
3307 procedure TUIButton.keyEvent (var ev: TFUIEvent);
3308 begin
3309   inherited keyEvent(ev);
3310   if (ev.alive) and (enabled) then
3311   begin
3312     if (ev = '+Enter') or (ev = '+Space') then
3313     begin
3314       focused := true;
3315       mPushed := true;
3316       ev.eat();
3317       exit;
3318     end;
3319     if (focused) and ((ev = '-Enter') or (ev = '-Space')) then
3320     begin
3321       if (mPushed) then
3322       begin
3323         mPushed := false;
3324         ev.eat();
3325         doAction();
3326       end
3327       else
3328       begin
3329         ev.eat();
3330       end;
3331       exit;
3332     end;
3333   end;
3334 end;
3335
3336
3337 // ////////////////////////////////////////////////////////////////////////// //
3338 procedure TUIButtonRound.AfterConstruction ();
3339 begin
3340   inherited;
3341   mHAlign := -1;
3342   mVAlign := 0;
3343   mCanFocus := true;
3344   mDefSize := TLaySize.Create(uiContext.textWidth(mText)+8*2, uiContext.textHeight(mText)+2);
3345   mCtl4Style := 'button-round';
3346   mSkipLayPrepare := true;
3347 end;
3348
3349
3350 procedure TUIButtonRound.setText (const s: AnsiString);
3351 begin
3352   inherited setText(s);
3353   mDefSize := TLaySize.Create(uiContext.textWidth(mText)+8*2, uiContext.textHeight(mText)+2);
3354 end;
3355
3356
3357 procedure TUIButtonRound.layPrepare ();
3358 var
3359   ods: TLaySize;
3360 begin
3361   ods := mDefSize;
3362   if (ods.w <> 0) or (ods.h <> 0) then
3363   begin
3364     mDefSize := TLaySize.Create(uiContext.textWidth(mText)+8*2, uiContext.textHeight(mText)+2);
3365   end;
3366   inherited layPrepare();
3367   mDefSize := ods;
3368 end;
3369
3370
3371 procedure TUIButtonRound.drawControl (gx, gy: Integer);
3372 var
3373   xpos, ypos: Integer;
3374   cidx: Integer;
3375 begin
3376   cidx := getColorIndex;
3377
3378   uiContext.color := mBackColor[cidx];
3379   uiContext.fillRect(gx+1, gy, mWidth-2, mHeight);
3380   uiContext.fillRect(gx, gy+1, 1, mHeight-2);
3381   uiContext.fillRect(gx+mWidth-1, gy+1, 1, mHeight-2);
3382
3383   if (Length(mText) > 0) then
3384   begin
3385          if (mHAlign < 0) then xpos := 0
3386     else if (mHAlign > 0) then xpos := mWidth-uiContext.textWidth(mText)
3387     else xpos := (mWidth-uiContext.textWidth(mText)) div 2;
3388
3389          if (mVAlign < 0) then ypos := 0
3390     else if (mVAlign > 0) then ypos := mHeight-uiContext.textHeight(mText)
3391     else ypos := (mHeight-uiContext.textHeight(mText)) div 2;
3392
3393     setScissor(8, 0, mWidth-16, mHeight);
3394     uiContext.color := mTextColor[cidx];
3395     uiContext.drawText(gx+xpos+8, gy+ypos, mText);
3396
3397     if (mHotChar <> #0) and (mHotChar <> ' ') then
3398     begin
3399       uiContext.color := mHotColor[cidx];
3400       uiContext.drawChar(gx+xpos+8+mHotOfs, gy+ypos, mHotChar);
3401     end;
3402   end;
3403 end;
3404
3405
3406 // ////////////////////////////////////////////////////////////////////////// //
3407 procedure TUISwitchBox.AfterConstruction ();
3408 begin
3409   inherited;
3410   mHAlign := -1;
3411   mVAlign := 0;
3412   mCanFocus := true;
3413   mIcon := TGxContext.TMarkIcon.Checkbox;
3414   mDefSize := TLaySize.Create(uiContext.textWidth(mText)+3+uiContext.iconMarkWidth(mIcon), nmax(uiContext.iconMarkHeight(mIcon), uiContext.textHeight(mText)));
3415   mCtl4Style := 'switchbox';
3416   mChecked := false;
3417   mBoolVar := @mChecked;
3418 end;
3419
3420
3421 procedure TUISwitchBox.cacheStyle (root: TUIStyle);
3422 begin
3423   inherited cacheStyle(root);
3424   // active
3425   mSwitchColor[ClrIdxActive] := root.get('switch-color', 'active', mCtl4Style).asRGBADef(TGxRGBA.Create(255, 255, 255));
3426   // disabled
3427   mSwitchColor[ClrIdxDisabled] := root.get('switch-color', 'disabled', mCtl4Style).asRGBADef(TGxRGBA.Create(255, 255, 255));
3428   // inactive
3429   mSwitchColor[ClrIdxInactive] := root.get('switch-color', 'inactive', mCtl4Style).asRGBADef(TGxRGBA.Create(255, 255, 255));
3430 end;
3431
3432
3433 procedure TUISwitchBox.setText (const s: AnsiString);
3434 begin
3435   inherited setText(s);
3436   mDefSize := TLaySize.Create(uiContext.textWidth(mText)+3+uiContext.iconMarkWidth(mIcon), nmax(uiContext.iconMarkHeight(mIcon), uiContext.textHeight(mText)));
3437 end;
3438
3439
3440 function TUISwitchBox.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
3441 begin
3442   if (strEquCI1251(prname, 'checked')) then
3443   begin
3444     result := true;
3445     setChecked(true);
3446     exit;
3447   end;
3448   result := inherited parseProperty(prname, par);
3449 end;
3450
3451
3452 function TUISwitchBox.getChecked (): Boolean;
3453 begin
3454   if (mBoolVar <> nil) then result := mBoolVar^ else result := false;
3455 end;
3456
3457
3458 procedure TUISwitchBox.setVar (pvar: PBoolean);
3459 begin
3460   if (pvar = nil) then pvar := @mChecked;
3461   if (pvar <> mBoolVar) then
3462   begin
3463     mBoolVar := pvar;
3464     setChecked(mBoolVar^);
3465   end;
3466 end;
3467
3468
3469 procedure TUISwitchBox.drawControl (gx, gy: Integer);
3470 var
3471   xpos, ypos, iwdt, dy: Integer;
3472   cidx: Integer;
3473 begin
3474   cidx := getColorIndex;
3475
3476   iwdt := uiContext.iconMarkWidth(mIcon);
3477        if (mHAlign < 0) then xpos := 0
3478   else if (mHAlign > 0) then xpos := mWidth-(uiContext.textWidth(mText)+3+iwdt)
3479   else xpos := (mWidth-(uiContext.textWidth(mText)+3+iwdt)) div 2;
3480
3481        if (mVAlign < 0) then ypos := 0
3482   else if (mVAlign > 0) then ypos := mHeight-uiContext.textHeight(mText)
3483   else ypos := (mHeight-uiContext.textHeight(mText)) div 2;
3484
3485   uiContext.color := mBackColor[cidx];
3486   uiContext.fillRect(gx, gy, mWidth, mHeight);
3487
3488   uiContext.color := mSwitchColor[cidx];
3489   if (uiContext.iconMarkHeight(mIcon) < uiContext.textHeight(mText)) then
3490   begin
3491     case uiContext.textHeight(mText) of
3492       14: dy := 2;
3493       16: dy := 3;
3494       else dy := 1;
3495     end;
3496     uiContext.drawIconMark(mIcon, gx, gy+ypos+uiContext.textHeight(mText)-uiContext.iconMarkHeight(mIcon)-dy, checked);
3497   end
3498   else
3499   begin
3500     uiContext.drawIconMark(mIcon, gx, gy, checked);
3501   end;
3502
3503   uiContext.color := mTextColor[cidx];
3504   uiContext.drawText(gx+xpos+3+iwdt, gy+ypos, mText);
3505
3506   if (mHotChar <> #0) and (mHotChar <> ' ') then
3507   begin
3508     uiContext.color := mHotColor[cidx];
3509     uiContext.drawChar(gx+xpos+3+iwdt+mHotOfs, gy+ypos, mHotChar);
3510   end;
3511 end;
3512
3513
3514 procedure TUISwitchBox.mouseEvent (var ev: TFUIEvent);
3515 var
3516   lx, ly: Integer;
3517 begin
3518   inherited mouseEvent(ev);
3519   if (uiGrabCtl = self) then
3520   begin
3521     ev.eat();
3522     if (ev = '-lmb') and focused and toLocal(ev.x, ev.y, lx, ly) then
3523     begin
3524       doAction();
3525     end;
3526     exit;
3527   end;
3528   if (not ev.alive) or (not enabled) or not focused then exit;
3529   ev.eat();
3530 end;
3531
3532
3533 procedure TUISwitchBox.keyEvent (var ev: TFUIEvent);
3534 begin
3535   inherited keyEvent(ev);
3536   if (ev.alive) and (enabled) then
3537   begin
3538     if (ev = 'Space') then
3539     begin
3540       ev.eat();
3541       doAction();
3542       exit;
3543     end;
3544   end;
3545 end;
3546
3547
3548 // ////////////////////////////////////////////////////////////////////////// //
3549 procedure TUICheckBox.AfterConstruction ();
3550 begin
3551   inherited;
3552   mChecked := false;
3553   mBoolVar := @mChecked;
3554   mIcon := TGxContext.TMarkIcon.Checkbox;
3555   setText('');
3556 end;
3557
3558
3559 procedure TUICheckBox.setChecked (v: Boolean);
3560 begin
3561   mBoolVar^ := v;
3562 end;
3563
3564
3565 procedure TUICheckBox.doAction ();
3566 begin
3567   if (assigned(actionCB)) then
3568   begin
3569     actionCB(self);
3570   end
3571   else
3572   begin
3573     setChecked(not getChecked);
3574   end;
3575 end;
3576
3577
3578 // ////////////////////////////////////////////////////////////////////////// //
3579 procedure TUIRadioBox.AfterConstruction ();
3580 begin
3581   inherited;
3582   mChecked := false;
3583   mBoolVar := @mChecked;
3584   mRadioGroup := '';
3585   mIcon := TGxContext.TMarkIcon.Radiobox;
3586   setText('');
3587 end;
3588
3589
3590 function TUIRadioBox.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
3591 begin
3592   if (strEquCI1251(prname, 'group')) then
3593   begin
3594     mRadioGroup := par.expectIdOrStr(true);
3595     if (getChecked) then setChecked(true);
3596     result := true;
3597     exit;
3598   end;
3599   if (strEquCI1251(prname, 'checked')) then
3600   begin
3601     result := true;
3602     setChecked(true);
3603     exit;
3604   end;
3605   result := inherited parseProperty(prname, par);
3606 end;
3607
3608
3609 procedure TUIRadioBox.setChecked (v: Boolean);
3610
3611   function resetGroup (ctl: TUIControl): Boolean;
3612   begin
3613     result := false;
3614     if (ctl <> self) and (ctl is TUIRadioBox) and (TUIRadioBox(ctl).mRadioGroup = mRadioGroup) then
3615     begin
3616       TUIRadioBox(ctl).mBoolVar^ := false;
3617     end;
3618   end;
3619
3620 begin
3621   mBoolVar^ := v;
3622   if v then topLevel.forEachControl(resetGroup);
3623 end;
3624
3625
3626 procedure TUIRadioBox.doAction ();
3627 begin
3628   if (assigned(actionCB)) then
3629   begin
3630     actionCB(self);
3631   end
3632   else
3633   begin
3634     setChecked(true);
3635   end;
3636 end;
3637
3638
3639 // ////////////////////////////////////////////////////////////////////////// //
3640 var
3641   oldFocus: procedure () = nil;
3642   oldBlur: procedure () = nil;
3643
3644 procedure onWinFocus (); begin uiFocus(); if (assigned(oldFocus)) then oldFocus(); end;
3645 procedure onWinBlur (); begin fuiResetKMState(true); uiBlur(); if (assigned(oldBlur)) then oldBlur(); end;
3646
3647 initialization
3648   registerCtlClass(TUIHBox, 'hbox');
3649   registerCtlClass(TUIVBox, 'vbox');
3650   registerCtlClass(TUISpan, 'span');
3651   registerCtlClass(TUILine, 'line');
3652   registerCtlClass(TUITextLabel, 'label');
3653   registerCtlClass(TUIStaticText, 'static');
3654   registerCtlClass(TUIButtonRound, 'round-button');
3655   registerCtlClass(TUIButton, 'button');
3656   registerCtlClass(TUICheckBox, 'checkbox');
3657   registerCtlClass(TUIRadioBox, 'radiobox');
3658
3659   oldFocus := winFocusCB;
3660   oldBlur := winBlurCB;
3661   winFocusCB := onWinFocus;
3662   winBlurCB := onWinBlur;
3663 end.