src/flexui/fui_ctls.pas

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