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