src/flexui/fui_ctls.pas

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