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
 120   public
 121     actionCB: TActionCB;
 122     closeRequestCB: TCloseRequestCB;
 123
 124   private
 125     mDefSize: TLaySize; // default size
 126     mMaxSize: TLaySize; // maximum size
 127     mFlex: Integer;
 128     mHoriz: Boolean;
 129     mHGroup: AnsiString;
 130     mVGroup: AnsiString;
 131     mAlign: Integer;
 132     mExpand: Boolean;
 133     mLayDefSize: TLaySize;
 134     mLayMaxSize: TLaySize;
 135     mFullSize: TLaySize;
 136     mNoPad: Boolean;
 137     mPadding: TLaySize;
 138
 139   public
 140     // layouter interface
 141     function getDefSize (): TLaySize; inline; // default size; <0: use max size
 142     //procedure setDefSize (const sz: TLaySize); inline; // default size; <0: use max size
 143     function getMargins (): TLayMargins; inline;
 144     function getPadding (): TLaySize; inline; // children padding (each non-first child will get this on left/top)
 145     function getMaxSize (): TLaySize; inline; // max size; <0: set to some huge value
 146     //procedure setMaxSize (const sz: TLaySize); inline; // max size; <0: set to some huge value
 147     function getFlex (): Integer; inline; // <=0: not flexible
 148     function isHorizBox (): Boolean; inline; // horizontal layout for children?
 149     function noPad (): Boolean; inline; // ignore padding in box direction for this control
 150     function getAlign (): Integer; inline; // aligning in non-main direction: <0: left/up; 0: center; >0: right/down
 151     function getExpand (): Boolean; inline; // expanding in non-main direction: `true` will ignore align and eat all available space
 152     function getHGroup (): AnsiString; inline; // empty: not grouped
 153     function getVGroup (): AnsiString; inline; // empty: not grouped
 154
 155     procedure setActualSizePos (constref apos: TLayPos; constref asize: TLaySize); inline;
 156
 157     procedure layPrepare (); virtual; // called before registering control in layouter
 158
 159   public
 160     property flex: Integer read mFlex write mFlex;
 161     property flDefaultSize: TLaySize read mDefSize write mDefSize;
 162     property flMaxSize: TLaySize read mMaxSize write mMaxSize;
 163     property flPadding: TLaySize read mPadding write mPadding;
 164     property flHoriz: Boolean read mHoriz write mHoriz;
 165     property flAlign: Integer read mAlign write mAlign;
 166     property flExpand: Boolean read mExpand write mExpand;
 167     property flHGroup: AnsiString read mHGroup write mHGroup;
 168     property flVGroup: AnsiString read mVGroup write mVGroup;
 169     property flNoPad: Boolean read mNoPad write mNoPad;
 170     property fullSize: TLaySize read mFullSize;
 171
 172   protected
 173     function parsePos (par: TTextParser): TLayPos;
 174     function parseSize (par: TTextParser): TLaySize;
 175     function parsePadding (par: TTextParser): TLaySize;
 176     function parseHPadding (par: TTextParser; def: Integer): TLaySize;
 177     function parseVPadding (par: TTextParser; def: Integer): TLaySize;
 178     function parseBool (par: TTextParser): Boolean;
 179     function parseAnyAlign (par: TTextParser): Integer;
 180     function parseHAlign (par: TTextParser): Integer;
 181     function parseVAlign (par: TTextParser): Integer;
 182     function parseOrientation (const prname: AnsiString; par: TTextParser): Boolean;
 183     procedure parseTextAlign (par: TTextParser; var h, v: Integer);
 184     procedure parseChildren (par: TTextParser); // par should be on '{'; final '}' is eaten
 185
 186   public
 187     // par is on property data
 188     // there may be more data in text stream, don't eat it!
 189     // return `true` if property name is valid and value was parsed
 190     // return `false` if property name is invalid; don't advance parser in this case
 191     // throw on property data errors
 192     function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; virtual;
 193
 194     // par should be on '{'; final '}' is eaten
 195     procedure parseProperties (par: TTextParser);
 196
 197   public
 198     constructor Create ();
 199     destructor Destroy (); override;
 200
 201     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 202
 203     // `sx` and `sy` are screen coordinates
 204     procedure drawControl (gx, gy: Integer); virtual;
 205
 206     // called after all children drawn
 207     procedure drawControlPost (gx, gy: Integer); virtual;
 208
 209     procedure draw (); virtual;
 210
 211     function topLevel (): TUIControl; inline;
 212
 213     // returns `true` if global coords are inside this control
 214     function toLocal (var x, y: Integer): Boolean;
 215     function toLocal (gx, gy: Integer; out x, y: Integer): Boolean; inline;
 216     procedure toGlobal (var x, y: Integer);
 217     procedure toGlobal (lx, ly: Integer; out x, y: Integer); inline;
 218
 219     procedure getDrawRect (out gx, gy, wdt, hgt: Integer);
 220
 221     // x and y are global coords
 222     function controlAtXY (x, y: Integer; allowDisabled: Boolean=false): TUIControl;
 223
 224     function parentScrollX (): Integer; inline;
 225     function parentScrollY (): Integer; inline;
 226
 227     procedure makeVisibleInParent ();
 228
 229     procedure doAction (); virtual; // so user controls can override it
 230
 231     procedure mouseEvent (var ev: THMouseEvent); virtual; // returns `true` if event was eaten
 232     procedure keyEvent (var ev: THKeyEvent); virtual; // returns `true` if event was eaten
 233     procedure keyEventPre (var ev: THKeyEvent); virtual; // will be called before dispatching the event
 234     procedure keyEventPost (var ev: THKeyEvent); virtual; // will be called after if nobody processed the event
 235
 236     function prevSibling (): TUIControl;
 237     function nextSibling (): TUIControl;
 238     function firstChild (): TUIControl; inline;
 239     function lastChild (): TUIControl; inline;
 240
 241     procedure appendChild (ctl: TUIControl); virtual;
 242
 243     function setActionCBFor (const aid: AnsiString; cb: TActionCB): TActionCB; // returns previous cb
 244
 245     function forEachChildren (cb: TCtlEnumCB): TUIControl; // doesn't recurse
 246     function forEachControl (cb: TCtlEnumCB; includeSelf: Boolean=true): TUIControl;
 247
 248     procedure close (); // this closes *top-level* control
 249
 250   public
 251     property id: AnsiString read mId write mId;
 252     property styleId: AnsiString read mStyleId;
 253     property scrollX: Integer read mScrollX write mScrollX;
 254     property scrollY: Integer read mScrollY write mScrollY;
 255     property x0: Integer read mX write mX;
 256     property y0: Integer read mY write mY;
 257     property width: Integer read mWidth write mWidth;
 258     property height: Integer read mHeight write mHeight;
 259     property enabled: Boolean read getEnabled write setEnabled;
 260     property parent: TUIControl read mParent;
 261     property focused: Boolean read getFocused write setFocused;
 262     property active: Boolean read getActive;
 263     property escClose: Boolean read mEscClose write mEscClose;
 264     property cancel: Boolean read mCancel write mCancel;
 265     property defctl: Boolean read mDefault write mDefault;
 266     property canFocus: Boolean read getCanFocus write mCanFocus;
 267     property ctlById[const aid: AnsiString]: TUIControl read findControlById; default;
 268   end;
 269
 270
 271   TUITopWindow = class(TUIControl)
 272   private
 273     type TXMode = (None, Drag, VScroll, HScroll);
 274
 275   private
 276     mTitle: AnsiString;
 277     mDragScroll: TXMode;
 278     mDragStartX, mDragStartY: Integer;
 279     mWaitingClose: Boolean;
 280     mInClose: Boolean;
 281     mFreeOnClose: Boolean; // default: false
 282     mDoCenter: Boolean; // after layouting
 283     mFitToScreen: Boolean;
 284
 285   protected
 286     procedure activated (); override;
 287     procedure blurred (); override;
 288
 289   public
 290     closeCB: TActionCB; // called after window was removed from ui window list
 291
 292   public
 293     constructor Create (const atitle: AnsiString);
 294
 295     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 296
 297     function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
 298
 299     procedure flFitToScreen (); // call this before layouting
 300
 301     procedure centerInScreen ();
 302
 303     // `sx` and `sy` are screen coordinates
 304     procedure drawControl (gx, gy: Integer); override;
 305     procedure drawControlPost (gx, gy: Integer); override;
 306
 307     procedure keyEvent (var ev: THKeyEvent); override; // returns `true` if event was eaten
 308     procedure mouseEvent (var ev: THMouseEvent); override; // returns `true` if event was eaten
 309
 310   public
 311     property freeOnClose: Boolean read mFreeOnClose write mFreeOnClose;
 312     property fitToScreen: Boolean read mFitToScreen write mFitToScreen;
 313   end;
 314
 315   // ////////////////////////////////////////////////////////////////////// //
 316   TUIBox = class(TUIControl)
 317   private
 318     mHasFrame: Boolean;
 319     mCaption: AnsiString;
 320     mHAlign: Integer; // -1: left; 0: center; 1: right; default: left
 321
 322   protected
 323     procedure setCaption (const acap: AnsiString);
 324     procedure setHasFrame (v: Boolean);
 325
 326   public
 327     constructor Create (ahoriz: Boolean);
 328
 329     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 330
 331     function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
 332
 333     procedure drawControl (gx, gy: Integer); override;
 334
 335     procedure mouseEvent (var ev: THMouseEvent); override;
 336     procedure keyEvent (var ev: THKeyEvent); override;
 337
 338   public
 339     property caption: AnsiString read mCaption write setCaption;
 340     property hasFrame: Boolean read mHasFrame write setHasFrame;
 341     property captionAlign: Integer read mHAlign write mHAlign;
 342   end;
 343
 344   TUIHBox = class(TUIBox)
 345   public
 346     constructor Create ();
 347
 348     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 349   end;
 350
 351   TUIVBox = class(TUIBox)
 352   public
 353     constructor Create ();
 354
 355     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 356   end;
 357
 358   // ////////////////////////////////////////////////////////////////////// //
 359   TUISpan = class(TUIControl)
 360   public
 361     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 362
 363     function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
 364
 365     procedure drawControl (gx, gy: Integer); 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: THMouseEvent); override;
 433     procedure keyEventPost (var ev: THKeyEvent); 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: THMouseEvent); override;
 465     procedure keyEvent (var ev: THKeyEvent); 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: THMouseEvent); override;
 505     procedure keyEvent (var ev: THKeyEvent); 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: THMouseEvent);
 544 procedure uiKeyEvent (var evt: THKeyEvent);
 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: THMouseEvent);
 740 var
 741   ev: THMouseEvent;
 742   f, c: Integer;
 743   lx, ly: Integer;
 744   ctmp: TUIControl;
 745 begin
 746   processKills();
 747   if (evt.eaten) or (evt.cancelled) 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 (not ev.eaten) and (not ev.cancelled) 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: THKeyEvent);
 791 var
 792   ev: THKeyEvent;
 793 begin
 794   processKills();
 795   if (evt.eaten) or (evt.cancelled) 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
