src/flexui/fui_ctls.pas

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