src/gx/gh_ui.pas

   1 (* Copyright (C)  DooM 2D:Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, either version 3 of the License, or
   6  * (at your option) any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 {$INCLUDE ../shared/a_modes.inc}
  17 {$M+}
  18 unit gh_ui;
  19
  20 interface
  21
  22 uses
  23   SysUtils, Classes,
  24   GL, GLExt, SDL2,
  25   gh_ui_common,
  26   sdlcarcass, glgfx,
  27   xparser;
  28
  29
  30 // ////////////////////////////////////////////////////////////////////////// //
  31 type
  32   THControlClass = class of THControl;
  33
  34   THControl = class
  35   public
  36     type TActionCB = procedure (me: THControl; uinfo: Integer);
  37
  38   private
  39     mParent: THControl;
  40     mId: AnsiString;
  41     mX, mY: Integer;
  42     mWidth, mHeight: Integer;
  43     mFrameWidth, mFrameHeight: Integer;
  44     mEnabled: Boolean;
  45     mCanFocus: Boolean;
  46     mChildren: array of THControl;
  47     mFocused: THControl; // valid only for top-level controls
  48     mGrab: THControl; // valid only for top-level controls
  49     mEscClose: Boolean; // valid only for top-level controls
  50     mEatKeys: Boolean;
  51     mDrawShadow: Boolean;
  52
  53   private
  54     scis: TScissorSave;
  55     scallowed: Boolean;
  56
  57   protected
  58     function getEnabled (): Boolean;
  59     procedure setEnabled (v: Boolean); inline;
  60
  61     function getFocused (): Boolean; inline;
  62     procedure setFocused (v: Boolean); inline;
  63
  64     function isMyChild (ctl: THControl): Boolean;
  65
  66     function findFirstFocus (): THControl;
  67     function findLastFocus (): THControl;
  68
  69     function findNextFocus (cur: THControl): THControl;
  70     function findPrevFocus (cur: THControl): THControl;
  71
  72     procedure activated (); virtual;
  73     procedure blurred (); virtual;
  74
  75     //WARNING! do not call scissor functions outside `.draw*()` API!
  76     // set scissor to this rect (in local coords)
  77     procedure setScissor (lx, ly, lw, lh: Integer);
  78     // reset scissor to whole control
  79     procedure resetScissor (fullArea: Boolean); inline; // "full area" means "with frame"
  80
  81     // DO NOT USE!
  82     // set scissor to this rect (in global coords)
  83     procedure setScissorGLInternal (x, y, w, h: Integer);
  84
  85   public
  86     actionCB: TActionCB;
  87
  88   private
  89     mDefSize: TLaySize; // default size
  90     mMaxSize: TLaySize; // maximum size
  91     mFlex: Integer;
  92     mHoriz: Boolean;
  93     mCanWrap: Boolean;
  94     mLineStart: Boolean;
  95     mHGroup: AnsiString;
  96     mVGroup: AnsiString;
  97     mAlign: Integer;
  98     mExpand: Boolean;
  99     mLayDefSize: TLaySize;
 100     mLayMaxSize: TLaySize;
 101
 102   public
 103     // layouter interface
 104     function getDefSize (): TLaySize; inline; // default size; <0: use max size
 105     //procedure setDefSize (const sz: TLaySize); inline; // default size; <0: use max size
 106     function getMargins (): TLayMargins; inline;
 107     function getMaxSize (): TLaySize; inline; // max size; <0: set to some huge value
 108     //procedure setMaxSize (const sz: TLaySize); inline; // max size; <0: set to some huge value
 109     function getFlex (): Integer; inline; // <=0: not flexible
 110     function isHorizBox (): Boolean; inline; // horizontal layout for children?
 111     procedure setHorizBox (v: Boolean); inline; // horizontal layout for children?
 112     function canWrap (): Boolean; inline; // for horizontal boxes: can wrap children? for child: `false` means 'nonbreakable at *next* ctl'
 113     procedure setCanWrap (v: Boolean); inline; // for horizontal boxes: can wrap children? for child: `false` means 'nonbreakable at *next* ctl'
 114     function isLineStart (): Boolean; inline; // `true` if this ctl should start a new line; ignored for vertical boxes
 115     procedure setLineStart (v: Boolean); inline; // `true` if this ctl should start a new line; ignored for vertical boxes
 116     function getAlign (): Integer; inline; // aligning in non-main direction: <0: left/up; 0: center; >0: right/down
 117     procedure setAlign (v: Integer); inline; // aligning in non-main direction: <0: left/up; 0: center; >0: right/down
 118     function getExpand (): Boolean; inline; // expanding in non-main direction: `true` will ignore align and eat all available space
 119     procedure setExpand (v: Boolean); inline; // expanding in non-main direction: `true` will ignore align and eat all available space
 120     function getHGroup (): AnsiString; inline; // empty: not grouped
 121     procedure setHGroup (const v: AnsiString); inline; // empty: not grouped
 122     function getVGroup (): AnsiString; inline; // empty: not grouped
 123     procedure setVGroup (const v: AnsiString); inline; // empty: not grouped
 124
 125     procedure setActualSizePos (constref apos: TLayPos; constref asize: TLaySize); inline;
 126
 127     procedure layPrepare (); virtual; // called before registering control in layouter
 128
 129   public
 130     property flex: Integer read mFlex write mFlex;
 131     property flDefaultSize: TLaySize read mDefSize write mDefSize;
 132     property flMaxSize: TLaySize read mMaxSize write mMaxSize;
 133     property flHoriz: Boolean read isHorizBox write setHorizBox;
 134     property flCanWrap: Boolean read canWrap write setCanWrap;
 135     property flLineStart: Boolean read isLineStart write setLineStart;
 136     property flAlign: Integer read getAlign write setAlign;
 137     property flExpand: Boolean read getExpand write setExpand;
 138     property flHGroup: AnsiString read getHGroup write setHGroup;
 139     property flVGroup: AnsiString read getVGroup write setVGroup;
 140
 141   protected
 142     function parsePos (par: TTextParser): TLayPos;
 143     function parseSize (par: TTextParser): TLaySize;
 144     function parseBool (par: TTextParser): Boolean;
 145     function parseAnyAlign (par: TTextParser): Integer;
 146     function parseHAlign (par: TTextParser): Integer;
 147     function parseVAlign (par: TTextParser): Integer;
 148     function parseOrientation (const prname: AnsiString; par: TTextParser): Boolean;
 149     procedure parseTextAlign (par: TTextParser; var h, v: Integer);
 150     procedure parseChildren (par: TTextParser); // par should be on '{'; final '}' is eaten
 151
 152   public
 153     // par is on property data
 154     // there may be more data in text stream, don't eat it!
 155     // return `true` if property name is valid and value was parsed
 156     // return `false` if property name is invalid; don't advance parser in this case
 157     // throw on property data errors
 158     function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; virtual;
 159
 160     // par should be on '{'; final '}' is eaten
 161     procedure parseProperties (par: TTextParser);
 162
 163   public
 164     constructor Create ();
 165     constructor Create (ax, ay, aw, ah: Integer);
 166     destructor Destroy (); override;
 167
 168     // `sx` and `sy` are screen coordinates
 169     procedure drawControl (gx, gy: Integer); virtual;
 170
 171     // called after all children drawn
 172     procedure drawControlPost (gx, gy: Integer); virtual;
 173
 174     procedure draw (); virtual;
 175
 176     function topLevel (): THControl; inline;
 177
 178     // returns `true` if global coords are inside this control
 179     function toLocal (var x, y: Integer): Boolean;
 180     function toLocal (gx, gy: Integer; out x, y: Integer): Boolean; inline;
 181     procedure toGlobal (var x, y: Integer);
 182     procedure toGlobal (lx, ly: Integer; out x, y: Integer); inline;
 183
 184     // x and y are global coords
 185     function controlAtXY (x, y: Integer): THControl;
 186
 187     function mouseEvent (var ev: THMouseEvent): Boolean; virtual; // returns `true` if event was eaten
 188     function keyEvent (var ev: THKeyEvent): Boolean; virtual; // returns `true` if event was eaten
 189
 190     function prevSibling (): THControl;
 191     function nextSibling (): THControl;
 192     function firstChild (): THControl; inline;
 193     function lastChild (): THControl; inline;
 194
 195     procedure appendChild (ctl: THControl); virtual;
 196
 197   public
 198     property id: AnsiString read mId;
 199     property x0: Integer read mX;
 200     property y0: Integer read mY;
 201     property height: Integer read mHeight;
 202     property width: Integer read mWidth;
 203     property enabled: Boolean read getEnabled write setEnabled;
 204     property parent: THControl read mParent;
 205     property focused: Boolean read getFocused write setFocused;
 206     property escClose: Boolean read mEscClose write mEscClose;
 207     property eatKeys: Boolean read mEatKeys write mEatKeys;
 208   end;
 209
 210
 211   THTopWindow = class(THControl)
 212   private
 213     mTitle: AnsiString;
 214     mDragging: Boolean;
 215     mDragStartX, mDragStartY: Integer;
 216     mWaitingClose: Boolean;
 217     mInClose: Boolean;
 218     mFreeOnClose: Boolean; // default: false
 219
 220   protected
 221     procedure blurred (); override;
 222
 223   public
 224     closeCB: TActionCB; // called after window was removed from ui window list
 225
 226   public
 227     constructor Create (const atitle: AnsiString; ax, ay: Integer; aw: Integer=-1; ah: Integer=-1);
 228
 229     function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
 230
 231     procedure centerInScreen ();
 232
 233     // `sx` and `sy` are screen coordinates
 234     procedure drawControl (gx, gy: Integer); override;
 235     procedure drawControlPost (gx, gy: Integer); override;
 236
 237     function keyEvent (var ev: THKeyEvent): Boolean; override; // returns `true` if event was eaten
 238     function mouseEvent (var ev: THMouseEvent): Boolean; override; // returns `true` if event was eaten
 239
 240   public
 241     property freeOnClose: Boolean read mFreeOnClose write mFreeOnClose;
 242   end;
 243
 244
 245   THCtlSimpleText = class(THControl)
 246   private
 247     type
 248       PItem = ^TItem;
 249       TItem = record
 250         title: AnsiString;
 251         centered: Boolean;
 252         hline: Boolean;
 253       end;
 254   private
 255     mItems: array of TItem;
 256
 257   public
 258     constructor Create (ax, ay: Integer);
 259     destructor Destroy (); override;
 260
 261     procedure appendItem (const atext: AnsiString; acentered: Boolean=false; ahline: Boolean=false);
 262
 263     procedure drawControl (gx, gy: Integer); override;
 264
 265     function mouseEvent (var ev: THMouseEvent): Boolean; override;
 266     function keyEvent (var ev: THKeyEvent): Boolean; override;
 267   end;
 268
 269
 270   THCtlCBListBox = class(THControl)
 271   private
 272     type
 273       PItem = ^TItem;
 274       TItem = record
 275         title: AnsiString;
 276         varp: PBoolean;
 277         actionCB: TActionCB;
 278       end;
 279   private
 280     mItems: array of TItem;
 281     mCurIndex: Integer;
 282
 283   public
 284     constructor Create (ax, ay: Integer);
 285     destructor Destroy (); override;
 286
 287     procedure appendItem (const atext: AnsiString; bv: PBoolean; aaction: TActionCB=nil);
 288
 289     procedure drawControl (gx, gy: Integer); override;
 290
 291     function mouseEvent (var ev: THMouseEvent): Boolean; override;
 292     function keyEvent (var ev: THKeyEvent): Boolean; override;
 293   end;
 294
 295   // ////////////////////////////////////////////////////////////////////// //
 296   THCtlBox = class(THControl)
 297   private
 298     mHasFrame: Boolean;
 299     mCaption: AnsiString;
 300
 301   public
 302     constructor Create (ahoriz: Boolean);
 303
 304     function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
 305
 306     procedure drawControl (gx, gy: Integer); override;
 307
 308     function mouseEvent (var ev: THMouseEvent): Boolean; override;
 309     function keyEvent (var ev: THKeyEvent): Boolean; override;
 310   end;
 311
 312   THCtlHBox = class(THCtlBox)
 313   public
 314     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 315   end;
 316
 317   THCtlVBox = class(THCtlBox)
 318   public
 319     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 320   end;
 321
 322   // ////////////////////////////////////////////////////////////////////// //
 323   THCtlSpan = class(THControl)
 324   public
 325     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 326
 327     function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
 328
 329     procedure drawControl (gx, gy: Integer); override;
 330   end;
 331
 332   // ////////////////////////////////////////////////////////////////////// //
 333   THCtlLine = class(THControl)
 334   public
 335     function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
 336
 337     procedure drawControl (gx, gy: Integer); override;
 338   end;
 339
 340   THCtlHLine = class(THCtlLine)
 341   public
 342     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 343   end;
 344
 345   THCtlVLine = class(THCtlLine)
 346   public
 347     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 348   end;
 349
 350   // ////////////////////////////////////////////////////////////////////// //
 351   THCtlTextLabel = class(THControl)
 352   private
 353     mText: AnsiString;
 354     mHAlign: Integer; // -1: left; 0: center; 1: right; default: left
 355     mVAlign: Integer; // -1: top; 0: center; 1: bottom; default: center
 356
 357   public
 358     constructor Create (const atext: AnsiString);
 359
 360     procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
 361
 362     function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
 363
 364     procedure drawControl (gx, gy: Integer); override;
 365
 366     function mouseEvent (var ev: THMouseEvent): Boolean; override;
 367     function keyEvent (var ev: THKeyEvent): Boolean; override;
 368   end;
 369
 370
 371 // ////////////////////////////////////////////////////////////////////////// //
 372 function uiMouseEvent (ev: THMouseEvent): Boolean;
 373 function uiKeyEvent (ev: THKeyEvent): Boolean;
 374 procedure uiDraw ();
 375
 376
 377 // ////////////////////////////////////////////////////////////////////////// //
 378 procedure uiAddWindow (ctl: THControl);
 379 procedure uiRemoveWindow (ctl: THControl); // will free window if `mFreeOnClose` is `true`
 380 function uiVisibleWindow (ctl: THControl): Boolean;
 381
 382
 383 // ////////////////////////////////////////////////////////////////////////// //
 384 // do layouting
 385 procedure uiLayoutCtl (ctl: THControl);
 386
 387
 388 // ////////////////////////////////////////////////////////////////////////// //
 389 var
 390   gh_ui_scale: Single = 1.0;
 391
 392
 393 implementation
 394
 395 uses
 396   gh_flexlay,
 397   utils;
 398
 399
 400 // ////////////////////////////////////////////////////////////////////////// //
 401 var
 402   knownCtlClasses: array of record
 403     klass: THControlClass;
 404     name: AnsiString;
 405   end = nil;
 406
 407
 408 procedure registerCtlClass (aklass: THControlClass; const aname: AnsiString);
 409 begin
 410   assert(aklass <> nil);
 411   assert(Length(aname) > 0);
 412   SetLength(knownCtlClasses, Length(knownCtlClasses)+1);
 413   knownCtlClasses[High(knownCtlClasses)].klass := aklass;
 414   knownCtlClasses[High(knownCtlClasses)].name := aname;
 415 end;
 416
 417
 418 function findCtlClass (const aname: AnsiString): THControlClass;
 419 var
 420   f: Integer;
 421 begin
 422   for f := 0 to High(knownCtlClasses) do
 423   begin
 424     if (strEquCI1251(aname, knownCtlClasses[f].name)) then
 425     begin
 426       result := knownCtlClasses[f].klass;
 427       exit;
 428     end;
 429   end;
 430   result := nil;
 431 end;
 432
 433
 434 // ////////////////////////////////////////////////////////////////////////// //
 435 type
 436   TFlexLayouter = specialize TFlexLayouterBase<THControl>;
 437
 438 procedure uiLayoutCtl (ctl: THControl);
 439 var
 440   lay: TFlexLayouter;
 441 begin
 442   if (ctl = nil) then exit;
 443   lay := TFlexLayouter.Create();
 444   try
 445     lay.setup(ctl);
 446     //lay.layout();
 447
 448     //writeln('============================'); lay.dumpFlat();
 449
 450     //writeln('=== initial ==='); lay.dump();
 451
 452     //lay.calcMaxSizeInternal(0);
 453     {
 454     lay.firstPass();
 455     writeln('=== after first pass ===');
 456     lay.dump();
 457
 458     lay.secondPass();
 459     writeln('=== after second pass ===');
 460     lay.dump();
 461     }
 462
 463     lay.layout();
 464     //writeln('=== final ==='); lay.dump();
 465
 466   finally
 467     FreeAndNil(lay);
 468   end;
 469 end;
 470
 471
 472 // ////////////////////////////////////////////////////////////////////////// //
 473 var
 474   uiTopList: array of THControl = nil;
 475
 476
 477 function uiMouseEvent (ev: THMouseEvent): Boolean;
 478 var
 479   f, c: Integer;
 480   lx, ly: Integer;
 481   ctmp: THControl;
 482 begin
 483   ev.x := trunc(ev.x/gh_ui_scale);
 484   ev.y := trunc(ev.y/gh_ui_scale);
 485   ev.dx := trunc(ev.dx/gh_ui_scale); //FIXME
 486   ev.dy := trunc(ev.dy/gh_ui_scale); //FIXME
 487   if (Length(uiTopList) = 0) then result := false else result := uiTopList[High(uiTopList)].mouseEvent(ev);
 488   if not result and (ev.press) then
 489   begin
 490     for f := High(uiTopList) downto 0 do
 491     begin
 492       if uiTopList[f].toLocal(ev.x, ev.y, lx, ly) then
 493       begin
 494         result := true;
 495         if uiTopList[f].mEnabled and (f <> High(uiTopList)) then
 496         begin
 497           uiTopList[High(uiTopList)].blurred();
 498           ctmp := uiTopList[f];
 499           ctmp.mGrab := nil;
 500           for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
 501           uiTopList[High(uiTopList)] := ctmp;
 502           ctmp.activated();
 503           result := ctmp.mouseEvent(ev);
 504         end;
 505         exit;
 506       end;
 507     end;
 508   end;
 509 end;
 510
 511
 512 function uiKeyEvent (ev: THKeyEvent): Boolean;
 513 begin
 514   ev.x := trunc(ev.x/gh_ui_scale);
 515   ev.y := trunc(ev.y/gh_ui_scale);
 516   if (Length(uiTopList) = 0) then result := false else result := uiTopList[High(uiTopList)].keyEvent(ev);
 517   if (ev.release) then begin result := true; exit; end;
 518 end;
 519
 520
 521 procedure uiDraw ();
 522 var
 523   f: Integer;
 524   ctl: THControl;
 525 begin
 526   glMatrixMode(GL_MODELVIEW);
 527   glPushMatrix();
 528   try
 529     glLoadIdentity();
 530     glScalef(gh_ui_scale, gh_ui_scale, 1);
 531     for f := 0 to High(uiTopList) do
 532     begin
 533       ctl := uiTopList[f];
 534       ctl.draw();
 535       if (f <> High(uiTopList)) then darkenRect(ctl.x0, ctl.y0, ctl.width, ctl.height, 128);
 536     end;
 537   finally
 538     glMatrixMode(GL_MODELVIEW);
 539     glPopMatrix();
 540   end;
 541 end;
 542
 543
 544 procedure uiAddWindow (ctl: THControl);
 545 var
 546   f, c: Integer;
 547 begin
 548   if (ctl = nil) then exit;
 549   ctl := ctl.topLevel;
 550   if not (ctl is THTopWindow) then exit; // alas
 551   for f := 0 to High(uiTopList) do
 552   begin
 553     if (uiTopList[f] = ctl) then
 554     begin
 555       if (f <> High(uiTopList)) then
 556       begin
 557         uiTopList[High(uiTopList)].blurred();
 558         for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
 559         uiTopList[High(uiTopList)] := ctl;
 560         ctl.activated();
 561       end;
 562       exit;
 563     end;
 564   end;
 565   if (Length(uiTopList) > 0) then uiTopList[High(uiTopList)].blurred();
 566   SetLength(uiTopList, Length(uiTopList)+1);
 567   uiTopList[High(uiTopList)] := ctl;
 568   ctl.activated();
 569 end;
 570
 571
 572 procedure uiRemoveWindow (ctl: THControl);
 573 var
 574   f, c: Integer;
 575 begin
 576   if (ctl = nil) then exit;
 577   ctl := ctl.topLevel;
 578   if not (ctl is THTopWindow) then exit; // alas
 579   for f := 0 to High(uiTopList) do
 580   begin
 581     if (uiTopList[f] = ctl) then
 582     begin
 583       ctl.blurred();
 584       for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
 585       SetLength(uiTopList, Length(uiTopList)-1);
 586       if (ctl is THTopWindow) then
 587       begin
 588         try
 589           if assigned(THTopWindow(ctl).closeCB) then THTopWindow(ctl).closeCB(ctl, 0);
 590         finally
 591           if (THTopWindow(ctl).mFreeOnClose) then FreeAndNil(ctl);
 592         end;
 593       end;
 594       exit;
 595     end;
 596   end;
 597 end;
 598
 599
 600 function uiVisibleWindow (ctl: THControl): Boolean;
 601 var
 602   f: Integer;
 603 begin
 604   result := false;
 605   if (ctl = nil) then exit;
 606   ctl := ctl.topLevel;
 607   if not (ctl is THTopWindow) then exit; // alas
 608   for f := 0 to High(uiTopList) do
 609   begin
 610     if (uiTopList[f] = ctl) then begin result := true; exit; end;
 611   end;
 612 end;
 613
 614
 615 // ////////////////////////////////////////////////////////////////////////// //
 616 constructor THControl.Create ();
 617 begin
 618   mParent := nil;
 619   mX := 0;
 620   mY := 0;
 621   mWidth := 64;
 622   mHeight := 8;
 623   mFrameWidth := 0;
 624   mFrameHeight := 0;
 625   mEnabled := true;
 626   mCanFocus := true;
 627   mChildren := nil;
 628   mFocused := nil;
 629   mGrab := nil;
 630   mEscClose := false;
 631   mEatKeys := false;
 632   scallowed := false;
 633   mDrawShadow := false;
 634   actionCB := nil;
 635   // layouter interface
 636   //mDefSize := TLaySize.Create(64, 8); // default size
 637   mDefSize := TLaySize.Create(0, 0); // default size
 638   mMaxSize := TLaySize.Create(-1, -1); // maximum size
 639   mFlex := 0;
 640   mHoriz := true;
 641   mCanWrap := false;
 642   mLineStart := false;
 643   mHGroup := '';
 644   mVGroup := '';
 645   mAlign := -1; // left/top
 646   mExpand := false;
 647 end;
 648
 649
 650 constructor THControl.Create (ax, ay, aw, ah: Integer);
 651 begin
 652   Create();
 653   mX := ax;
 654   mY := ay;
 655   mWidth := aw;
 656   mHeight := ah;
 657 end;
 658
 659
 660 destructor THControl.Destroy ();
 661 var
 662   f, c: Integer;
 663 begin
 664   if (mParent <> nil) then
 665   begin
 666     setFocused(false);
 667     for f := 0 to High(mParent.mChildren) do
 668     begin
 669       if (mParent.mChildren[f] = self) then
 670       begin
 671         for c := f+1 to High(mParent.mChildren) do mParent.mChildren[c-1] := mParent.mChildren[c];
 672         SetLength(mParent.mChildren, Length(mParent.mChildren)-1);
 673       end;
 674     end;
 675   end;
 676   for f := 0 to High(mChildren) do
 677   begin
 678     mChildren[f].mParent := nil;
 679     mChildren[f].Free();
 680   end;
 681   mChildren := nil;
 682 end;
 683
 684
 685 // ////////////////////////////////////////////////////////////////////////// //
 686 function THControl.getDefSize (): TLaySize; inline; begin result := mLayDefSize; end;
 687 function THControl.getMaxSize (): TLaySize; inline; begin result := mLayMaxSize; end;
 688 function THControl.getFlex (): Integer; inline; begin result := mFlex; end;
 689 function THControl.isHorizBox (): Boolean; inline; begin result := mHoriz; end;
 690 procedure THControl.setHorizBox (v: Boolean); inline; begin mHoriz := v; end;
 691 function THControl.canWrap (): Boolean; inline; begin result := mCanWrap; end;
 692 procedure THControl.setCanWrap (v: Boolean); inline; begin mCanWrap := v; end;
 693 function THControl.isLineStart (): Boolean; inline; begin result := mLineStart; end;
 694 procedure THControl.setLineStart (v: Boolean); inline; begin mLineStart := v; end;
 695 function THControl.getAlign (): Integer; inline; begin result := mAlign; end;
 696 procedure THControl.setAlign (v: Integer); inline; begin mAlign := v; end;
 697 function THControl.getExpand (): Boolean; inline; begin result := mExpand; end;
 698 procedure THControl.setExpand (v: Boolean); inline; begin mExpand := v; end;
 699 function THControl.getHGroup (): AnsiString; inline; begin result := mHGroup; end;
 700 procedure THControl.setHGroup (const v: AnsiString); inline; begin mHGroup := v; end;
 701 function THControl.getVGroup (): AnsiString; inline; begin result := mVGroup; end;
 702 procedure THControl.setVGroup (const v: AnsiString); inline; begin mVGroup := v; end;
 703
 704 function THControl.getMargins (): TLayMargins; inline;
 705 begin
 706   result := TLayMargins.Create(mFrameHeight, mFrameWidth, mFrameHeight, mFrameWidth);
 707 end;
 708
 709 procedure THControl.setActualSizePos (constref apos: TLayPos; constref asize: TLaySize); inline; begin
 710   //writeln(self.className, '; pos=', apos.toString, '; size=', asize.toString);
 711   if (mParent <> nil) then
 712   begin
 713     mX := apos.x;
 714     mY := apos.y;
 715   end;
 716   mWidth := asize.w;
 717   mHeight := asize.h;
 718 end;
 719
 720 procedure THControl.layPrepare ();
 721 begin
 722   mLayDefSize := mDefSize;
 723   mLayMaxSize := mMaxSize;
 724   if (mLayMaxSize.w >= 0) then mLayMaxSize.w += mFrameWidth*2;
 725   if (mLayMaxSize.h >= 0) then mLayMaxSize.h += mFrameHeight*2;
 726 end;
 727
 728
 729 // ////////////////////////////////////////////////////////////////////////// //
 730 function THControl.parsePos (par: TTextParser): TLayPos;
 731 var
 732   ech: AnsiChar = ')';
 733 begin
 734   if (par.eatDelim('[')) then ech := ']' else par.expectDelim('(');
 735   result.x := par.expectInt();
 736   par.eatDelim(','); // optional comma
 737   result.y := par.expectInt();
 738   par.eatDelim(','); // optional comma
 739   par.expectDelim(ech);
 740 end;
 741
 742 function THControl.parseSize (par: TTextParser): TLaySize;
 743 var
 744   ech: AnsiChar = ')';
 745 begin
 746   if (par.eatDelim('[')) then ech := ']' else par.expectDelim('(');
 747   result.w := par.expectInt();
 748   par.eatDelim(','); // optional comma
 749   result.h := par.expectInt();
 750   par.eatDelim(','); // optional comma
 751   par.expectDelim(ech);
 752 end;
 753
 754 function THControl.parseBool (par: TTextParser): Boolean;
 755 begin
 756   result :=
 757     par.eatIdOrStr('true', false) or
 758     par.eatIdOrStr('yes', false) or
 759     par.eatIdOrStr('tan', false);
 760   if not result then
 761   begin
 762     if (not par.eatIdOrStr('false', false)) and (not par.eatIdOrStr('no', false)) and (not par.eatIdOrStr('ona', false)) then
 763     begin
 764       par.error('boolean value expected');
 765     end;
 766   end;
 767 end;
 768
 769 function THControl.parseAnyAlign (par: TTextParser): Integer;
 770 begin
 771        if (par.eatIdOrStr('left', false)) or (par.eatIdOrStr('top', false)) then result := -1
 772   else if (par.eatIdOrStr('right', false)) or (par.eatIdOrStr('bottom', false)) then result := 1
 773   else if (par.eatIdOrStr('center', false)) then result := 0
 774   else par.error('invalid align value');
 775 end;
 776
 777 function THControl.parseHAlign (par: TTextParser): Integer;
 778 begin
 779        if (par.eatIdOrStr('left', false)) then result := -1
 780   else if (par.eatIdOrStr('right', false)) then result := 1
 781   else if (par.eatIdOrStr('center', false)) then result := 0
 782   else par.error('invalid horizontal align value');
 783 end;
 784
 785 function THControl.parseVAlign (par: TTextParser): Integer;
 786 begin
 787        if (par.eatIdOrStr('top', false)) then result := -1
 788   else if (par.eatIdOrStr('bottom', false)) then result := 1
 789   else if (par.eatIdOrStr('center', false)) then result := 0
 790   else par.error('invalid vertical align value');
 791 end;
 792
 793 procedure THControl.parseTextAlign (par: TTextParser; var h, v: Integer);
 794 var
 795   wasH: Boolean = false;
 796   wasV: Boolean = false;
 797 begin
 798   while true do
 799   begin
 800     if (par.eatIdOrStr('left', false)) then
 801     begin
 802       if wasH then par.error('too many align directives');
 803       wasH := true;
 804       h := -1;
 805       continue;
 806     end;
 807     if (par.eatIdOrStr('right', false)) then
 808     begin
 809       if wasH then par.error('too many align directives');
 810       wasH := true;
 811       h := 1;
 812       continue;
 813     end;
 814     if (par.eatIdOrStr('hcenter', false)) then
 815     begin
 816       if wasH then par.error('too many align directives');
 817       wasH := true;
 818       h := 0;
 819       continue;
 820     end;
 821     if (par.eatIdOrStr('top', false)) then
 822     begin
 823       if wasV then par.error('too many align directives');
 824       wasV := true;
 825       v := -1;
 826       continue;
 827     end;
 828     if (par.eatIdOrStr('bottom', false)) then
 829     begin
 830       if wasV then par.error('too many align directives');
 831       wasV := true;
 832       v := 1;
 833       continue;
 834     end;
 835     if (par.eatIdOrStr('vcenter', false)) then
 836     begin
 837       if wasV then par.error('too many align directives');
 838       wasV := true;
 839       v := 0;
 840       continue;
 841     end;
 842     if (par.eatIdOrStr('center', false)) then
 843     begin
 844       if wasV or wasH then par.error('too many align directives');
 845       wasV := true;
 846       wasH := true;
 847       h := 0;
 848       v := 0;
 849       continue;
 850     end;
 851     break;
 852   end;
 853   if not wasV and not wasH then par.error('invalid align value');
 854 end;
 855
 856 function THControl.parseOrientation (const prname: AnsiString; par: TTextParser): Boolean;
 857 begin
 858   if (strEquCI1251(prname, 'orientation')) or (strEquCI1251(prname, 'orient')) then
 859   begin
 860          if (par.eatIdOrStr('horizontal', false)) or (par.eatIdOrStr('horiz', false)) then mHoriz := true
 861     else if (par.eatIdOrStr('vertical', false)) or (par.eatIdOrStr('vert', false)) then mHoriz := false
 862     else par.error('`horizontal` or `vertical` expected');
 863     result := true;
 864   end
 865   else
 866   begin
 867     result := false;
 868   end;
 869 end;
 870
 871 // par should be on '{'; final '}' is eaten
 872 procedure THControl.parseProperties (par: TTextParser);
 873 var
 874   pn: AnsiString;
 875 begin
 876   if (not par.eatDelim('{')) then exit;
 877   while (not par.eatDelim('}')) do
 878   begin
 879     if (not par.isIdOrStr) then par.error('property name expected');
 880     pn := par.tokStr;
 881     par.skipToken();
 882     par.eatDelim(':'); // optional
 883     if not parseProperty(pn, par) then par.errorfmt('invalid property name ''%s''', [pn]);
 884     par.eatDelim(','); // optional
 885   end;
 886 end;
 887
 888 // par should be on '{'
 889 procedure THControl.parseChildren (par: TTextParser);
 890 var
 891   cc: THControlClass;
 892   ctl: THControl;
 893 begin
 894   par.expectDelim('{');
 895   while (not par.eatDelim('}')) do
 896   begin
 897     if (not par.isIdOrStr) then par.error('control name expected');
 898     cc := findCtlClass(par.tokStr);
 899     if (cc = nil) then par.errorfmt('unknown control name: ''%s''', [par.tokStr]);
 900     //writeln('children for <', par.tokStr, '>: <', cc.className, '>');
 901     par.skipToken();
 902     par.eatDelim(':'); // optional
 903     ctl := cc.Create();
 904     //writeln('  mHoriz=', ctl.mHoriz);
 905     try
 906       ctl.parseProperties(par);
 907     except
 908       FreeAndNil(ctl);
 909       raise;
 910     end;
 911     //writeln(': ', ctl.mDefSize.toString);
 912     appendChild(ctl);
 913     par.eatDelim(','); // optional
 914   end;
 915 end;
 916
 917
 918 function THControl.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
 919 begin
 920   result := true;
 921   if (strEquCI1251(prname, 'id')) then begin mId := par.expectStrOrId(true); exit; end; // allow empty strings
 922   if (strEquCI1251(prname, 'flex')) then begin flex := par.expectInt(); exit; end;
 923   // sizes
 924   if (strEquCI1251(prname, 'defsize')) or (strEquCI1251(prname, 'size')) then begin mDefSize := parseSize(par); exit; end;
 925   if (strEquCI1251(prname, 'maxsize')) then begin mMaxSize := parseSize(par); exit; end;
 926   if (strEquCI1251(prname, 'defwidth')) or (strEquCI1251(prname, 'width')) then begin mDefSize.w := par.expectInt(); exit; end;
 927   if (strEquCI1251(prname, 'defheight')) or (strEquCI1251(prname, 'height')) then begin mDefSize.h := par.expectInt(); exit; end;
 928   if (strEquCI1251(prname, 'maxwidth')) then begin mMaxSize.w := par.expectInt(); exit; end;
 929   if (strEquCI1251(prname, 'maxheight')) then begin mMaxSize.h := par.expectInt(); exit; end;
 930   // flags
 931   if (strEquCI1251(prname, 'wrap')) then begin mCanWrap := parseBool(par); exit; end;
 932   if (strEquCI1251(prname, 'linestart')) then begin mLineStart := parseBool(par); exit; end;
 933   if (strEquCI1251(prname, 'expand')) then begin mExpand := parseBool(par); exit; end;
 934   // align
 935   if (strEquCI1251(prname, 'align')) then begin mAlign := parseAnyAlign(par); exit; end;
 936   if (strEquCI1251(prname, 'hgroup')) then begin mHGroup := par.expectStrOrId(true); exit; end; // allow empty strings
 937   if (strEquCI1251(prname, 'vgroup')) then begin mVGroup := par.expectStrOrId(true); exit; end; // allow empty strings
 938   // other
 939   if (strEquCI1251(prname, 'canfocus')) then begin mCanFocus := parseBool(par); exit; end;
 940   if (strEquCI1251(prname, 'enabled')) then begin mEnabled := parseBool(par); exit; end;
 941   if (strEquCI1251(prname, 'disabled')) then begin mEnabled := not parseBool(par); exit; end;
 942   if (strEquCI1251(prname, 'escclose')) then begin mEscClose := not parseBool(par); exit; end;
 943   if (strEquCI1251(prname, 'eatkeys')) then begin mEatKeys := not parseBool(par); exit; end;
 944   result := false;
 945 end;
 946
 947
 948 // ////////////////////////////////////////////////////////////////////////// //
 949 procedure THControl.activated ();
 950 begin
 951 end;
 952
 953
 954 procedure THControl.blurred ();
 955 begin
 956   mGrab := nil;
 957 end;
 958
 959
 960 function THControl.topLevel (): THControl; inline;
 961 begin
 962   result := self;
 963   while (result.mParent <> nil) do result := result.mParent;
 964 end;
 965
 966
 967 function THControl.getEnabled (): Boolean;
 968 var
 969   ctl: THControl;
 970 begin
 971   result := false;
 972   if (not mEnabled) or (mWidth < 1) or (mHeight < 1) then exit;
 973   ctl := mParent;
 974   while (ctl <> nil) do
 975   begin
 976     if (not ctl.mEnabled) or (ctl.mWidth < 1) or (ctl.mHeight < 1) then exit;
 977     ctl := ctl.mParent;
 978   end;
 979   result := true;
 980 end;
 981
 982
 983 procedure THControl.setEnabled (v: Boolean); inline;
 984 begin
 985   if (mEnabled = v) then exit;
 986   mEnabled := v;
 987   if not v and focused then setFocused(false);
 988 end;
 989
 990
 991 function THControl.getFocused (): Boolean; inline;
 992 begin
 993   if (mParent = nil) then result := (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)] = self) else result := (topLevel.mFocused = self);
 994 end;
 995
 996
 997 procedure THControl.setFocused (v: Boolean); inline;
 998 var
 999   tl: THControl;
