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