src/gx/gh_ui.pas

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