src/flexui/fui_ctls.pas

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