src/flexui/fui_ctls.pas

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