1000 begin
1001   tl := topLevel;
1002   if not v then
1003   begin
1004     if (tl.mFocused = self) then
1005     begin
1006       tl.blurred();
1007       tl.mFocused := tl.findNextFocus(self);
1008       if (tl.mFocused = self) then tl.mFocused := nil;
1009     end;
1010     exit;
1011   end;
1012   if (not mEnabled) or (not mCanFocus) then exit;
1013   if (tl.mFocused <> self) then
1014   begin
1015     tl.mFocused.blurred();
1016     tl.mFocused := self;
1017     if (tl.mGrab <> self) then tl.mGrab := nil;
1018     activated();
1019   end;
1020 end;
1021
1022
1023 function THControl.isMyChild (ctl: THControl): Boolean;
1024 begin
1025   result := true;
1026   while (ctl <> nil) do
1027   begin
1028     if (ctl.mParent = self) then exit;
1029     ctl := ctl.mParent;
1030   end;
1031   result := false;
1032 end;
1033
1034
1035 // returns `true` if global coords are inside this control
1036 function THControl.toLocal (var x, y: Integer): Boolean;
1037 var
1038   ctl: THControl;
1039 begin
1040   ctl := self;
1041   while (ctl <> nil) do
1042   begin
1043     Dec(x, ctl.mX);
1044     Dec(y, ctl.mY);
1045     ctl := ctl.mParent;
1046   end;
1047   result := (x >= 0) and (y >= 0) and (x < mWidth) and (y < mHeight);
1048 end;
1049
1050 function THControl.toLocal (gx, gy: Integer; out x, y: Integer): Boolean; inline;
1051 begin
1052   x := gx;
1053   y := gy;
1054   result := toLocal(x, y);
1055 end;
1056
1057 procedure THControl.toGlobal (var x, y: Integer);
1058 var
1059   ctl: THControl;
1060 begin
1061   ctl := self;
1062   while (ctl <> nil) do
1063   begin
1064     Inc(x, ctl.mX);
1065     Inc(y, ctl.mY);
1066     ctl := ctl.mParent;
1067   end;
1068 end;
1069
1070 procedure THControl.toGlobal (lx, ly: Integer; out x, y: Integer); inline;
1071 begin
1072   x := lx;
1073   y := ly;
1074   toGlobal(x, y);
1075 end;
1076
1077
1078 // x and y are global coords
1079 function THControl.controlAtXY (x, y: Integer): THControl;
1080 var
1081   lx, ly: Integer;
1082   f: Integer;
1083 begin
1084   result := nil;
1085   if (not mEnabled) or (mWidth < 1) or (mHeight < 1) then exit;
1086   if not toLocal(x, y, lx, ly) then exit;
1087   for f := High(mChildren) downto 0 do
1088   begin
1089     result := mChildren[f].controlAtXY(x, y);
1090     if (result <> nil) then exit;
1091   end;
1092   result := self;
1093 end;
1094
1095
1096 function THControl.prevSibling (): THControl;
1097 var
1098   f: Integer;
1099 begin
1100   if (mParent <> nil) then
1101   begin
1102     for f := 1 to High(mParent.mChildren) do
1103     begin
1104       if (mParent.mChildren[f] = self) then begin result := mParent.mChildren[f-1]; exit; end;
1105     end;
1106   end;
1107   result := nil;
1108 end;
1109
1110 function THControl.nextSibling (): THControl;
1111 var
1112   f: Integer;
1113 begin
1114   if (mParent <> nil) then
1115   begin
1116     for f := 0 to High(mParent.mChildren)-1 do
1117     begin
1118       if (mParent.mChildren[f] = self) then begin result := mParent.mChildren[f+1]; exit; end;
1119     end;
1120   end;
1121   result := nil;
1122 end;
1123
1124 function THControl.firstChild (): THControl; inline;
1125 begin
1126   if (Length(mChildren) <> 0) then result := mChildren[0] else result := nil;
1127 end;
1128
1129 function THControl.lastChild (): THControl; inline;
1130 begin
1131   if (Length(mChildren) <> 0) then result := mChildren[High(mChildren)] else result := nil;
1132 end;
1133
1134
1135 function THControl.findFirstFocus (): THControl;
1136 var
1137   f: Integer;
1138 begin
1139   result := nil;
1140   if enabled then
1141   begin
1142     for f := 0 to High(mChildren) do
1143     begin
1144       result := mChildren[f].findFirstFocus();
1145       if (result <> nil) then exit;
1146     end;
1147     if mCanFocus then result := self;
1148   end;
1149 end;
1150
1151
1152 function THControl.findLastFocus (): THControl;
1153 var
1154   f: Integer;
1155 begin
1156   result := nil;
1157   if enabled then
1158   begin
1159     for f := High(mChildren) downto 0 do
1160     begin
1161       result := mChildren[f].findLastFocus();
1162       if (result <> nil) then exit;
1163     end;
1164     if mCanFocus then result := self;
1165   end;
1166 end;
1167
1168
1169 function THControl.findNextFocus (cur: THControl): THControl;
1170 begin
1171   result := nil;
1172   if enabled then
1173   begin
1174     if not isMyChild(cur) then cur := nil;
1175     if (cur = nil) then begin result := findFirstFocus(); exit; end;
1176     result := cur.findFirstFocus();
1177     if (result <> nil) and (result <> cur) then exit;
1178     while true do
1179     begin
1180       cur := cur.nextSibling;
1181       if (cur = nil) then break;
1182       result := cur.findFirstFocus();
1183       if (result <> nil) then exit;
1184     end;
1185     result := findFirstFocus();
1186   end;
1187 end;
1188
1189
1190 function THControl.findPrevFocus (cur: THControl): THControl;
1191 begin
1192   result := nil;
1193   if enabled then
1194   begin
1195     if not isMyChild(cur) then cur := nil;
1196     if (cur = nil) then begin result := findLastFocus(); exit; end;
1197     //FIXME!
1198     result := cur.findLastFocus();
1199     if (result <> nil) and (result <> cur) then exit;
1200     while true do
1201     begin
1202       cur := cur.prevSibling;
1203       if (cur = nil) then break;
1204       result := cur.findLastFocus();
1205       if (result <> nil) then exit;
1206     end;
1207     result := findLastFocus();
1208   end;
1209 end;
1210
1211
1212 procedure THControl.appendChild (ctl: THControl);
1213 begin
1214   if (ctl = nil) then exit;
1215   if (ctl.mParent <> nil) then exit;
1216   SetLength(mChildren, Length(mChildren)+1);
1217   mChildren[High(mChildren)] := ctl;
1218   ctl.mParent := self;
1219   Inc(ctl.mX, mFrameWidth);
1220   Inc(ctl.mY, mFrameHeight);
1221   if (ctl.mWidth > 0) and (ctl.mHeight > 0) and
1222      (ctl.mX+ctl.mWidth > mFrameWidth) and (ctl.mY+ctl.mHeight > mFrameHeight) then
1223   begin
1224     if (mWidth+mFrameWidth < ctl.mX+ctl.mWidth) then mWidth := ctl.mX+ctl.mWidth+mFrameWidth;
1225     if (mHeight+mFrameHeight < ctl.mY+ctl.mHeight) then mHeight := ctl.mY+ctl.mHeight+mFrameHeight;
1226   end;
1227   if (mFocused = nil) and ctl.mEnabled and ctl.mCanFocus and (ctl.mWidth > 0) and (ctl.mHeight > 0) then mFocused := ctl;
1228 end;
1229
1230
1231 // ////////////////////////////////////////////////////////////////////////// //
1232 procedure THControl.setScissorGLInternal (x, y, w, h: Integer);
1233 begin
1234   if not scallowed then exit;
1235   x := trunc(x*gh_ui_scale);
1236   y := trunc(y*gh_ui_scale);
1237   w := trunc(w*gh_ui_scale);
1238   h := trunc(h*gh_ui_scale);
1239   scis.combineRect(x, y, w, h);
1240 end;
1241
1242 procedure THControl.setScissor (lx, ly, lw, lh: Integer);
1243 var
1244   gx, gy: Integer;
1245   //ox, oy, ow, oh: Integer;
1246 begin
1247   if not scallowed then exit;
1248   //ox := lx; oy := ly; ow := lw; oh := lh;
1249   if not intersectRect(lx, ly, lw, lh, 0, 0, mWidth, mHeight) then
1250   begin
1251     //writeln('oops: <', self.className, '>: old=(', ox, ',', oy, ')-[', ow, ',', oh, ']');
1252     glScissor(0, 0, 0, 0);
1253     exit;
1254   end;
1255   toGlobal(lx, ly, gx, gy);
1256   setScissorGLInternal(gx, gy, lw, lh);
1257 end;
1258
1259 procedure THControl.resetScissor (fullArea: Boolean); inline;
1260 begin
1261   if not scallowed then exit;
1262   if (fullArea) then
1263   begin
1264     setScissor(0, 0, mWidth, mHeight);
1265   end
1266   else
1267   begin
1268     setScissor(mFrameWidth, mFrameHeight, mWidth-mFrameWidth*2, mHeight-mFrameHeight*2);
1269   end;
1270 end;
1271
1272
1273 // ////////////////////////////////////////////////////////////////////////// //
1274 procedure THControl.draw ();
1275 var
1276   f: Integer;
1277   gx, gy: Integer;
1278 begin
1279   if (mWidth < 1) or (mHeight < 1) then exit;
1280   toGlobal(0, 0, gx, gy);
1281   //conwritefln('[%s]: (%d,%d)-(%d,%d)  (%d,%d)', [ClassName, mX, mY, mWidth, mHeight, x, y]);
1282
1283   scis.save(true); // scissoring enabled
1284   try
1285     scallowed := true;
1286     resetScissor(true); // full area
1287     drawControl(gx, gy);
1288     resetScissor(false); // client area
1289     for f := 0 to High(mChildren) do mChildren[f].draw();
1290     resetScissor(true); // full area
1291     drawControlPost(gx, gy);
1292   finally
1293     scis.restore();
1294     scallowed := false;
1295   end;
1296 end;
1297
1298 procedure THControl.drawControl (gx, gy: Integer);
1299 begin
1300   if (mParent = nil) then darkenRect(gx, gy, mWidth, mHeight, 64);
1301 end;
1302
1303 procedure THControl.drawControlPost (gx, gy: Integer);
1304 begin
1305   // shadow
1306   if mDrawShadow and (mWidth > 0) and (mHeight > 0) then
1307   begin
1308     setScissorGLInternal(gx+8, gy+8, mWidth, mHeight);
1309     darkenRect(gx+mWidth, gy+8, 8, mHeight, 128);
1310     darkenRect(gx+8, gy+mHeight, mWidth-8, 8, 128);
1311   end;
1312 end;
1313
1314
1315 // ////////////////////////////////////////////////////////////////////////// //
1316 function THControl.mouseEvent (var ev: THMouseEvent): Boolean;
1317 var
1318   ctl: THControl;
1319 begin
1320   result := false;
1321   if not mEnabled then exit;
1322   if (mParent = nil) then
1323   begin
1324     if (mGrab <> nil) then
1325     begin
1326       result := mGrab.mouseEvent(ev);
1327       if (ev.release) then mGrab := nil;
1328       exit;
1329     end;
1330   end;
1331   if (mWidth < 1) or (mHeight < 1) then exit;
1332   ctl := controlAtXY(ev.x, ev.y);
1333   if (ctl <> nil) and (ctl <> self) then
1334   begin
1335     if (ctl <> topLevel.mFocused) then ctl.setFocused(true);
1336     result := ctl.mouseEvent(ev);
1337   end
1338   else if (ctl = self) and assigned(actionCB) then
1339   begin
1340     actionCB(self, 0);
1341   end;
1342 end;
1343
1344
1345 function THControl.keyEvent (var ev: THKeyEvent): Boolean;
1346 var
1347   ctl: THControl;
1348 begin
1349   result := false;
1350   if not mEnabled then exit;
1351   if (topLevel.mFocused <> self) and isMyChild(topLevel.mFocused) and topLevel.mFocused.mEnabled then result := topLevel.mFocused.keyEvent(ev);
1352   if (mParent = nil) then
1353   begin
1354     if (ev = 'S-Tab') then
1355     begin
1356       result := true;
1357       ctl := findPrevFocus(mFocused);
1358       if (ctl <> mFocused) then
1359       begin
1360         mGrab := nil;
1361         mFocused := ctl;
1362       end;
1363       exit;
1364     end;
1365     if (ev = 'Tab') then
1366     begin
1367       result := true;
1368       ctl := findNextFocus(mFocused);
1369       if (ctl <> mFocused) then
1370       begin
1371         mGrab := nil;
1372         mFocused := ctl;
1373       end;
1374       exit;
1375     end;
1376     if mEscClose and (ev = 'Escape') then
1377     begin
1378       result := true;
1379       uiRemoveWindow(self);
1380       exit;
1381     end;
1382   end;
1383   if mEatKeys then result := true;
1384 end;
1385
1386
1387 // ////////////////////////////////////////////////////////////////////////// //
1388 constructor THTopWindow.Create (const atitle: AnsiString; ax, ay: Integer; aw: Integer=-1; ah: Integer=-1);
1389 begin
1390   inherited Create(ax, ay, aw, ah);
1391   mFrameWidth := 8;
1392   mFrameHeight := 8;
1393   mTitle := atitle;
1394   if (mWidth < mFrameWidth*2+3*8) then mWidth := mFrameWidth*2+3*8;
1395   if (mHeight < mFrameHeight*2) then mHeight := mFrameHeight*2;
1396   if (Length(mTitle) > 0) then
1397   begin
1398     if (mWidth < Length(mTitle)*8+mFrameWidth*2+3*8) then mWidth := Length(mTitle)*8+mFrameWidth*2+3*8;
1399   end;
1400   mDragging := false;
1401   mDrawShadow := true;
1402   mWaitingClose := false;
1403   mInClose := false;
1404   closeCB := nil;
1405 end;
1406
1407
1408 function THTopWindow.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
1409 begin
1410   if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) then
1411   begin
1412     mTitle := par.expectStrOrId(true);
1413     result := true;
1414     exit;
1415   end;
1416   if (strEquCI1251(prname, 'children')) then
1417   begin
1418     parseChildren(par);
1419     result := true;
1420     exit;
1421   end;
1422   if (parseOrientation(prname, par)) then begin result := true; exit; end;
1423   result := inherited parseProperty(prname, par);
1424 end;
1425
1426
1427 procedure THTopWindow.centerInScreen ();
1428 begin
1429   if (mWidth > 0) and (mHeight > 0) then
1430   begin
1431     mX := trunc((gScrWidth/gh_ui_scale-mWidth)/2);
1432     mY := trunc((gScrHeight/gh_ui_scale-mHeight)/2);
1433   end;
1434 end;
1435
1436
1437 procedure THTopWindow.drawControl (gx, gy: Integer);
1438 begin
1439   fillRect(gx, gy, mWidth, mHeight, TGxRGBA.Create(0, 0, 128));
1440 end;
1441
1442
1443 procedure THTopWindow.drawControlPost (gx, gy: Integer);
1444 const r = 255;
1445 const g = 255;
1446 const b = 255;
1447 var
1448   tx: Integer;
1449 begin
1450   if mDragging then
1451   begin
1452     drawRectUI(mX+4, mY+4, mWidth-8, mHeight-8, TGxRGBA.Create(r, g, b));
1453   end
1454   else
1455   begin
1456     drawRectUI(mX+3, mY+3, mWidth-6, mHeight-6, TGxRGBA.Create(r, g, b));
1457     drawRectUI(mX+5, mY+5, mWidth-10, mHeight-10, TGxRGBA.Create(r, g, b));
1458     setScissor(mFrameWidth, 0, 3*8, 8);
1459     fillRect(mX+mFrameWidth, mY, 3*8, 8, TGxRGBA.Create(0, 0, 128));
1460     drawText8(mX+mFrameWidth, mY, '[ ]', TGxRGBA.Create(r, g, b));
1461     if mInClose then drawText8(mX+mFrameWidth+7, mY, '#', TGxRGBA.Create(0, 255, 0))
1462     else drawText8(mX+mFrameWidth+7, mY, '*', TGxRGBA.Create(0, 255, 0));
1463   end;
1464   if (Length(mTitle) > 0) then
1465   begin
1466     setScissor(mFrameWidth+3*8, 0, mWidth-mFrameWidth*2-3*8, 8);
1467     tx := (mX+3*8)+((mWidth-3*8)-Length(mTitle)*8) div 2;
1468     fillRect(tx-3, mY, Length(mTitle)*8+3+2, 8, TGxRGBA.Create(0, 0, 128));
1469     drawText8(tx, mY, mTitle, TGxRGBA.Create(r, g, b));
1470   end;
1471   inherited drawControlPost(gx, gy);
1472 end;
1473
1474
1475 procedure THTopWindow.blurred ();
1476 begin
1477   mDragging := false;
1478   mWaitingClose := false;
1479   mInClose := false;
1480   inherited;
1481 end;
1482
1483
1484 function THTopWindow.keyEvent (var ev: THKeyEvent): Boolean;
1485 begin
1486   result := inherited keyEvent(ev);
1487   if not getFocused then exit;
1488   if (ev = 'M-F3') then
1489   begin
1490     uiRemoveWindow(self);
1491     result := true;
1492     exit;
1493   end;
1494 end;
1495
1496
1497 function THTopWindow.mouseEvent (var ev: THMouseEvent): Boolean;
1498 var
1499   lx, ly: Integer;
1500 begin
1501   result := false;
1502   if not mEnabled then exit;
1503   if (mWidth < 1) or (mHeight < 1) then exit;
1504
1505   if mDragging then
1506   begin
1507     mX += ev.x-mDragStartX;
1508     mY += ev.y-mDragStartY;
1509     mDragStartX := ev.x;
1510     mDragStartY := ev.y;
1511     if (ev.release) then mDragging := false;
1512     result := true;
1513     exit;
1514   end;
1515
1516   if toLocal(ev.x, ev.y, lx, ly) then
1517   begin
1518     if (ev.press) then
1519     begin
1520       if (ly < 8) then
1521       begin
1522         if (lx >= mFrameWidth) and (lx < mFrameWidth+3*8) then
1523         begin
1524           //uiRemoveWindow(self);
1525           mWaitingClose := true;
1526           mInClose := true;
1527         end
1528         else
1529         begin
1530           mDragging := true;
1531           mDragStartX := ev.x;
1532           mDragStartY := ev.y;
1533         end;
1534         result := true;
1535         exit;
1536       end;
1537       if (lx < mFrameWidth) or (lx >= mWidth-mFrameWidth) or (ly >= mHeight-mFrameHeight) then
1538       begin
1539         mDragging := true;
1540         mDragStartX := ev.x;
1541         mDragStartY := ev.y;
1542         result := true;
1543         exit;
1544       end;
1545     end;
1546
1547     if (ev.release) then
1548     begin
1549       if mWaitingClose and (lx >= mFrameWidth) and (lx < mFrameWidth+3*8) then
1550       begin
1551         uiRemoveWindow(self);
1552         result := true;
1553         exit;
1554       end;
1555       mWaitingClose := false;
1556       mInClose := false;
1557     end;
1558
1559     if (ev.motion) then
1560     begin
1561       if mWaitingClose then
1562       begin
1563         mInClose := (lx >= mFrameWidth) and (lx < mFrameWidth+3*8);
1564         result := true;
1565         exit;
1566       end;
1567     end;
1568   end
1569   else
1570   begin
1571     mInClose := false;
1572     if (not ev.motion) then mWaitingClose := false;
1573   end;
1574
1575   result := inherited mouseEvent(ev);
1576 end;
1577
1578
1579 // ////////////////////////////////////////////////////////////////////////// //
1580 constructor THCtlSimpleText.Create (ax, ay: Integer);
1581 begin
1582   mItems := nil;
1583   inherited Create(ax, ay, 4, 4);
1584 end;
1585
1586
1587 destructor THCtlSimpleText.Destroy ();
1588 begin
1589   mItems := nil;
1590   inherited;
1591 end;
1592
1593
1594 procedure THCtlSimpleText.appendItem (const atext: AnsiString; acentered: Boolean=false; ahline: Boolean=false);
1595 var
1596   it: PItem;
1597 begin
1598   if (Length(atext)*8+3*8+2 > mWidth) then mWidth := Length(atext)*8+3*8+2;
1599   SetLength(mItems, Length(mItems)+1);
1600   it := @mItems[High(mItems)];
1601   it.title := atext;
1602   it.centered := acentered;
1603   it.hline := ahline;
1604   if (Length(mItems)*8 > mHeight) then mHeight := Length(mItems)*8;
1605 end;
1606
1607
1608 procedure THCtlSimpleText.drawControl (gx, gy: Integer);
1609 var
1610   f, tx: Integer;
1611   it: PItem;
1612   r, g, b: Integer;
1613 begin
1614   for f := 0 to High(mItems) do
1615   begin
1616     it := @mItems[f];
1617     tx := gx;
1618     r := 255;
1619     g := 255;
1620     b := 0;
1621     if it.centered then begin b := 255; tx := gx+(mWidth-Length(it.title)*8) div 2; end;
1622     if it.hline then
1623     begin
1624       b := 255;
1625       if (Length(it.title) = 0) then
1626       begin
1627         drawHLine(gx+4, gy+3, mWidth-8, TGxRGBA.Create(r, g, b));
1628       end
1629       else if (tx-3 > gx+4) then
1630       begin
1631         drawHLine(gx+4, gy+3, tx-3-(gx+3), TGxRGBA.Create(r, g, b));
1632         drawHLine(tx+Length(it.title)*8, gy+3, mWidth-4, TGxRGBA.Create(r, g, b));
1633       end;
1634     end;
1635     drawText8(tx, gy, it.title, TGxRGBA.Create(r, g, b));
1636     Inc(gy, 8);
1637   end;
1638 end;
1639
1640
1641 function THCtlSimpleText.mouseEvent (var ev: THMouseEvent): Boolean;
1642 var
1643   lx, ly: Integer;
1644 begin
1645   result := inherited mouseEvent(ev);
1646   if not result and toLocal(ev.x, ev.y, lx, ly) then
1647   begin
1648     result := true;
1649   end;
1650 end;
1651
1652
1653 function THCtlSimpleText.keyEvent (var ev: THKeyEvent): Boolean;
1654 begin
1655   result := inherited keyEvent(ev);
1656 end;
1657
1658
1659 // ////////////////////////////////////////////////////////////////////////// //
1660 constructor THCtlCBListBox.Create (ax, ay: Integer);
1661 begin
1662   mItems := nil;
1663   mCurIndex := -1;
1664   inherited Create(ax, ay, 4, 4);
1665 end;
1666
1667
1668 destructor THCtlCBListBox.Destroy ();
1669 begin
1670   mItems := nil;
1671   inherited;
1672 end;
1673
1674
1675 procedure THCtlCBListBox.appendItem (const atext: AnsiString; bv: PBoolean; aaction: TActionCB=nil);
1676 var
1677   it: PItem;
1678 begin
1679   if (Length(atext)*8+3*8+2 > mWidth) then mWidth := Length(atext)*8+3*8+2;
1680   SetLength(mItems, Length(mItems)+1);
1681   it := @mItems[High(mItems)];
1682   it.title := atext;
1683   it.varp := bv;
1684   it.actionCB := aaction;
1685   if (Length(mItems)*8 > mHeight) then mHeight := Length(mItems)*8;
1686   if (mCurIndex < 0) then mCurIndex := 0;
1687 end;
1688
1689
1690 procedure THCtlCBListBox.drawControl (gx, gy: Integer);
1691 var
1692   f, tx: Integer;
1693   it: PItem;
1694 begin
1695   for f := 0 to High(mItems) do
1696   begin
1697     it := @mItems[f];
1698     if (mCurIndex = f) then fillRect(gx, gy, mWidth, 8, TGxRGBA.Create(0, 128, 0));
1699     if (it.varp <> nil) then
1700     begin
1701       if it.varp^ then drawText8(gx, gy, '[x]', TGxRGBA.Create(255, 255, 255)) else drawText8(gx, gy, '[ ]', TGxRGBA.Create(255, 255, 255));
1702       drawText8(gx+3*8+2, gy, it.title, TGxRGBA.Create(255, 255, 0));
1703     end
1704     else if (Length(it.title) > 0) then
1705     begin
1706       tx := gx+(mWidth-Length(it.title)*8) div 2;
1707       if (tx-3 > gx+4) then
1708       begin
1709         drawHLine(gx+4, gy+3, tx-3-(gx+3), TGxRGBA.Create(255, 255, 255));
1710         drawHLine(tx+Length(it.title)*8, gy+3, mWidth-4, TGxRGBA.Create(255, 255, 255));
1711       end;
1712       drawText8(tx, gy, it.title, TGxRGBA.Create(255, 255, 255));
1713     end
1714     else
1715     begin
1716       drawHLine(gx+4, gy+3, mWidth-8, TGxRGBA.Create(255, 255, 255));
1717     end;
1718     Inc(gy, 8);
1719   end;
1720 end;
1721
1722
1723 function THCtlCBListBox.mouseEvent (var ev: THMouseEvent): Boolean;
1724 var
1725   lx, ly: Integer;
1726   it: PItem;
1727 begin
1728   result := inherited mouseEvent(ev);
1729   if not result and toLocal(ev.x, ev.y, lx, ly) then
1730   begin
1731     result := true;
1732     if (ev = 'lmb') then
1733     begin
1734       ly := ly div 8;
1735       if (ly >= 0) and (ly < Length(mItems)) then
1736       begin
1737         it := @mItems[ly];
1738         if (it.varp <> nil) then
1739         begin
1740           mCurIndex := ly;
1741           it.varp^ := not it.varp^;
1742           if assigned(it.actionCB) then it.actionCB(self, Integer(it.varp^));
1743           if assigned(actionCB) then actionCB(self, ly);
1744         end;
1745       end;
1746     end;
1747   end;
1748 end;
1749
1750
1751 function THCtlCBListBox.keyEvent (var ev: THKeyEvent): Boolean;
1752 var
1753   it: PItem;
1754 begin
1755   result := inherited keyEvent(ev);
1756   if not getFocused then exit;
1757   //result := true;
1758   if (ev = 'Home') or (ev = 'PageUp') then
1759   begin
1760     result := true;
1761     mCurIndex := 0;
1762   end;
1763   if (ev = 'End') or (ev = 'PageDown') then
1764   begin
1765     result := true;
1766     mCurIndex := High(mItems);
1767   end;
1768   if (ev = 'Up') then
1769   begin
1770     result := true;
1771     if (Length(mItems) > 0) then
1772     begin
1773       if (mCurIndex < 0) then mCurIndex := Length(mItems);
1774       while (mCurIndex > 0) do
1775       begin
1776         Dec(mCurIndex);
1777         if (mItems[mCurIndex].varp <> nil) then break;
1778       end;
1779     end
1780     else
1781     begin
1782       mCurIndex := -1;
1783     end;
1784   end;
1785   if (ev = 'Down') then
1786   begin
1787     result := true;
1788     if (Length(mItems) > 0) then
1789     begin
1790       if (mCurIndex < 0) then mCurIndex := -1;
1791       while (mCurIndex < High(mItems)) do
1792       begin
1793         Inc(mCurIndex);
1794         if (mItems[mCurIndex].varp <> nil) then break;
1795       end;
1796     end
1797     else
1798     begin
1799       mCurIndex := -1;
1800     end;
1801   end;
1802   if (ev = 'Space') or (ev = 'Enter') then
1803   begin
1804     result := true;
1805     if (mCurIndex >= 0) and (mCurIndex < Length(mItems)) and (mItems[mCurIndex].varp <> nil) then
1806     begin
1807       it := @mItems[mCurIndex];
1808       it.varp^ := not it.varp^;
1809       if assigned(it.actionCB) then it.actionCB(self, Integer(it.varp^));
1810       if assigned(actionCB) then actionCB(self, mCurIndex);
1811     end;
1812   end;
1813 end;
1814
1815
1816 // ////////////////////////////////////////////////////////////////////////// //
1817 constructor THCtlBox.Create (ahoriz: Boolean);
1818 begin
1819   inherited Create();
1820   mHoriz := ahoriz;
1821   mCanFocus := false;
1822 end;
1823
1824
1825 function THCtlBox.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
1826 begin
1827   if (parseOrientation(prname, par)) then begin result := true; exit; end;
1828   if (strEquCI1251(prname, 'frame')) then
1829   begin
1830     mHasFrame := parseBool(par);
1831     if (mHasFrame) then begin mFrameWidth := 8; mFrameHeight := 8; end else begin mFrameWidth := 0; mFrameHeight := 0; end;
1832     result := true;
1833     exit;
1834   end;
1835   if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) then
1836   begin
1837     mCaption := par.expectStrOrId(true);
1838     mDefSize := TLaySize.Create(Length(mCaption)*8+3, 8);
1839     result := true;
1840     exit;
1841   end;
1842   if (strEquCI1251(prname, 'children')) then
1843   begin
1844     parseChildren(par);
1845     result := true;
1846     exit;
1847   end;
1848   result := inherited parseProperty(prname, par);
1849 end;
1850
1851
1852 procedure THCtlBox.drawControl (gx, gy: Integer);
1853 var
1854   r, g, b: Integer;
1855   tx: Integer;
1856 begin
1857   if focused then begin r := 255; g := 255; b := 255; end else begin r := 255; g := 255; b := 0; end;
1858   if mHasFrame then
1859   begin
1860     // draw frame
1861     drawRectUI(gx+3, gy+3, mWidth-6, mHeight-6, TGxRGBA.Create(r, g, b));
1862   end;
1863   // draw caption
1864   if (Length(mCaption) > 0) then
1865   begin
1866     setScissor(mFrameWidth+1, 0, mWidth-mFrameWidth-2, 8);
1867     tx := gx+((mWidth-Length(mCaption)*8) div 2);
1868     if mHasFrame then fillRect(tx-2, gy, Length(mCaption)*8+3, 8, TGxRGBA.Create(0, 0, 128));
1869     drawText8(tx, gy, mCaption, TGxRGBA.Create(r, g, b));
1870   end;
1871 end;
1872
1873
1874 function THCtlBox.mouseEvent (var ev: THMouseEvent): Boolean;
1875 var
1876   lx, ly: Integer;
1877 begin
1878   result := inherited mouseEvent(ev);
1879   if not result and toLocal(ev.x, ev.y, lx, ly) then
1880   begin
1881     result := true;
1882   end;
1883 end;
1884
1885
1886 //TODO: navigation with arrow keys, according to box orientation
1887 function THCtlBox.keyEvent (var ev: THKeyEvent): Boolean;
1888 begin
1889   result := inherited keyEvent(ev);
1890 end;
1891
1892
1893 // ////////////////////////////////////////////////////////////////////////// //
1894 procedure THCtlHBox.AfterConstruction ();
1895 begin
1896   inherited AfterConstruction();
1897   mHoriz := true;
1898 end;
1899
1900
1901 // ////////////////////////////////////////////////////////////////////////// //
1902 procedure THCtlVBox.AfterConstruction ();
1903 begin
1904   inherited AfterConstruction();
1905   mHoriz := false;
1906   mCanFocus := false;
1907 end;
1908
1909
1910 // ////////////////////////////////////////////////////////////////////////// //
1911 procedure THCtlSpan.AfterConstruction ();
1912 begin
1913   inherited AfterConstruction();
1914   mExpand := true;
1915   mCanFocus := false;
1916 end;
1917
1918
1919 function THCtlSpan.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
1920 begin
1921   if (parseOrientation(prname, par)) then begin result := true; exit; end;
1922   result := inherited parseProperty(prname, par);
1923 end;
1924
1925
1926 procedure THCtlSpan.drawControl (gx, gy: Integer);
1927 begin
1928 end;
1929
1930
1931 // ////////////////////////////////////////////////////////////////////// //
1932 function THCtlLine.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
1933 begin
1934   if (parseOrientation(prname, par)) then begin result := true; exit; end;
1935   result := inherited parseProperty(prname, par);
1936 end;
1937
1938
1939 procedure THCtlLine.drawControl (gx, gy: Integer);
1940 begin
1941   if mHoriz then
1942   begin
1943     drawHLine(gx, gy+(mHeight div 2), mWidth, TGxRGBA.Create(255, 255, 255));
1944   end
1945   else
1946   begin
1947     drawVLine(gx+(mWidth div 2), gy, mHeight, TGxRGBA.Create(255, 255, 255));
1948   end;
1949 end;
1950
1951
1952 // ////////////////////////////////////////////////////////////////////////// //
1953 procedure THCtlHLine.AfterConstruction ();
1954 begin
1955   mHoriz := true;
1956   mExpand := true;
1957   mDefSize.h := 1;
1958 end;
1959
1960
1961 // ////////////////////////////////////////////////////////////////////////// //
1962 procedure THCtlVLine.AfterConstruction ();
1963 begin
1964   mHoriz := false;
1965   mExpand := true;
1966   mDefSize.w := 1;
1967   //mDefSize.h := 8;
1968 end;
1969
1970
1971 // ////////////////////////////////////////////////////////////////////////// //
1972 constructor THCtlTextLabel.Create (const atext: AnsiString);
1973 begin
1974   inherited Create();
1975   mText := atext;
1976   mDefSize := TLaySize.Create(Length(atext)*8, 8);
1977 end;
1978
1979
1980 procedure THCtlTextLabel.AfterConstruction ();
1981 begin
1982   inherited AfterConstruction();
1983   mHAlign := -1;
1984   mVAlign := 0;
1985   mCanFocus := false;
1986   if (mDefSize.h <= 0) then mDefSize.h := 8;
1987 end;
1988
1989
1990 function THCtlTextLabel.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
1991 begin
1992   if (strEquCI1251(prname, 'title')) or (strEquCI1251(prname, 'caption')) then
1993   begin
1994     mText := par.expectStrOrId(true);
1995     mDefSize := TLaySize.Create(Length(mText)*8, 8);
1996     result := true;
1997     exit;
1998   end;
1999   if (strEquCI1251(prname, 'textalign')) then
2000   begin
2001     parseTextAlign(par, mHAlign, mVAlign);
2002     result := true;
2003     exit;
2004   end;
2005   result := inherited parseProperty(prname, par);
2006 end;
2007
2008
2009 procedure THCtlTextLabel.drawControl (gx, gy: Integer);
2010 var
2011   xpos, ypos: Integer;
2012 begin
2013   // debug
2014   fillRect(gx, gy, mWidth, mHeight, TGxRGBA.Create(96, 96, 0));
2015   drawRectUI(gx, gy, mWidth, mHeight, TGxRGBA.Create(96, 96, 96));
2016
2017   if (Length(mText) > 0) then
2018   begin
2019          if (mHAlign < 0) then xpos := 0
2020     else if (mHAlign > 0) then xpos := mWidth-Length(mText)*8
2021     else xpos := (mWidth-Length(mText)*8) div 2;
2022
2023          if (mVAlign < 0) then ypos := 0
2024     else if (mVAlign > 0) then ypos := mHeight-8
2025     else ypos := (mHeight-8) div 2;
2026
2027     drawText8(gx+xpos, gy+ypos, mText, TGxRGBA.Create(255, 255, 255));
2028   end;
2029 end;
2030
2031
2032 function THCtlTextLabel.mouseEvent (var ev: THMouseEvent): Boolean;
2033 var
2034   lx, ly: Integer;
2035 begin
2036   result := inherited mouseEvent(ev);
2037   if not result and toLocal(ev.x, ev.y, lx, ly) then
2038   begin
2039     result := true;
2040   end;
2041 end;
2042
2043
2044 function THCtlTextLabel.keyEvent (var ev: THKeyEvent): Boolean;
2045 begin
2046   result := inherited keyEvent(ev);
2047 end;
2048
2049
2050 initialization
2051   registerCtlClass(THCtlHBox, 'hbox');
2052   registerCtlClass(THCtlVBox, 'vbox');
2053   registerCtlClass(THCtlSpan, 'span');
2054   registerCtlClass(THCtlHLine, 'hline');
2055   registerCtlClass(THCtlVLine, 'vline');
2056   registerCtlClass(THCtlTextLabel, 'label');
2057 end.