src/flexui/fui_ctls.pas

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