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