1923
1924 // ////////////////////////////////////////////////////////////////////////// //
1925 procedure TUIControl.drawFrame (gx, gy, resx, thalign: Integer; const text: AnsiString; dbl: Boolean);
1926 var
1927   cidx, tx, tw: Integer;
1928 begin
1929   if (mFrameWidth < 1) or (mFrameHeight < 1) then exit;
1930   cidx := getColorIndex;
1931   uiContext.color := mFrameColor[cidx];
1932   case mFrameHeight of
1933     8:
1934       begin
1935         if dbl then
1936         begin
1937           uiContext.rect(gx+3, gy+3, mWidth-6, mHeight-6);
1938           uiContext.rect(gx+5, gy+5, mWidth-10, mHeight-10);
1939         end
1940         else
1941         begin
1942           uiContext.rect(gx+4, gy+4, mWidth-8, mHeight-8);
1943         end;
1944       end;
1945     14:
1946       begin
1947         if dbl then
1948         begin
1949           uiContext.rect(gx+3, gy+3+3, mWidth-6, mHeight-6-6);
1950           uiContext.rect(gx+5, gy+5+3, mWidth-10, mHeight-10-6);
1951         end
1952         else
1953         begin
1954           uiContext.rect(gx+4, gy+4+3, mWidth-8, mHeight-8-6);
1955         end;
1956       end;
1957     16:
1958       begin
1959         if dbl then
1960         begin
1961           uiContext.rect(gx+3, gy+3+4, mWidth-6, mHeight-6-8);
1962           uiContext.rect(gx+5, gy+5+4, mWidth-10, mHeight-10-8);
1963         end
1964         else
1965         begin
1966           uiContext.rect(gx+4, gy+4+4, mWidth-8, mHeight-8-8);
1967         end;
1968       end;
1969     else
1970       begin
1971         //TODO!
1972         if dbl then
1973         begin
1974         end
1975         else
1976         begin
1977         end;
1978       end;
1979   end;
1980
1981   // title
1982   if (Length(text) > 0) then
1983   begin
1984     if (resx < 0) then resx := 0;
1985     tw := uiContext.textWidth(text);
1986     setScissor(mFrameWidth+resx, 0, mWidth-mFrameWidth*2-resx, mFrameHeight);
1987          if (thalign < 0) then tx := gx+resx+mFrameWidth+2
1988     else if (thalign > 0) then tx := gx+mWidth-mFrameWidth-1-tw
1989     else tx := (gx+resx+mFrameWidth)+(mWidth-mFrameWidth*2-resx-tw) div 2;
1990     uiContext.color := mBackColor[cidx];
1991     uiContext.fillRect(tx-2, gy, tw+4, mFrameHeight);
1992     uiContext.color := mFrameTextColor[cidx];
1993     uiContext.drawText(tx, gy, text);
1994   end;
1995 end;
1996
1997
1998 procedure TUIControl.draw ();
1999 var
2000   f: Integer;
2001   gx, gy: Integer;
2002
2003   procedure resetScissor (fullArea: Boolean); inline;
2004   begin
2005     uiContext.clip := savedClip;
2006     if (fullArea) or ((mFrameWidth = 0) and (mFrameHeight = 0)) then
2007     begin
2008       setScissor(0, 0, mWidth, mHeight);
2009     end
2010     else
2011     begin
2012       //writeln('frm: (', mFrameWidth, 'x', mFrameHeight, ')');
2013       setScissor(mFrameWidth, mFrameHeight, mWidth-mFrameWidth*2, mHeight-mFrameHeight*2);
2014     end;
2015   end;
2016
2017 begin
2018   if (mWidth < 1) or (mHeight < 1) or (uiContext = nil) or (not uiContext.active) then exit;
2019   toGlobal(0, 0, gx, gy);
2020
2021   savedClip := uiContext.clip;
2022   try
2023     resetScissor(true); // full area
2024     drawControl(gx, gy);
2025     resetScissor(false); // client area
2026     for f := 0 to High(mChildren) do mChildren[f].draw();
2027     resetScissor(true); // full area
2028     if (self is TUISwitchBox) then
2029     begin
2030       uiContext.color := TGxRGBA.Create(255, 0, 0, 255);
2031       //uiContext.fillRect(gx, gy, mWidth, mHeight);
2032       //writeln('frm: (', mFrameWidth, 'x', mFrameHeight, '); sz=(', mWidth, 'x', mHeight, '); clip=', uiContext.clip.toString);
2033     end;
2034     if false and (mId = 'cbtest') then
2035     begin
2036       uiContext.color := TGxRGBA.Create(255, 127, 0, 96);
2037       uiContext.fillRect(gx, gy, mWidth, mHeight);
2038       if (mFrameWidth > 0) and (mFrameHeight > 0) then
2039       begin
2040         uiContext.color := TGxRGBA.Create(255, 255, 0, 96);
2041         uiContext.fillRect(gx+mFrameWidth, gy+mFrameHeight, mWidth-mFrameWidth*2, mHeight-mFrameHeight*2);
2042       end;
2043     end
2044     else if false and (self is TUISwitchBox) then
2045     begin
2046       uiContext.color := TGxRGBA.Create(255, 0, 0, 255);
2047       uiContext.fillRect(gx, gy, mWidth, mHeight);
2048       //writeln('frm: (', mFrameWidth, 'x', mFrameHeight, ')');
2049     end;
2050     drawControlPost(gx, gy);
2051   finally
2052     uiContext.clip := savedClip;
2053   end;
2054 end;
2055
2056 procedure TUIControl.drawControl (gx, gy: Integer);
2057 begin
2058   //if (mParent = nil) then darkenRect(gx, gy, mWidth, mHeight, 64);
2059 end;
2060
2061 procedure TUIControl.drawControlPost (gx, gy: Integer);
2062 begin
2063   // shadow
2064   if (mParent = nil) and (mDrawShadow) and (mWidth > 0) and (mHeight > 0) then
2065   begin
2066     //setScissorGLInternal(gx+8, gy+8, mWidth, mHeight);
2067     uiContext.resetClip();
2068     uiContext.darkenRect(gx+mWidth, gy+8, 8, mHeight, 128);
2069     uiContext.darkenRect(gx+8, gy+mHeight, mWidth-8, 8, 128);
2070   end;
2071 end;
2072
2073
2074 // ////////////////////////////////////////////////////////////////////////// //
2075 procedure TUIControl.mouseEvent (var ev: THMouseEvent);
2076 var
2077   ctl: TUIControl;
2078 begin
2079   if (not enabled) then exit;
2080   if (mWidth < 1) or (mHeight < 1) then exit;
2081   ctl := controlAtXY(ev.x, ev.y);
2082   if (ctl = nil) then exit;
2083   if (ctl.canFocus) and (ev.press) then
2084   begin
2085     if (ctl <> topLevel.mFocused) then ctl.setFocused(true);
2086     uiGrabCtl := ctl;
2087   end;
2088   if (ctl <> self) then ctl.mouseEvent(ev);
2089   //ev.eat();
2090 end;
2091
2092
2093 procedure TUIControl.keyEvent (var ev: THKeyEvent);
2094
2095   function doPreKey (ctl: TUIControl): Boolean;
2096   begin
2097     if (not ctl.enabled) then begin result := false; exit; end;
2098     ctl.keyEventPre(ev);
2099     result := (ev.eaten) or (ev.cancelled); // stop if event was consumed
2100   end;
2101
2102   function doPostKey (ctl: TUIControl): Boolean;
2103   begin
2104     if (not ctl.enabled) then begin result := false; exit; end;
2105     ctl.keyEventPost(ev);
2106     result := (ev.eaten) or (ev.cancelled); // stop if event was consumed
2107   end;
2108
2109 var
2110   ctl: TUIControl;
2111 begin
2112   if (not enabled) then exit;
2113   if (ev.eaten) or (ev.cancelled) then exit;
2114   // call pre-key
2115   if (mParent = nil) then
2116   begin
2117     forEachControl(doPreKey);
2118     if (ev.eaten) or (ev.cancelled) then exit;
2119   end;
2120   // focused control should process keyboard first
2121   if (topLevel.mFocused <> self) and isMyChild(topLevel.mFocused) and (topLevel.mFocused.enabled) then
2122   begin
2123     // bubble keyboard event
2124     ctl := topLevel.mFocused;
2125     while (ctl <> nil) and (ctl <> self) do
2126     begin
2127       ctl.keyEvent(ev);
2128       if (ev.eaten) or (ev.cancelled) then exit;
2129       ctl := ctl.mParent;
2130     end;
2131   end;
2132   // for top-level controls
2133   if (mParent = nil) then
2134   begin
2135     if (ev = 'S-Tab') then
2136     begin
2137       ctl := findPrevFocus(mFocused, true);
2138       if (ctl <> nil) and (ctl <> mFocused) then ctl.setFocused(true);
2139       ev.eat();
2140       exit;
2141     end;
2142     if (ev = 'Tab') then
2143     begin
2144       ctl := findNextFocus(mFocused, true);
2145       if (ctl <> nil) and (ctl <> mFocused) then ctl.setFocused(true);
2146       ev.eat();
2147       exit;
2148     end;
2149     if (ev = 'Enter') or (ev = 'C-Enter') then
2150     begin
2151       ctl := findDefaulControl();
2152       if (ctl <> nil) then
2153       begin
2154         ev.eat();
2155         ctl.doAction();
2156         exit;
2157       end;
2158     end;
2159     if (ev = 'Escape') then
2160     begin
2161       ctl := findCancelControl();
2162       if (ctl <> nil) then
2163       begin
2164         ev.eat();
2165         ctl.doAction();
2166         exit;
2167       end;
2168     end;
2169     if mEscClose and (ev = 'Escape') then
2170     begin
2171       if (not assigned(closeRequestCB)) or (closeRequestCB(self)) then
2172       begin
2173         uiRemoveWindow(self);
2174       end;
2175       ev.eat();
2176       exit;
2177     end;
2178     // call post-keys
2179     if (ev.eaten) or (ev.cancelled) then exit;
2180     forEachControl(doPostKey);
2181   end;
2182 end;
2183
2184
2185 procedure TUIControl.keyEventPre (var ev: THKeyEvent);
2186 begin
2187 end;
2188
2189
2190 procedure TUIControl.keyEventPost (var ev: THKeyEvent);
2191 begin
2192 end;
2193
2194
2195 // ////////////////////////////////////////////////////////////////////////// //
2196 constructor TUITopWindow.Create (const atitle: AnsiString);
2197 begin
2198   inherited Create();
2199   mTitle := atitle;
2200 end;
2201
2202
2203 procedure TUITopWindow.AfterConstruction ();
2204 begin
2205   inherited;
2206   mFitToScreen := true;
2207   mFrameWidth := 8;
2208   mFrameHeight := uiContext.charHeight(#184);
2209   if (mWidth < mFrameWidth*2+uiContext.iconWinWidth(TGxContext.TWinIcon.Close)) then mWidth := mFrameWidth*2+uiContext.iconWinWidth(TGxContext.TWinIcon.Close);
2210   if (mHeight < mFrameHeight*2) then mHeight := mFrameHeight*2;
2211   if (Length(mTitle) > 0) then
2212   begin
2213     if (mWidth < uiContext.textWidth(mTitle)+mFrameWidth*2+uiContext.iconWinWidth(TGxContext.TWinIcon.Close)) then
2214     begin
2215       mWidth := uiContext.textWidth(mTitle)+mFrameWidth*2+uiContext.iconWinWidth(TGxContext.TWinIcon.Close);
2216     end;
2217   end;
2218   mCanFocus := false;
2219   mDragScroll := TXMode.None;
2220   mDrawShadow := true;
2221   mWaitingClose := false;
2222   mInClose := false;
2223   closeCB := nil;
2224   mCtl4Style := 'window';
2225   mDefSize.w := nmax(1, mDefSize.w);
2226   mDefSize.h := nmax(1, mDefSize.h);
2227 end;
2228
2229
2230 function TUITopWindow.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
2231 begin
2232   if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) then
2233   begin
2234     mTitle := par.expectIdOrStr(true);
2235     result := true;
2236     exit;
2237   end;
2238   if (strEquCI1251(prname, 'children')) then
2239   begin
2240     parseChildren(par);
2241     result := true;
2242     exit;
2243   end;
2244   if (strEquCI1251(prname, 'position')) then
2245   begin
2246          if (par.eatIdOrStrCI('default')) then mDoCenter := false
2247     else if (par.eatIdOrStrCI('center')) then mDoCenter := true
2248     else par.error('`center` or `default` expected');
2249     result := true;
2250     exit;
2251   end;
2252   if (parseOrientation(prname, par)) then begin result := true; exit; end;
2253   result := inherited parseProperty(prname, par);
2254 end;
2255
2256
2257 procedure TUITopWindow.flFitToScreen ();
2258 var
2259   nsz: TLaySize;
2260 begin
2261   nsz := TLaySize.Create(trunc(fuiScrWdt/fuiRenderScale)-mFrameWidth*2-6, trunc(fuiScrHgt/fuiRenderScale)-mFrameHeight*2-6);
2262   if (mMaxSize.w < 1) then mMaxSize.w := nsz.w;
2263   if (mMaxSize.h < 1) then mMaxSize.h := nsz.h;
2264 end;
2265
2266
2267 procedure TUITopWindow.centerInScreen ();
2268 begin
2269   if (mWidth > 0) and (mHeight > 0) then
2270   begin
2271     mX := trunc((fuiScrWdt/fuiRenderScale-mWidth)/2);
2272     mY := trunc((fuiScrHgt/fuiRenderScale-mHeight)/2);
2273   end;
2274 end;
2275
2276
2277 procedure TUITopWindow.drawControl (gx, gy: Integer);
2278 begin
2279   uiContext.color := mBackColor[getColorIndex];
2280   uiContext.fillRect(gx, gy, mWidth, mHeight);
2281 end;
2282
2283 procedure TUITopWindow.drawControlPost (gx, gy: Integer);
2284 var
2285   cidx, iwdt, ihgt: Integer;
2286   ybot, xend, vhgt, vwdt: Integer;
2287 begin
2288   cidx := getColorIndex;
2289   iwdt := uiContext.iconWinWidth(TGxContext.TWinIcon.Close);
2290   if (mDragScroll = TXMode.Drag) then
2291   begin
2292     //uiContext.color := mFrameColor[cidx];
2293     drawFrame(gx, gy, iwdt, 0, mTitle, false);
2294   end
2295   else
2296   begin
2297     ihgt := uiContext.iconWinHeight(TGxContext.TWinIcon.Close);
2298     //uiContext.color := mFrameColor[cidx];
2299     drawFrame(gx, gy, iwdt, 0, mTitle, true);
2300     // vertical scroll bar
2301     vhgt := mHeight-mFrameHeight*2;
2302     if (mFullSize.h > vhgt) then
2303     begin
2304       ybot := mScrollY+vhgt;
2305       setScissor(0, 0, mWidth, mHeight);
2306       uiContext.drawVSBar(gx+mWidth-mFrameWidth+1, gy+mFrameHeight-1, mFrameWidth-3, vhgt+2, ybot, 0, mFullSize.h, mSBarFullColor[cidx], mSBarEmptyColor[cidx]);
2307     end;
2308     // horizontal scroll bar
2309     vwdt := mWidth-mFrameWidth*2;
2310     if (mFullSize.w > vwdt) then
2311     begin
2312       xend := mScrollX+vwdt;
2313       setScissor(0, 0, mWidth, mHeight);
2314       uiContext.drawHSBar(gx+mFrameWidth+1, gy+mHeight-mFrameHeight+1, vwdt-2, mFrameHeight-3, xend, 0, mFullSize.w, mSBarFullColor[cidx], mSBarEmptyColor[cidx]);
2315     end;
2316     // frame icon
2317     setScissor(mFrameWidth, 0, iwdt, ihgt);
2318     uiContext.color := mBackColor[cidx];
2319     uiContext.fillRect(gx+mFrameWidth, gy, iwdt, ihgt);
2320     uiContext.color := mFrameIconColor[cidx];
2321     uiContext.drawIconWin(TGxContext.TWinIcon.Close, gx+mFrameWidth, gy, mInClose);
2322   end;
2323   // shadow
2324   inherited drawControlPost(gx, gy);
2325 end;
2326
2327
2328 procedure TUITopWindow.activated ();
2329 begin
2330   if (mFocused = nil) or (mFocused = self) then
2331   begin
2332     mFocused := findFirstFocus();
2333   end;
2334   if (mFocused <> nil) and (mFocused <> self) then mFocused.activated();
2335   inherited;
2336 end;
2337
2338
2339 procedure TUITopWindow.blurred ();
2340 begin
2341   mDragScroll := TXMode.None;
2342   mWaitingClose := false;
2343   mInClose := false;
2344   if (mFocused <> nil) and (mFocused <> self) then mFocused.blurred();
2345   inherited;
2346 end;
2347
2348
2349 procedure TUITopWindow.keyEvent (var ev: THKeyEvent);
2350 begin
2351   inherited keyEvent(ev);
2352   if (ev.eaten) or (ev.cancelled) or (not enabled) {or (not getFocused)} then exit;
2353   if (ev = 'M-F3') then
2354   begin
2355     if (not assigned(closeRequestCB)) or (closeRequestCB(self)) then
2356     begin
2357       uiRemoveWindow(self);
2358     end;
2359     ev.eat();
2360     exit;
2361   end;
2362 end;
2363
2364
2365 procedure TUITopWindow.mouseEvent (var ev: THMouseEvent);
2366 var
2367   lx, ly: Integer;
2368   vhgt, ytop: Integer;
2369   vwdt, xend: Integer;
2370 begin
2371   if (not enabled) then exit;
2372   if (mWidth < 1) or (mHeight < 1) then exit;
2373
2374   if (mDragScroll = TXMode.Drag) then
2375   begin
2376     mX += ev.x-mDragStartX;
2377     mY += ev.y-mDragStartY;
2378     mDragStartX := ev.x;
2379     mDragStartY := ev.y;
2380     if (ev.release) and (ev.but = ev.Left) then mDragScroll := TXMode.None;
2381     ev.eat();
2382     exit;
2383   end;
2384
2385   if (mDragScroll = TXMode.VScroll) then
2386   begin
2387     ly := ev.y-mY;
2388     vhgt := mHeight-mFrameHeight*2;
2389     ytop := uiContext.sbarPos(ly, mFrameHeight-1, vhgt+2, 0, mFullSize.h)-vhgt;
2390     mScrollY := nmax(0, ytop);
2391     if (ev.release) and (ev.but = ev.Left) then mDragScroll := TXMode.None;
2392     ev.eat();
2393     exit;
2394   end;
2395
2396   if (mDragScroll = TXMode.HScroll) then
2397   begin
2398     lx := ev.x-mX;
2399     vwdt := mWidth-mFrameWidth*2;
2400     xend := uiContext.sbarPos(lx, mFrameWidth+1, vwdt-2, 0, mFullSize.w)-vwdt;
2401     mScrollX := nmax(0, xend);
2402     if (ev.release) and (ev.but = ev.Left) then mDragScroll := TXMode.None;
2403     ev.eat();
2404     exit;
2405   end;
2406
2407   if toLocal(ev.x, ev.y, lx, ly) then
2408   begin
2409     if (ev.press) then
2410     begin
2411       if (ly < mFrameHeight) then
2412       begin
2413         uiGrabCtl := self;
2414         if (lx >= mFrameWidth) and (lx < mFrameWidth+uiContext.iconWinWidth(TGxContext.TWinIcon.Close)) then
2415         begin
2416           //uiRemoveWindow(self);
2417           mWaitingClose := true;
2418           mInClose := true;
2419         end
2420         else
2421         begin
2422           mDragScroll := TXMode.Drag;
2423           mDragStartX := ev.x;
2424           mDragStartY := ev.y;
2425         end;
2426         ev.eat();
2427         exit;
2428       end;
2429       // check for vertical scrollbar
2430       if (lx >= mWidth-mFrameWidth+1) and (ly >= mFrameHeight-1) and (ly < mHeight-mFrameHeight+2) then
2431       begin
2432         vhgt := mHeight-mFrameHeight*2;
2433         if (mFullSize.h > vhgt) then
2434         begin
2435           uiGrabCtl := self;
2436           mDragScroll := TXMode.VScroll;
2437           ev.eat();
2438           ytop := uiContext.sbarPos(ly, mFrameHeight-1, vhgt+2, 0, mFullSize.h)-vhgt;
2439           mScrollY := nmax(0, ytop);
2440           exit;
2441         end;
2442       end;
2443       // check for horizontal scrollbar
2444       if (ly >= mHeight-mFrameHeight+1) and (lx >= mFrameWidth+1) and (lx < mWidth-mFrameWidth-1) then
2445       begin
2446         vwdt := mWidth-mFrameWidth*2;
2447         if (mFullSize.w > vwdt) then
2448         begin
2449           uiGrabCtl := self;
2450           mDragScroll := TXMode.HScroll;
2451           ev.eat();
2452           xend := uiContext.sbarPos(lx, mFrameWidth+1, vwdt-2, 0, mFullSize.w)-vwdt;
2453           mScrollX := nmax(0, xend);
2454           exit;
2455         end;
2456       end;
2457       // drag
2458       if (lx < mFrameWidth) or (lx >= mWidth-mFrameWidth) or (ly >= mHeight-mFrameHeight) then
2459       begin
2460         uiGrabCtl := self;
2461         mDragScroll := TXMode.Drag;
2462         mDragStartX := ev.x;
2463         mDragStartY := ev.y;
2464         ev.eat();
2465         exit;
2466       end;
2467     end;
2468
2469     if (ev.release) then
2470     begin
2471       if mWaitingClose then
2472       begin
2473         if (lx >= mFrameWidth) and (lx < mFrameWidth+uiContext.iconWinWidth(TGxContext.TWinIcon.Close)) then
2474         begin
2475           if (not assigned(closeRequestCB)) or (closeRequestCB(self)) then
2476           begin
2477             uiRemoveWindow(self);
2478           end;
2479         end;
2480         mWaitingClose := false;
2481         mInClose := false;
2482         ev.eat();
2483         exit;
2484       end;
2485     end;
2486
2487     if (ev.motion) then
2488     begin
2489       if mWaitingClose then
2490       begin
2491         mInClose := (lx >= mFrameWidth) and (lx < mFrameWidth+uiContext.iconWinWidth(TGxContext.TWinIcon.Close));
2492         ev.eat();
2493         exit;
2494       end;
2495     end;
2496
2497     inherited mouseEvent(ev);
2498   end
2499   else
2500   begin
2501     mInClose := false;
2502     if (not ev.motion) and (mWaitingClose) then begin ev.eat(); mWaitingClose := false; exit; end;
2503   end;
2504 end;
2505
2506
2507 // ////////////////////////////////////////////////////////////////////////// //
2508 constructor TUIBox.Create (ahoriz: Boolean);
2509 begin
2510   inherited Create();
2511   mHoriz := ahoriz;
2512 end;
2513
2514
2515 procedure TUIBox.AfterConstruction ();
2516 begin
2517   inherited;
2518   mCanFocus := false;
2519   mHAlign := -1; // left
2520   mCtl4Style := 'box';
2521   mDefSize := TLaySize.Create(-1, -1);
2522 end;
2523
2524
2525 procedure TUIBox.setCaption (const acap: AnsiString);
2526 begin
2527   mCaption := acap;
2528   mDefSize := TLaySize.Create(uiContext.textWidth(mCaption)+3, uiContext.textHeight(mCaption));
2529 end;
2530
2531
2532 procedure TUIBox.setHasFrame (v: Boolean);
2533 begin
2534   mHasFrame := v;
2535   if (mHasFrame) then begin mFrameWidth := 8; mFrameHeight := uiContext.charHeight(#184); end else begin mFrameWidth := 0; mFrameHeight := 0; end;
2536   if (mHasFrame) then mNoPad := true;
2537 end;
2538
2539
2540 function TUIBox.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
2541 begin
2542   if (parseOrientation(prname, par)) then begin result := true; exit; end;
2543   if (strEquCI1251(prname, 'padding')) then
2544   begin
2545     if (mHoriz) then mPadding := parseHPadding(par, 0) else mPadding := parseVPadding(par, 0);
2546     result := true;
2547     exit;
2548   end;
2549   if (strEquCI1251(prname, 'frame')) then
2550   begin
2551     setHasFrame(parseBool(par));
2552     result := true;
2553     exit;
2554   end;
2555   if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) then
2556   begin
2557     setCaption(par.expectIdOrStr(true));
2558     result := true;
2559     exit;
2560   end;
2561   if (strEquCI1251(prname, 'textalign')) or (strEquCI1251(prname, 'text-align')) then
2562   begin
2563     mHAlign := parseHAlign(par);
2564     result := true;
2565     exit;
2566   end;
2567   if (strEquCI1251(prname, 'children')) then
2568   begin
2569     parseChildren(par);
2570     result := true;
2571     exit;
2572   end;
2573   result := inherited parseProperty(prname, par);
2574 end;
2575
2576
2577 procedure TUIBox.drawControl (gx, gy: Integer);
2578 var
2579   cidx: Integer;
2580   xpos: Integer;
2581 begin
2582   cidx := getColorIndex;
2583   uiContext.color := mBackColor[cidx];
2584   uiContext.fillRect(gx, gy, mWidth, mHeight);
2585   if (mHasFrame) then
2586   begin
2587     // draw frame
2588     drawFrame(gx, gy, 0, -1, mCaption, false);
2589     //uiContext.color := mFrameColor[cidx];
2590     //uiContext.rect(gx+3, gy+3, mWidth-6, mHeight-6);
2591   end
2592   else if (Length(mCaption) > 0) then
2593   begin
2594     // draw caption
2595          if (mHAlign < 0) then xpos := 3
2596     else if (mHAlign > 0) then xpos := mWidth-mFrameWidth*2-uiContext.textWidth(mCaption)
2597     else xpos := (mWidth-mFrameWidth*2-uiContext.textWidth(mCaption)) div 2;
2598     xpos += gx+mFrameWidth;
2599
2600     setScissor(mFrameWidth+1, 0, mWidth-mFrameWidth-2, uiContext.textHeight(mCaption));
2601     {
2602     if (mHasFrame) then
2603     begin
2604       uiContext.color := mBackColor[cidx];
2605       uiContext.fillRect(xpos-3, gy, uiContext.textWidth(mCaption)+4, 8);
2606     end;
2607     }
2608     uiContext.color := mFrameTextColor[cidx];
2609     uiContext.drawText(xpos, gy, mCaption);
2610   end;
2611 end;
2612
2613
2614 procedure TUIBox.mouseEvent (var ev: THMouseEvent);
2615 var
2616   lx, ly: Integer;
2617 begin
2618   inherited mouseEvent(ev);
2619   if (not ev.eaten) and (not ev.cancelled) and (enabled) and toLocal(ev.x, ev.y, lx, ly) then
2620   begin
2621     ev.eat();
2622   end;
2623 end;
2624
2625
2626 procedure TUIBox.keyEvent (var ev: THKeyEvent);
2627 var
2628   dir: Integer = 0;
2629   cur, ctl: TUIControl;
2630 begin
2631   inherited keyEvent(ev);
2632   if (ev.eaten) or (ev.cancelled) or (not ev.press) or (not enabled) or (not getActive) then exit;
2633   if (Length(mChildren) = 0) then exit;
2634        if (mHoriz) and (ev = 'Left') then dir := -1
2635   else if (mHoriz) and (ev = 'Right') then dir := 1
2636   else if (not mHoriz) and (ev = 'Up') then dir := -1
2637   else if (not mHoriz) and (ev = 'Down') then dir := 1;
2638   if (dir = 0) then exit;
2639   ev.eat();
2640   cur := topLevel.mFocused;
2641   while (cur <> nil) and (cur.mParent <> self) do cur := cur.mParent;
2642   //if (cur = nil) then writeln('CUR: nil') else writeln('CUR: ', cur.className, '#', cur.id);
2643   if (dir < 0) then ctl := findPrevFocus(cur, true) else ctl := findNextFocus(cur, true);
2644   //if (ctl = nil) then writeln('CTL: nil') else writeln('CTL: ', ctl.className, '#', ctl.id);
2645   if (ctl <> nil) and (ctl <> self) then
2646   begin
2647     ctl.focused := true;
2648   end;
2649 end;
2650
2651
2652 // ////////////////////////////////////////////////////////////////////////// //
2653 constructor TUIHBox.Create ();
2654 begin
2655 end;
2656
2657
2658 procedure TUIHBox.AfterConstruction ();
2659 begin
2660   inherited;
2661   mHoriz := true;
2662 end;
2663
2664
2665 // ////////////////////////////////////////////////////////////////////////// //
2666 constructor TUIVBox.Create ();
2667 begin
2668 end;
2669
2670
2671 procedure TUIVBox.AfterConstruction ();
2672 begin
2673   inherited;
2674   mHoriz := false;
2675 end;
2676
2677
2678 // ////////////////////////////////////////////////////////////////////////// //
2679 procedure TUISpan.AfterConstruction ();
2680 begin
2681   inherited;
2682   mExpand := true;
2683   mCanFocus := false;
2684   mNoPad := true;
2685   mCtl4Style := 'span';
2686   mDefSize := TLaySize.Create(-1, -1);
2687 end;
2688
2689
2690 function TUISpan.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
2691 begin
2692   if (parseOrientation(prname, par)) then begin result := true; exit; end;
2693   result := inherited parseProperty(prname, par);
2694 end;
2695
2696
2697 procedure TUISpan.drawControl (gx, gy: Integer);
2698 begin
2699 end;
2700
2701
2702 // ////////////////////////////////////////////////////////////////////// //
2703 procedure TUILine.AfterConstruction ();
2704 begin
2705   inherited;
2706   mCanFocus := false;
2707   mExpand := true;
2708   mCanFocus := false;
2709   mCtl4Style := 'line';
2710   mDefSize := TLaySize.Create(-1, -1);
2711 end;
2712
2713
2714 function TUILine.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
2715 begin
2716   if (parseOrientation(prname, par)) then begin result := true; exit; end;
2717   result := inherited parseProperty(prname, par);
2718 end;
2719
2720
2721 procedure TUILine.layPrepare ();
2722 begin
2723   inherited layPrepare();
2724   if (mParent <> nil) then mHoriz := not mParent.mHoriz;
2725   if (mHoriz) then
2726   begin
2727     if (mLayDefSize.w < 0) then mLayDefSize.w := 1;
2728     if (mLayDefSize.h < 0) then mLayDefSize.h := 7;
2729   end
2730   else
2731   begin
2732     if (mLayDefSize.w < 0) then mLayDefSize.w := 7;
2733     if (mLayDefSize.h < 0) then mLayDefSize.h := 1;
2734   end;
2735 end;
2736
2737
2738 procedure TUILine.drawControl (gx, gy: Integer);
2739 var
2740   cidx: Integer;
2741 begin
2742   cidx := getColorIndex;
2743   uiContext.color := mTextColor[cidx];
2744   if mHoriz then uiContext.hline(gx, gy+(mHeight div 2), mWidth)
2745   else uiContext.vline(gx+(mWidth div 2), gy, mHeight);
2746 end;
2747
2748
2749 // ////////////////////////////////////////////////////////////////////////// //
2750 procedure TUIStaticText.AfterConstruction ();
2751 begin
2752   inherited;
2753   mCanFocus := false;
2754   mHAlign := -1;
2755   mVAlign := 0;
2756   mHoriz := true; // nobody cares
2757   mHeader := false;
2758   mLine := false;
2759   mCtl4Style := 'static';
2760 end;
2761
2762
2763 procedure TUIStaticText.setText (const atext: AnsiString);
2764 begin
2765   mText := atext;
2766   mDefSize := TLaySize.Create(uiContext.textWidth(mText), uiContext.textHeight(mText));
2767 end;
2768
2769
2770 function TUIStaticText.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
2771 begin
2772   if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) or (strEquCI1251(prname, 'text')) then
2773   begin
2774     setText(par.expectIdOrStr(true));
2775     result := true;
2776     exit;
2777   end;
2778   if (strEquCI1251(prname, 'textalign')) or (strEquCI1251(prname, 'text-align')) then
2779   begin
2780     parseTextAlign(par, mHAlign, mVAlign);
2781     result := true;
2782     exit;
2783   end;
2784   if (strEquCI1251(prname, 'header')) then
2785   begin
2786     mHeader := true;
2787     result := true;
2788     exit;
2789   end;
2790   if (strEquCI1251(prname, 'line')) then
2791   begin
2792     mLine := true;
2793     result := true;
2794     exit;
2795   end;
2796   result := inherited parseProperty(prname, par);
2797 end;
2798
2799
2800 procedure TUIStaticText.drawControl (gx, gy: Integer);
2801 var
2802   xpos, ypos: Integer;
2803   cidx: Integer;
2804 begin
2805   cidx := getColorIndex;
2806   uiContext.color := mBackColor[cidx];
2807   uiContext.fillRect(gx, gy, mWidth, mHeight);
2808
2809        if (mHAlign < 0) then xpos := 0
2810   else if (mHAlign > 0) then xpos := mWidth-uiContext.textWidth(mText)
2811   else xpos := (mWidth-uiContext.textWidth(mText)) div 2;
2812
2813   if (Length(mText) > 0) then
2814   begin
2815     if (mHeader) then uiContext.color := mFrameTextColor[cidx] else uiContext.color := mTextColor[cidx];
2816
2817          if (mVAlign < 0) then ypos := 0
2818     else if (mVAlign > 0) then ypos := mHeight-uiContext.textHeight(mText)
2819     else ypos := (mHeight-uiContext.textHeight(mText)) div 2;
2820
2821     uiContext.drawText(gx+xpos, gy+ypos, mText);
2822   end;
2823
2824   if (mLine) then
2825   begin
2826     if (mHeader) then uiContext.color := mFrameColor[cidx] else uiContext.color := mTextColor[cidx];
2827
2828          if (mVAlign < 0) then ypos := 0
2829     else if (mVAlign > 0) then ypos := mHeight-1
2830     else ypos := (mHeight div 2);
2831     ypos += gy;
2832
2833     if (Length(mText) = 0) then
2834     begin
2835       uiContext.hline(gx, ypos, mWidth);
2836     end
2837     else
2838     begin
2839       uiContext.hline(gx, ypos, xpos-1);
2840       uiContext.hline(gx+xpos+uiContext.textWidth(mText), ypos, mWidth);
2841     end;
2842   end;
2843 end;
2844
2845
2846 // ////////////////////////////////////////////////////////////////////////// //
2847 procedure TUITextLabel.AfterConstruction ();
2848 begin
2849   inherited;
2850   mHAlign := -1;
2851   mVAlign := 0;
2852   mCanFocus := false;
2853   mCtl4Style := 'label';
2854   mLinkId := '';
2855 end;
2856
2857
2858 procedure TUITextLabel.cacheStyle (root: TUIStyle);
2859 begin
2860   inherited cacheStyle(root);
2861   // active
2862   mHotColor[ClrIdxActive] := root.get('hot-color', 'active', mCtl4Style).asRGBADef(TGxRGBA.Create(0, 128, 0));
2863   // disabled
2864   mHotColor[ClrIdxDisabled] := root.get('hot-color', 'disabled', mCtl4Style).asRGBADef(TGxRGBA.Create(0, 64, 0));
2865   // inactive
2866   mHotColor[ClrIdxInactive] := root.get('hot-color', 'inactive', mCtl4Style).asRGBADef(TGxRGBA.Create(0, 64, 0));
2867 end;
2868
2869
2870 procedure TUITextLabel.setText (const s: AnsiString);
2871 var
2872   f: Integer;
2873 begin
2874   mText := '';
2875   mHotChar := #0;
2876   mHotOfs := 0;
2877   f := 1;
2878   while (f <= Length(s)) do
2879   begin
2880     if (s[f] = '\\') then
2881     begin
2882       Inc(f);
2883       if (f <= Length(s)) then mText += s[f];
2884       Inc(f);
2885     end
2886     else if (s[f] = '~') then
2887     begin
2888       Inc(f);
2889       if (f <= Length(s)) then
2890       begin
2891         if (mHotChar = #0) then
2892         begin
2893           mHotChar := s[f];
2894           mHotOfs := Length(mText);
2895         end;
2896         mText += s[f];
2897       end;
2898       Inc(f);
2899     end
2900     else
2901     begin
2902       mText += s[f];
2903       Inc(f);
2904     end;
2905   end;
2906   // fix hotchar offset
2907   if (mHotChar <> #0) and (mHotOfs > 0) then
2908   begin
2909     mHotOfs := uiContext.textWidth(Copy(mText, 1, mHotOfs+1))-uiContext.charWidth(mText[mHotOfs+1]);
2910   end;
2911   // fix size
2912   mDefSize := TLaySize.Create(uiContext.textWidth(mText), uiContext.textHeight(mText));
2913 end;
2914
2915
2916 function TUITextLabel.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
2917 begin
2918   if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) or (strEquCI1251(prname, 'text')) then
2919   begin
2920     setText(par.expectIdOrStr(true));
2921     result := true;
2922     exit;
2923   end;
2924   if (strEquCI1251(prname, 'link')) then
2925   begin
2926     mLinkId := par.expectIdOrStr(true);
2927     result := true;
2928     exit;
2929   end;
2930   if (strEquCI1251(prname, 'textalign')) or (strEquCI1251(prname, 'text-align')) then
2931   begin
2932     parseTextAlign(par, mHAlign, mVAlign);
2933     result := true;
2934     exit;
2935   end;
2936   result := inherited parseProperty(prname, par);
2937 end;
2938
2939
2940 procedure TUITextLabel.drawControl (gx, gy: Integer);
2941 var
2942   xpos, ypos: Integer;
2943   cidx: Integer;
2944 begin
2945   cidx := getColorIndex;
2946   uiContext.color := mBackColor[cidx];
2947   uiContext.fillRect(gx, gy, mWidth, mHeight);
2948   if (Length(mText) > 0) then
2949   begin
2950          if (mHAlign < 0) then xpos := 0
2951     else if (mHAlign > 0) then xpos := mWidth-uiContext.textWidth(mText)
2952     else xpos := (mWidth-uiContext.textWidth(mText)) div 2;
2953
2954          if (mVAlign < 0) then ypos := 0
2955     else if (mVAlign > 0) then ypos := mHeight-uiContext.textHeight(mText)
2956     else ypos := (mHeight-uiContext.textHeight(mText)) div 2;
2957
2958     uiContext.color := mTextColor[cidx];
2959     uiContext.drawText(gx+xpos, gy+ypos, mText);
2960
2961     if (Length(mLinkId) > 0) and (mHotChar <> #0) and (mHotChar <> ' ') then
2962     begin
2963       uiContext.color := mHotColor[cidx];
2964       uiContext.drawChar(gx+xpos+mHotOfs, gy+ypos, mHotChar);
2965     end;
2966   end;
2967 end;
2968
2969
2970 procedure TUITextLabel.mouseEvent (var ev: THMouseEvent);
2971 var
2972   lx, ly: Integer;
2973 begin
2974   inherited mouseEvent(ev);
2975   if (not ev.eaten) and (not ev.cancelled) and (enabled) and toLocal(ev.x, ev.y, lx, ly) then
2976   begin
2977     ev.eat();
2978   end;
2979 end;
2980
2981
2982 procedure TUITextLabel.doAction ();
2983 var
2984   ctl: TUIControl;
2985 begin
2986   if (assigned(actionCB)) then
2987   begin
2988     actionCB(self);
2989   end
2990   else
2991   begin
2992     ctl := topLevel[mLinkId];
2993     if (ctl <> nil) then
2994     begin
2995       if (ctl.canFocus) then ctl.focused := true;
2996     end;
2997   end;
2998 end;
2999
3000
3001 procedure TUITextLabel.keyEventPost (var ev: THKeyEvent);
3002 begin
3003   if (not enabled) then exit;
3004   if (mHotChar = #0) then exit;
3005   if (ev.eaten) or (ev.cancelled) or (not ev.press) then exit;
3006   if (ev.kstate <> ev.ModAlt) then exit;
3007   if (not ev.isHot(mHotChar)) then exit;
3008   ev.eat();
3009   if (canFocus) then focused := true;
3010   doAction();
3011 end;
3012
3013
3014 // ////////////////////////////////////////////////////////////////////////// //
3015 procedure TUIButton.AfterConstruction ();
3016 begin
3017   inherited;
3018   mHAlign := 0;
3019   mVAlign := 0;
3020   mShadowSize := 0;
3021   mCanFocus := true;
3022   mDefSize := TLaySize.Create(uiContext.textWidth(mText)+uiContext.textWidth('[  ]'), uiContext.textHeight(mText));
3023   mCtl4Style := 'button';
3024   mSkipLayPrepare := false;
3025   mAddMarkers := false;
3026   mHideMarkers := false;
3027 end;
3028
3029
3030 procedure TUIButton.cacheStyle (root: TUIStyle);
3031 var
3032   sz: Integer = 0;
3033 begin
3034   inherited cacheStyle(root);
3035   // shadow size
3036   sz := nmax(0, root.get('shadow-size', 'active', mCtl4Style).asInt(0));
3037   sz := nmax(sz, root.get('shadow-size', 'disabled', mCtl4Style).asInt(0));
3038   sz := nmax(sz, root.get('shadow-size', 'inactive', mCtl4Style).asInt(0));
3039   mShadowSize := sz;
3040   // markers mode
3041   mAddMarkers := root.get('add-markers', 'active', mCtl4Style).asBool(false);
3042   mAddMarkers := mAddMarkers or root.get('add-markers', 'disabled', mCtl4Style).asBool(false);
3043   mAddMarkers := mAddMarkers or root.get('add-markers', 'inactive', mCtl4Style).asBool(false);
3044   // hide markers?
3045   mHideMarkers := root.get('hide-markers', 'active', mCtl4Style).asBool(false);
3046   mHideMarkers := mHideMarkers or root.get('hide-markers', 'disabled', mCtl4Style).asBool(false);
3047   mHideMarkers := mHideMarkers or root.get('hide-markers', 'inactive', mCtl4Style).asBool(false);
3048 end;
3049
3050
3051 procedure TUIButton.setText (const s: AnsiString);
3052 begin
3053   inherited setText(s);
3054   if (mHideMarkers) then
3055   begin
3056     mDefSize := TLaySize.Create(uiContext.textWidth(mText)+10, uiContext.textHeight(mText));
3057   end
3058   else if (mAddMarkers) then
3059   begin
3060     mDefSize := TLaySize.Create(uiContext.textWidth(mText)+uiContext.textWidth('[<>]'), uiContext.textHeight(mText));
3061   end
3062   else
3063   begin
3064     mDefSize := TLaySize.Create(uiContext.textWidth(mText)+uiContext.textWidth('<>'), uiContext.textHeight(mText));
3065   end;
3066 end;
3067
3068
3069 procedure TUIButton.layPrepare ();
3070 var
3071   ods: TLaySize;
3072   ww: Integer;
3073 begin
3074   if (not mSkipLayPrepare) then
3075   begin
3076     ods := mDefSize;
3077     if (ods.w <> 0) or (ods.h <> 0) then
3078     begin
3079       mDefSize := TLaySize.Create(uiContext.textWidth(mText), uiContext.textHeight(mText));
3080       if (mHideMarkers) then
3081       begin
3082         ww := 10;
3083       end
3084       else if (mAddMarkers) then
3085       begin
3086              if (mDefault) then ww := uiContext.textWidth('[<  >]')
3087         else if (mCancel) then ww := uiContext.textWidth('[{  }]')
3088         else ww := uiContext.textWidth('[  ]');
3089       end
3090       else
3091       begin
3092         ww := nmax(0, uiContext.textWidth('<  >'));
3093         ww := nmax(ww, uiContext.textWidth('{  }'));
3094         ww := nmax(ww, uiContext.textWidth('[  ]'));
3095       end;
3096       mDefSize.w += ww+mShadowSize;
3097       mDefSize.h += mShadowSize;
3098     end;
3099   end
3100   else
3101   begin
3102     ods := TLaySize.Create(0, 0); // fpc is dumb!
3103   end;
3104   inherited layPrepare();
3105   if (not mSkipLayPrepare) then mDefSize := ods;
3106 end;
3107
3108
3109 procedure TUIButton.blurred ();
3110 begin
3111   mPushed := false;
3112 end;
3113
3114
3115 procedure TUIButton.drawControl (gx, gy: Integer);
3116 var
3117   wdt, hgt: Integer;
3118   xpos, ypos, xofsl, xofsr{, sofs}: Integer;
3119   cidx: Integer;
3120   lch, rch: AnsiChar;
3121   lstr, rstr: AnsiString;
3122 begin
3123   cidx := getColorIndex;
3124
3125   wdt := mWidth-mShadowSize;
3126   hgt := mHeight-mShadowSize;
3127   if (mPushed) {or (cidx = ClrIdxActive)} then
3128   begin
3129     //sofs := mShadowSize;
3130     gx += mShadowSize;
3131     gy += mShadowSize;
3132   end
3133   else
3134   begin
3135     //sofs := 0;
3136     if (mShadowSize > 0) then
3137     begin
3138       uiContext.darkenRect(gx+mShadowSize, gy+hgt, wdt, mShadowSize, 96);
3139       uiContext.darkenRect(gx+wdt, gy+mShadowSize, mShadowSize, hgt-mShadowSize, 96);
3140     end;
3141   end;
3142
3143   uiContext.color := mBackColor[cidx];
3144   //setScissor(sofs, sofs, wdt, hgt);
3145   uiContext.fillRect(gx, gy, wdt, hgt);
3146
3147        if (mVAlign < 0) then ypos := 0
3148   else if (mVAlign > 0) then ypos := hgt-uiContext.textHeight(mText)
3149   else ypos := (hgt-uiContext.textHeight(mText)) div 2;
3150   ypos += gy;
3151
3152   uiContext.color := mTextColor[cidx];
3153
3154   if (mHideMarkers) then
3155   begin
3156     xofsl := 5;
3157     xofsr := 5;
3158   end
3159   else
3160   begin
3161     if (mAddMarkers) then
3162     begin
3163            if (mDefault) then begin lstr := '[< '; rstr := ' >]'; end
3164       else if (mCancel) then begin lstr := '[{ '; rstr := ' }]'; end
3165       else begin lstr := '[ '; rstr := ' ]'; end;
3166       xofsl := uiContext.textWidth(lstr);
3167       xofsr := uiContext.textWidth(rstr);
3168       uiContext.drawText(gx, ypos, lstr);
3169       uiContext.drawText(gx+wdt-uiContext.textWidth(rstr), ypos, rstr);
3170     end
3171     else
3172     begin
3173       xofsl := nmax(0, uiContext.textWidth('< '));
3174       xofsl := nmax(xofsl, uiContext.textWidth('{ '));
3175       xofsl := nmax(xofsl, uiContext.textWidth('[ '));
3176       xofsr := nmax(0, uiContext.textWidth(' >'));
3177       xofsr := nmax(xofsr, uiContext.textWidth(' }'));
3178       xofsr := nmax(xofsr, uiContext.textWidth(' ]'));
3179            if (mDefault) then begin lch := '<'; rch := '>'; end
3180       else if (mCancel) then begin lch := '{'; rch := '}'; end
3181       else begin lch := '['; rch := ']'; end;
3182       uiContext.drawChar(gx, ypos, lch);
3183       uiContext.drawChar(gx+wdt-uiContext.charWidth(rch), ypos, rch);
3184     end;
3185   end;
3186
3187   if (Length(mText) > 0) then
3188   begin
3189     if (mHAlign < 0) then xpos := 0
3190     else begin xpos := wdt-xofsl-xofsr-uiContext.textWidth(mText); if (mHAlign = 0) then xpos := xpos div 2; end;
3191     xpos += xofsl;
3192
3193     //setScissor(xofsl+sofs, sofs, wdt-xofsl-xofsr, hgt);
3194     uiContext.drawText(gx+xpos, ypos, mText);
3195
3196     if (mHotChar <> #0) and (mHotChar <> ' ') then
3197     begin
3198       uiContext.color := mHotColor[cidx];
3199       uiContext.drawChar(gx+xpos+mHotOfs, ypos, mHotChar);
3200     end;
3201   end;
3202 end;
3203
3204
3205 procedure TUIButton.mouseEvent (var ev: THMouseEvent);
3206 var
3207   lx, ly: Integer;
3208 begin
3209   inherited mouseEvent(ev);
3210   if (uiGrabCtl = self) then
3211   begin
3212     ev.eat();
3213     mPushed := toLocal(ev.x, ev.y, lx, ly);
3214     if (ev = '-lmb') and focused and mPushed then
3215     begin
3216       mPushed := false;
3217       doAction();
3218     end;
3219     exit;
3220   end;
3221   if (ev.eaten) or (ev.cancelled) or (not enabled) or not focused then exit;
3222   mPushed := true;
3223   ev.eat();
3224 end;
3225
3226
3227 procedure TUIButton.keyEvent (var ev: THKeyEvent);
3228 begin
3229   inherited keyEvent(ev);
3230   if (not ev.eaten) and (not ev.cancelled) and (enabled) then
3231   begin
3232     if (ev = '+Enter') or (ev = '+Space') then
3233     begin
3234       focused := true;
3235       mPushed := true;
3236       ev.eat();
3237       exit;
3238     end;
3239     if (focused) and ((ev = '-Enter') or (ev = '-Space')) then
3240     begin
3241       if (mPushed) then
3242       begin
3243         mPushed := false;
3244         ev.eat();
3245         doAction();
3246       end
3247       else
3248       begin
3249         ev.eat();
3250       end;
3251       exit;
3252     end;
3253   end;
3254 end;
3255
3256
3257 // ////////////////////////////////////////////////////////////////////////// //
3258 procedure TUIButtonRound.AfterConstruction ();
3259 begin
3260   inherited;
3261   mHAlign := -1;
3262   mVAlign := 0;
3263   mCanFocus := true;
3264   mDefSize := TLaySize.Create(uiContext.textWidth(mText)+8*2, uiContext.textHeight(mText)+2);
3265   mCtl4Style := 'button-round';
3266   mSkipLayPrepare := true;
3267 end;
3268
3269
3270 procedure TUIButtonRound.setText (const s: AnsiString);
3271 begin
3272   inherited setText(s);
3273   mDefSize := TLaySize.Create(uiContext.textWidth(mText)+8*2, uiContext.textHeight(mText)+2);
3274 end;
3275
3276
3277 procedure TUIButtonRound.layPrepare ();
3278 var
3279   ods: TLaySize;
3280 begin
3281   ods := mDefSize;
3282   if (ods.w <> 0) or (ods.h <> 0) then
3283   begin
3284     mDefSize := TLaySize.Create(uiContext.textWidth(mText)+8*2, uiContext.textHeight(mText)+2);
3285   end;
3286   inherited layPrepare();
3287   mDefSize := ods;
3288 end;
3289
3290
3291 procedure TUIButtonRound.drawControl (gx, gy: Integer);
3292 var
3293   xpos, ypos: Integer;
3294   cidx: Integer;
3295 begin
3296   cidx := getColorIndex;
3297
3298   uiContext.color := mBackColor[cidx];
3299   uiContext.fillRect(gx+1, gy, mWidth-2, mHeight);
3300   uiContext.fillRect(gx, gy+1, 1, mHeight-2);
3301   uiContext.fillRect(gx+mWidth-1, gy+1, 1, mHeight-2);
3302
3303   if (Length(mText) > 0) then
3304   begin
3305          if (mHAlign < 0) then xpos := 0
3306     else if (mHAlign > 0) then xpos := mWidth-uiContext.textWidth(mText)
3307     else xpos := (mWidth-uiContext.textWidth(mText)) div 2;
3308
3309          if (mVAlign < 0) then ypos := 0
3310     else if (mVAlign > 0) then ypos := mHeight-uiContext.textHeight(mText)
3311     else ypos := (mHeight-uiContext.textHeight(mText)) div 2;
3312
3313     setScissor(8, 0, mWidth-16, mHeight);
3314     uiContext.color := mTextColor[cidx];
3315     uiContext.drawText(gx+xpos+8, gy+ypos, mText);
3316
3317     if (mHotChar <> #0) and (mHotChar <> ' ') then
3318     begin
3319       uiContext.color := mHotColor[cidx];
3320       uiContext.drawChar(gx+xpos+8+mHotOfs, gy+ypos, mHotChar);
3321     end;
3322   end;
3323 end;
3324
3325
3326 // ////////////////////////////////////////////////////////////////////////// //
3327 procedure TUISwitchBox.AfterConstruction ();
3328 begin
3329   inherited;
3330   mHAlign := -1;
3331   mVAlign := 0;
3332   mCanFocus := true;
3333   mIcon := TGxContext.TMarkIcon.Checkbox;
3334   mDefSize := TLaySize.Create(uiContext.textWidth(mText)+3+uiContext.iconMarkWidth(mIcon), nmax(uiContext.iconMarkHeight(mIcon), uiContext.textHeight(mText)));
3335   mCtl4Style := 'switchbox';
3336   mChecked := false;
3337   mBoolVar := @mChecked;
3338 end;
3339
3340
3341 procedure TUISwitchBox.cacheStyle (root: TUIStyle);
3342 begin
3343   inherited cacheStyle(root);
3344   // active
3345   mSwitchColor[ClrIdxActive] := root.get('switch-color', 'active', mCtl4Style).asRGBADef(TGxRGBA.Create(255, 255, 255));
3346   // disabled
3347   mSwitchColor[ClrIdxDisabled] := root.get('switch-color', 'disabled', mCtl4Style).asRGBADef(TGxRGBA.Create(255, 255, 255));
3348   // inactive
3349   mSwitchColor[ClrIdxInactive] := root.get('switch-color', 'inactive', mCtl4Style).asRGBADef(TGxRGBA.Create(255, 255, 255));
3350 end;
3351
3352
3353 procedure TUISwitchBox.setText (const s: AnsiString);
3354 begin
3355   inherited setText(s);
3356   mDefSize := TLaySize.Create(uiContext.textWidth(mText)+3+uiContext.iconMarkWidth(mIcon), nmax(uiContext.iconMarkHeight(mIcon), uiContext.textHeight(mText)));
3357 end;
3358
3359
3360 function TUISwitchBox.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
3361 begin
3362   if (strEquCI1251(prname, 'checked')) then
3363   begin
3364     result := true;
3365     setChecked(true);
3366     exit;
3367   end;
3368   result := inherited parseProperty(prname, par);
3369 end;
3370
3371
3372 function TUISwitchBox.getChecked (): Boolean;
3373 begin
3374   if (mBoolVar <> nil) then result := mBoolVar^ else result := false;
3375 end;
3376
3377
3378 procedure TUISwitchBox.setVar (pvar: PBoolean);
3379 begin
3380   if (pvar = nil) then pvar := @mChecked;
3381   if (pvar <> mBoolVar) then
3382   begin
3383     mBoolVar := pvar;
3384     setChecked(mBoolVar^);
3385   end;
3386 end;
3387
3388
3389 procedure TUISwitchBox.drawControl (gx, gy: Integer);
3390 var
3391   xpos, ypos, iwdt, dy: Integer;
3392   cidx: Integer;
3393 begin
3394   cidx := getColorIndex;
3395
3396   iwdt := uiContext.iconMarkWidth(mIcon);
3397        if (mHAlign < 0) then xpos := 0
3398   else if (mHAlign > 0) then xpos := mWidth-(uiContext.textWidth(mText)+3+iwdt)
3399   else xpos := (mWidth-(uiContext.textWidth(mText)+3+iwdt)) div 2;
3400
3401        if (mVAlign < 0) then ypos := 0
3402   else if (mVAlign > 0) then ypos := mHeight-uiContext.textHeight(mText)
3403   else ypos := (mHeight-uiContext.textHeight(mText)) div 2;
3404
3405   uiContext.color := mBackColor[cidx];
3406   uiContext.fillRect(gx, gy, mWidth, mHeight);
3407
3408   uiContext.color := mSwitchColor[cidx];
3409   if (uiContext.iconMarkHeight(mIcon) < uiContext.textHeight(mText)) then
3410   begin
3411     case uiContext.textHeight(mText) of
3412       14: dy := 2;
3413       16: dy := 3;
3414       else dy := 1;
3415     end;
3416     uiContext.drawIconMark(mIcon, gx, gy+ypos+uiContext.textHeight(mText)-uiContext.iconMarkHeight(mIcon)-dy, checked);
3417   end
3418   else
3419   begin
3420     uiContext.drawIconMark(mIcon, gx, gy, checked);
3421   end;
3422
3423   uiContext.color := mTextColor[cidx];
3424   uiContext.drawText(gx+xpos+3+iwdt, gy+ypos, mText);
3425
3426   if (mHotChar <> #0) and (mHotChar <> ' ') then
3427   begin
3428     uiContext.color := mHotColor[cidx];
3429     uiContext.drawChar(gx+xpos+3+iwdt+mHotOfs, gy+ypos, mHotChar);
3430   end;
3431 end;
3432
3433
3434 procedure TUISwitchBox.mouseEvent (var ev: THMouseEvent);
3435 var
3436   lx, ly: Integer;
3437 begin
3438   inherited mouseEvent(ev);
3439   if (uiGrabCtl = self) then
3440   begin
3441     ev.eat();
3442     if (ev = '-lmb') and focused and toLocal(ev.x, ev.y, lx, ly) then
3443     begin
3444       doAction();
3445     end;
3446     exit;
3447   end;
3448   if (ev.eaten) or (ev.cancelled) or (not enabled) or not focused then exit;
3449   ev.eat();
3450 end;
3451
3452
3453 procedure TUISwitchBox.keyEvent (var ev: THKeyEvent);
3454 begin
3455   inherited keyEvent(ev);
3456   if (not ev.eaten) and (not ev.cancelled) and (enabled) then
3457   begin
3458     if (ev = 'Space') then
3459     begin
3460       ev.eat();
3461       doAction();
3462       exit;
3463     end;
3464   end;
3465 end;
3466
3467
3468 // ////////////////////////////////////////////////////////////////////////// //
3469 procedure TUICheckBox.AfterConstruction ();
3470 begin
3471   inherited;
3472   mChecked := false;
3473   mBoolVar := @mChecked;
3474   mIcon := TGxContext.TMarkIcon.Checkbox;
3475   setText('');
3476 end;
3477
3478
3479 procedure TUICheckBox.setChecked (v: Boolean);
3480 begin
3481   mBoolVar^ := v;
3482 end;
3483
3484
3485 procedure TUICheckBox.doAction ();
3486 begin
3487   if (assigned(actionCB)) then
3488   begin
3489     actionCB(self);
3490   end
3491   else
3492   begin
3493     setChecked(not getChecked);
3494   end;
3495 end;
3496
3497
3498 // ////////////////////////////////////////////////////////////////////////// //
3499 procedure TUIRadioBox.AfterConstruction ();
3500 begin
3501   inherited;
3502   mChecked := false;
3503   mBoolVar := @mChecked;
3504   mRadioGroup := '';
3505   mIcon := TGxContext.TMarkIcon.Radiobox;
3506   setText('');
3507 end;
3508
3509
3510 function TUIRadioBox.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
3511 begin
3512   if (strEquCI1251(prname, 'group')) then
3513   begin
3514     mRadioGroup := par.expectIdOrStr(true);
3515     if (getChecked) then setChecked(true);
3516     result := true;
3517     exit;
3518   end;
3519   if (strEquCI1251(prname, 'checked')) then
3520   begin
3521     result := true;
3522     setChecked(true);
3523     exit;
3524   end;
3525   result := inherited parseProperty(prname, par);
3526 end;
3527
3528
3529 procedure TUIRadioBox.setChecked (v: Boolean);
3530
3531   function resetGroup (ctl: TUIControl): Boolean;
3532   begin
3533     result := false;
3534     if (ctl <> self) and (ctl is TUIRadioBox) and (TUIRadioBox(ctl).mRadioGroup = mRadioGroup) then
3535     begin
3536       TUIRadioBox(ctl).mBoolVar^ := false;
3537     end;
3538   end;
3539
3540 begin
3541   mBoolVar^ := v;
3542   if v then topLevel.forEachControl(resetGroup);
3543 end;
3544
3545
3546 procedure TUIRadioBox.doAction ();
3547 begin
3548   if (assigned(actionCB)) then
3549   begin
3550     actionCB(self);
3551   end
3552   else
3553   begin
3554     setChecked(true);
3555   end;
3556 end;
3557
3558
3559 // ////////////////////////////////////////////////////////////////////////// //
3560 var
3561   oldFocus: procedure () = nil;
3562   oldBlur: procedure () = nil;
3563
3564 procedure onWinFocus (); begin uiFocus(); if (assigned(oldFocus)) then oldFocus(); end;
3565 procedure onWinBlur (); begin fuiResetKMState(true); uiBlur(); if (assigned(oldBlur)) then oldBlur(); end;
3566
3567 initialization
3568   registerCtlClass(TUIHBox, 'hbox');
3569   registerCtlClass(TUIVBox, 'vbox');
3570   registerCtlClass(TUISpan, 'span');
3571   registerCtlClass(TUILine, 'line');
3572   registerCtlClass(TUITextLabel, 'label');
3573   registerCtlClass(TUIStaticText, 'static');
3574   registerCtlClass(TUIButtonRound, 'round-button');
3575   registerCtlClass(TUIButton, 'button');
3576   registerCtlClass(TUICheckBox, 'checkbox');
3577   registerCtlClass(TUIRadioBox, 'radiobox');
3578
3579   oldFocus := winFocusCB;
3580   oldBlur := winBlurCB;
3581   winFocusCB := onWinFocus;
3582   winBlurCB := onWinBlur;
3583 end.