src/game/g_holmes_ui.inc

   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 // ////////////////////////////////////////////////////////////////////////// //
  17 type
  18   THControl = class
  19   private
  20     mParent: THControl;
  21     mX, mY: Integer;
  22     mWidth, mHeight: Integer;
  23     mEnabled: Boolean;
  24     mCanFocus: Boolean;
  25     mChildren: array of THControl;
  26     mFocused: THControl; // valid only for top-level controls
  27     mGrab: THControl; // valid only for top-level controls
  28     mEscClose: Boolean; // valid only for top-level controls
  29     mEatKeys: Boolean;
  30
  31   protected
  32     function getEnabled (): Boolean;
  33     procedure setEnabled (v: Boolean); inline;
  34
  35     function getFocused (): Boolean; inline;
  36     procedure setFocused (v: Boolean); inline;
  37
  38     function isMyChild (ctl: THControl): Boolean;
  39
  40     function findFirstFocus (): THControl;
  41     function findLastFocus (): THControl;
  42
  43     function findNextFocus (cur: THControl): THControl;
  44     function findPrevFocus (cur: THControl): THControl;
  45
  46     procedure activated (); virtual;
  47     procedure blurred (); virtual;
  48
  49   public
  50     constructor Create (ax, ay, aw, ah: Integer; aparent: THControl=nil);
  51     destructor Destroy (); override;
  52
  53     // `sx` and `sy` are screen coordinates
  54     procedure drawControl (sx, sy: Integer); virtual;
  55
  56     // called after all children drawn
  57     procedure drawControlPost (sx, sy: Integer); virtual;
  58
  59     procedure draw (); virtual;
  60
  61     function topLevel (): THControl; inline;
  62
  63     // returns `true` if global coords are inside this control
  64     function toLocal (var x, y: Integer): Boolean;
  65     procedure toGlobal (var x, y: Integer);
  66
  67     // x and y are global coords
  68     function controlAtXY (x, y: Integer): THControl;
  69
  70     function mouseEvent (var ev: THMouseEvent): Boolean; virtual; // returns `true` if event was eaten
  71     function keyEvent (var ev: THKeyEvent): Boolean; virtual; // returns `true` if event was eaten
  72
  73     function prevSibling (): THControl;
  74     function nextSibling (): THControl;
  75     function firstChild (): THControl; inline;
  76     function lastChild (): THControl; inline;
  77
  78   public
  79     property x0: Integer read mX;
  80     property y0: Integer read mY;
  81     property height: Integer read mHeight;
  82     property width: Integer read mWidth;
  83     property enabled: Boolean read getEnabled write setEnabled;
  84     property parent: THControl read mParent;
  85     property focused: Boolean read getFocused write setFocused;
  86     property escClose: Boolean read mEscClose write mEscClose;
  87     property eatKeys: Boolean read mEatKeys write mEatKeys;
  88   end;
  89
  90
  91   THTopWindow = class(THControl)
  92   private
  93     mTitle: AnsiString;
  94     mDragging: Boolean;
  95     mDragStartX, mDragStartY: Integer;
  96
  97   protected
  98     procedure blurred (); override;
  99
 100   public
 101     constructor Create (const atitle: AnsiString; ax, ay: Integer; aw: Integer=-1; ah: Integer=-1);
 102
 103     procedure appendChild (ctl: THControl);
 104
 105     // `sx` and `sy` are screen coordinates
 106     procedure drawControl (sx, sy: Integer); override;
 107     procedure drawControlPost (sx, sy: Integer); override;
 108
 109     function mouseEvent (var ev: THMouseEvent): Boolean; override; // returns `true` if event was eaten
 110   end;
 111
 112
 113   THCtlCBListBox = class(THControl)
 114   private
 115     mItems: array of AnsiString;
 116     mChecks: array of PBoolean;
 117     mCurIndex: Integer;
 118
 119   public
 120     constructor Create (ax, ay: Integer; aparent: THControl=nil);
 121     destructor Destroy (); override;
 122
 123     procedure appendItem (const atext: AnsiString; bv: PBoolean);
 124
 125     procedure drawControl (sx, sy: Integer); override;
 126
 127     function mouseEvent (var ev: THMouseEvent): Boolean; override;
 128     function keyEvent (var ev: THKeyEvent): Boolean; override;
 129   end;
 130
 131 // ////////////////////////////////////////////////////////////////////////// //
 132 var
 133   uiTopList: array of THControl = nil;
 134
 135
 136 function uiMouseEvent (var ev: THMouseEvent): Boolean;
 137 var
 138   f, c: Integer;
 139   lx, ly: Integer;
 140   ctmp: THControl;
 141 begin
 142   if (Length(uiTopList) = 0) then result := false else result := uiTopList[High(uiTopList)].mouseEvent(ev);
 143   if not result and (ev.kind = ev.Press) then
 144   begin
 145     for f := High(uiTopList) downto 0 do
 146     begin
 147       lx := ev.x;
 148       ly := ev.y;
 149       if uiTopList[f].toLocal(lx, ly) then
 150       begin
 151         result := true;
 152         if uiTopList[f].mEnabled and (f <> High(uiTopList)) then
 153         begin
 154           uiTopList[High(uiTopList)].blurred();
 155           ctmp := uiTopList[f];
 156           ctmp.mGrab := nil;
 157           for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
 158           uiTopList[High(uiTopList)] := ctmp;
 159           ctmp.activated();
 160           result := ctmp.mouseEvent(ev);
 161         end;
 162         exit;
 163       end;
 164     end;
 165   end;
 166 end;
 167
 168
 169 function uiKeyEvent (var ev: THKeyEvent): Boolean;
 170 begin
 171   if (Length(uiTopList) = 0) then result := false else result := uiTopList[High(uiTopList)].keyEvent(ev);
 172   if (ev.kind = ev.Release) then begin result := true; exit; end;
 173 end;
 174
 175
 176 procedure uiDraw ();
 177 var
 178   f: Integer;
 179   ctl: THControl;
 180 begin
 181   for f := 0 to High(uiTopList) do
 182   begin
 183     ctl := uiTopList[f];
 184     ctl.draw();
 185     if (f <> High(uiTopList)) then darkenRect(ctl.x0, ctl.y0, ctl.width, ctl.height, 128);
 186   end;
 187 end;
 188
 189
 190 procedure uiAddWindow (ctl: THControl);
 191 var
 192   f, c: Integer;
 193 begin
 194   if (ctl = nil) then exit;
 195   ctl := ctl.topLevel;
 196   for f := 0 to High(uiTopList) do
 197   begin
 198     if (uiTopList[f] = ctl) then
 199     begin
 200       if (f <> High(uiTopList)) then
 201       begin
 202         uiTopList[High(uiTopList)].blurred();
 203         for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
 204         uiTopList[High(uiTopList)] := ctl;
 205         ctl.activated();
 206       end;
 207       exit;
 208     end;
 209   end;
 210   if (Length(uiTopList) > 0) then uiTopList[High(uiTopList)].blurred();
 211   SetLength(uiTopList, Length(uiTopList)+1);
 212   uiTopList[High(uiTopList)] := ctl;
 213   ctl.activated();
 214 end;
 215
 216
 217 // won't free object
 218 procedure uiRemoveWindow (ctl: THControl);
 219 var
 220   f, c: Integer;
 221 begin
 222   if (ctl = nil) then exit;
 223   ctl := ctl.topLevel;
 224   for f := 0 to High(uiTopList) do
 225   begin
 226     if (uiTopList[f] = ctl) then
 227     begin
 228       ctl.blurred();
 229       for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
 230       SetLength(uiTopList, Length(uiTopList)-1);
 231       exit;
 232     end;
 233   end;
 234 end;
 235
 236
 237 function uiVisibleWindow (ctl: THControl): Boolean;
 238 var
 239   f: Integer;
 240 begin
 241   result := false;
 242   if (ctl = nil) then exit;
 243   ctl := ctl.topLevel;
 244   for f := 0 to High(uiTopList) do
 245   begin
 246     if (uiTopList[f] = ctl) then begin result := true; exit; end;
 247   end;
 248 end;
 249
 250
 251 // ////////////////////////////////////////////////////////////////////////// //
 252 constructor THControl.Create (ax, ay, aw, ah: Integer; aparent: THControl=nil);
 253 begin
 254   mParent := aparent;
 255   mX := ax;
 256   mY := ay;
 257   mWidth := aw;
 258   mHeight := ah;
 259   mEnabled := true;
 260   mCanFocus := true;
 261   mChildren := nil;
 262   mFocused := nil;
 263   mGrab := nil;
 264   mEscClose := false;
 265   mEatKeys := false;
 266 end;
 267
 268
 269 destructor THControl.Destroy ();
 270 var
 271   f, c: Integer;
 272 begin
 273   if (mParent <> nil) then
 274   begin
 275     setFocused(false);
 276     for f := 0 to High(mParent.mChildren) do
 277     begin
 278       if (mParent.mChildren[f] = self) then
 279       begin
 280         for c := f+1 to High(mParent.mChildren) do mParent.mChildren[c-1] := mParent.mChildren[c];
 281         SetLength(mParent.mChildren, Length(mParent.mChildren)-1);
 282       end;
 283     end;
 284   end;
 285   for f := 0 to High(mChildren) do
 286   begin
 287     mChildren[f].mParent := nil;
 288     mChildren[f].Free();
 289   end;
 290   mChildren := nil;
 291 end;
 292
 293
 294 procedure THControl.activated ();
 295 begin
 296 end;
 297
 298
 299 procedure THControl.blurred ();
 300 begin
 301   mGrab := nil;
 302 end;
 303
 304
 305 function THControl.topLevel (): THControl; inline;
 306 begin
 307   result := self;
 308   while (result.mParent <> nil) do result := result.mParent;
 309 end;
 310
 311
 312 function THControl.getEnabled (): Boolean;
 313 var
 314   ctl: THControl;
 315 begin
 316   result := false;
 317   if (not mEnabled) or (mWidth < 1) or (mHeight < 1) then exit;
 318   ctl := mParent;
 319   while (ctl <> nil) do
 320   begin
 321     if (not ctl.mEnabled) or (ctl.mWidth < 1) or (ctl.mHeight < 1) then exit;
 322     ctl := ctl.mParent;
 323   end;
 324   result := true;
 325 end;
 326
 327
 328 procedure THControl.setEnabled (v: Boolean); inline;
 329 begin
 330   if (mEnabled = v) then exit;
 331   mEnabled := v;
 332   if not v and focused then setFocused(false);
 333 end;
 334
 335
 336 function THControl.getFocused (): Boolean; inline;
 337 begin
 338   if (mParent = nil) then result := (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)] = self) else result := (topLevel.mFocused = self);
 339 end;
 340
 341
 342 procedure THControl.setFocused (v: Boolean); inline;
 343 var
 344   tl: THControl;
 345 begin
 346   tl := topLevel;
 347   if not v then
 348   begin
 349     if (tl.mFocused = self) then
 350     begin
 351       tl.blurred();
 352       tl.mFocused := tl.findNextFocus(self);
 353       if (tl.mFocused = self) then tl.mFocused := nil;
 354     end;
 355     exit;
 356   end;
 357   if (not mEnabled) or (not mCanFocus) then exit;
 358   if (tl.mFocused <> self) then
 359   begin
 360     tl.mFocused.blurred();
 361     tl.mFocused := self;
 362     if (tl.mGrab <> self) then tl.mGrab := nil;
 363     activated();
 364   end;
 365 end;
 366
 367
 368 function THControl.isMyChild (ctl: THControl): Boolean;
 369 begin
 370   result := true;
 371   while (ctl <> nil) do
 372   begin
 373     if (ctl.mParent = self) then exit;
 374     ctl := ctl.mParent;
 375   end;
 376   result := false;
 377 end;
 378
 379
 380 // returns `true` if global coords are inside this control
 381 function THControl.toLocal (var x, y: Integer): Boolean;
 382 var
 383   ctl: THControl;
 384 begin
 385   ctl := self;
 386   while (ctl <> nil) do
 387   begin
 388     Dec(x, ctl.mX);
 389     Dec(y, ctl.mY);
 390     ctl := ctl.mParent;
 391   end;
 392   result := (x >= 0) and (y >= 0) and (x < mWidth) and (y < mHeight);
 393 end;
 394
 395
 396 procedure THControl.toGlobal (var x, y: Integer);
 397 var
 398   ctl: THControl;
 399 begin
 400   ctl := self;
 401   while (ctl <> nil) do
 402   begin
 403     Inc(x, ctl.mX);
 404     Inc(y, ctl.mY);
 405     ctl := ctl.mParent;
 406   end;
 407 end;
 408
 409
 410 // x and y are global coords
 411 function THControl.controlAtXY (x, y: Integer): THControl;
 412 var
 413   lx, ly: Integer;
 414   f: Integer;
 415 begin
 416   result := nil;
 417   if (not mEnabled) or (mWidth < 1) or (mHeight < 1) then exit;
 418   lx := x;
 419   ly := y;
 420   if not toLocal(lx, ly) then exit;
 421   for f := High(mChildren) downto 0 do
 422   begin
 423     result := mChildren[f].controlAtXY(x, y);
 424     if (result <> nil) then exit;
 425   end;
 426   result := self;
 427 end;
 428
 429
 430 function THControl.prevSibling (): THControl;
 431 var
 432   f: Integer;
 433 begin
 434   if (mParent <> nil) then
 435   begin
 436     for f := 1 to High(mParent.mChildren) do
 437     begin
 438       if (mParent.mChildren[f] = self) then begin result := mParent.mChildren[f-1]; exit; end;
 439     end;
 440   end;
 441   result := nil;
 442 end;
 443
 444 function THControl.nextSibling (): THControl;
 445 var
 446   f: Integer;
 447 begin
 448   if (mParent <> nil) then
 449   begin
 450     for f := 0 to High(mParent.mChildren)-1 do
 451     begin
 452       if (mParent.mChildren[f] = self) then begin result := mParent.mChildren[f+1]; exit; end;
 453     end;
 454   end;
 455   result := nil;
 456 end;
 457
 458 function THControl.firstChild (): THControl; inline;
 459 begin
 460   if (Length(mChildren) <> 0) then result := mChildren[0] else result := nil;
 461 end;
 462
 463 function THControl.lastChild (): THControl; inline;
 464 begin
 465   if (Length(mChildren) <> 0) then result := mChildren[High(mChildren)] else result := nil;
 466 end;
 467
 468
 469 function THControl.findFirstFocus (): THControl;
 470 var
 471   f: Integer;
 472 begin
 473   result := nil;
 474   if enabled then
 475   begin
 476     for f := 0 to High(mChildren) do
 477     begin
 478       result := mChildren[f].findFirstFocus();
 479       if (result <> nil) then exit;
 480     end;
 481     if mCanFocus then result := self;
 482   end;
 483 end;
 484
 485
 486 function THControl.findLastFocus (): THControl;
 487 var
 488   f: Integer;
 489 begin
 490   result := nil;
 491   if enabled then
 492   begin
 493     for f := High(mChildren) downto 0 do
 494     begin
 495       result := mChildren[f].findLastFocus();
 496       if (result <> nil) then exit;
 497     end;
 498     if mCanFocus then result := self;
 499   end;
 500 end;
 501
 502
 503 function THControl.findNextFocus (cur: THControl): THControl;
 504 begin
 505   result := nil;
 506   if enabled then
 507   begin
 508     if not isMyChild(cur) then cur := nil;
 509     if (cur = nil) then begin result := findFirstFocus(); exit; end;
 510     result := cur.findFirstFocus();
 511     if (result <> nil) and (result <> cur) then exit;
 512     while true do
 513     begin
 514       cur := cur.nextSibling;
 515       if (cur = nil) then break;
 516       result := cur.findFirstFocus();
 517       if (result <> nil) then exit;
 518     end;
 519     result := findFirstFocus();
 520   end;
 521 end;
 522
 523
 524 function THControl.findPrevFocus (cur: THControl): THControl;
 525 begin
 526   result := nil;
 527   if enabled then
 528   begin
 529     if not isMyChild(cur) then cur := nil;
 530     if (cur = nil) then begin result := findLastFocus(); exit; end;
 531     //FIXME!
 532     result := cur.findLastFocus();
 533     if (result <> nil) and (result <> cur) then exit;
 534     while true do
 535     begin
 536       cur := cur.prevSibling;
 537       if (cur = nil) then break;
 538       result := cur.findLastFocus();
 539       if (result <> nil) then exit;
 540     end;
 541     result := findLastFocus();
 542   end;
 543 end;
 544
 545
 546 procedure THControl.draw ();
 547 var
 548   f: Integer;
 549   x, y: Integer;
 550   scxywh: array[0..3] of GLint;
 551   wassc: Boolean;
 552
 553   procedure setScissor (x, y, w, h: Integer);
 554   var
 555     x1, y1: Integer;
 556     sx0, sy0: Integer;
 557     sx1, sy1: Integer;
 558   begin
 559     if (w < 1) or (h < 1) or (scxywh[2] < 1) or (scxywh[3] < 1) then begin glScissor(0, 0, 0, 0); exit; end;
 560     x1 := x+w-1;
 561     y1 := y+h-1;
 562     sx0 := scxywh[0];
 563     sy0 := scxywh[1];
 564     sx1 := sx0+scxywh[2]-1;
 565     sy1 := sy0+scxywh[3]-1;
 566     //conwritefln('0: (%d,%d)-(%d,%d)  (%d,%d)-(%d,%d)', [sx0, sy0, sx1, sy1, x, y, x1, y1]);
 567     if (x1 < sx0) or (y1 < sy0) or (x > sx1) or (y > sy1) then begin glScissor(0, 0, 0, 0); exit; end;
 568     if (x < sx0) then x := sx0;
 569     if (y < sy0) then y := sy0;
 570     if (x1 > sx1) then x1 := sx1;
 571     if (y1 > sy1) then y1 := sy1;
 572     //conwritefln('1: (%d,%d)-(%d,%d)  (%d,%d)-(%d,%d)', [sx0, sy0, sx1, sy1, x, y, x1, y1]);
 573     glScissor(x, y, x1-x+1, y1-y+1);
 574   end;
 575
 576 begin
 577   if (mWidth < 1) or (mHeight < 1) then exit;
 578   x := 0;
 579   y := 0;
 580   toGlobal(x, y);
 581   //conwritefln('[%s]: (%d,%d)-(%d,%d)  (%d,%d)', [ClassName, mX, mY, mWidth, mHeight, x, y]);
 582
 583   scxywh[0] := 0;
 584   scxywh[1] := 0;
 585   scxywh[2] := 0;
 586   scxywh[3] := 0;
 587
 588   wassc := (glIsEnabled(GL_SCISSOR_TEST) <> 0);
 589   if wassc then
 590   begin
 591     glGetIntegerv(GL_SCISSOR_BOX, @scxywh[0]);
 592   end
 593   else
 594   begin
 595     glGetIntegerv(GL_VIEWPORT, @scxywh[0]);
 596   end;
 597   //conwritefln('(%d,%d)-(%d,%d)', [scxywh[0], scxywh[1], scxywh[2], scxywh[3]]);
 598
 599   glEnable(GL_SCISSOR_TEST);
 600   setScissor(x, gWinSizeY-(y+mHeight-1)-1, mWidth, mHeight);
 601
 602   drawControl(x, y);
 603   if (mParent = nil) then setScissor(x+2, gWinSizeY-(y+mHeight-1-2)-1, mWidth-4, mHeight-14);
 604   for f := 0 to High(mChildren) do mChildren[f].draw();
 605   if (mParent = nil) then setScissor(x, gWinSizeY-(y+mHeight-1)-1, mWidth, mHeight);
 606   drawControlPost(x, y);
 607   glScissor(scxywh[0], scxywh[1], scxywh[2], scxywh[3]);
 608   if wassc then glEnable(GL_SCISSOR_TEST) else glDisable(GL_SCISSOR_TEST);
 609 end;
 610
 611
 612 procedure THControl.drawControl (sx, sy: Integer);
 613 begin
 614   if (mParent = nil) then darkenRect(sx, sy, mWidth, mHeight, 64);
 615   //fillRect(sx, sy, mWidth, mHeight, 0, 0, 255, 120);
 616 end;
 617
 618
 619 procedure THControl.drawControlPost (sx, sy: Integer);
 620 begin
 621 end;
 622
 623
 624 function THControl.mouseEvent (var ev: THMouseEvent): Boolean;
 625 var
 626   ctl: THControl;
 627 begin
 628   result := false;
 629   if not mEnabled then exit;
 630   if (mParent = nil) then
 631   begin
 632     if (mGrab <> nil) then
 633     begin
 634       result := mGrab.mouseEvent(ev);
 635       if (ev.kind = ev.Release) then mGrab := nil;
 636       exit;
 637     end;
 638   end;
 639   if (mWidth < 1) or (mHeight < 1) then exit;
 640   ctl := controlAtXY(ev.x, ev.y);
 641   if (ctl <> nil) and (ctl <> self) then
 642   begin
 643     if (ctl <> topLevel.mFocused) then ctl.setFocused(true);
 644     result := ctl.mouseEvent(ev);
 645   end;
 646 end;
 647
 648
 649 function THControl.keyEvent (var ev: THKeyEvent): Boolean;
 650 var
 651   ctl: THControl;
 652 begin
 653   result := false;
 654   if not mEnabled then exit;
 655   if (topLevel.mFocused <> self) and isMyChild(topLevel.mFocused) and topLevel.mFocused.mEnabled then result := topLevel.mFocused.keyEvent(ev);
 656   if (mParent = nil) then
 657   begin
 658     if (ev.kstate = THKeyEvent.ModShift) and (ev.scan = SDL_SCANCODE_TAB) then
 659     begin
 660       result := true;
 661       if (ev.kind = ev.Press) then
 662       begin
 663         ctl := findPrevFocus(mFocused);
 664         if (ctl <> mFocused) then
 665         begin
 666           mGrab := nil;
 667           mFocused := ctl;
 668         end;
 669       end;
 670       exit;
 671     end;
 672     if (ev.kstate = 0) and (ev.scan = SDL_SCANCODE_TAB) then
 673     begin
 674       result := true;
 675       if (ev.kind = ev.Press) then
 676       begin
 677         ctl := findNextFocus(mFocused);
 678         if (ctl <> mFocused) then
 679         begin
 680           mGrab := nil;
 681           mFocused := ctl;
 682         end;
 683       end;
 684       exit;
 685     end;
 686     if mEscClose and (ev.kind = ev.Press) and (ev.kstate = 0) and (ev.scan = SDL_SCANCODE_ESCAPE) then
 687     begin
 688       result := true;
 689       uiRemoveWindow(self);
 690       exit;
 691     end;
 692   end;
 693   if mEatKeys then result := true;
 694 end;
 695
 696
 697 // ////////////////////////////////////////////////////////////////////////// //
 698 constructor THTopWindow.Create (const atitle: AnsiString; ax, ay: Integer; aw: Integer=-1; ah: Integer=-1);
 699 begin
 700   mTitle := atitle;
 701   if (Length(mTitle) > 0) then
 702   begin
 703     if (ah < 14) then ah := 14;
 704     if (aw < Length(mTitle)*8+4) then aw := Length(mTitle)*8+4;
 705   end
 706   else
 707   begin
 708     if (ah < 4) then ah := 4;
 709     if (aw < 4) then aw := 4;
 710   end;
 711   mDragging := false;
 712   inherited Create(ax, ay, aw, ah, nil);
 713 end;
 714
 715
 716 procedure THTopWindow.appendChild (ctl: THControl);
 717 var
 718   myofs: Integer;
 719 begin
 720   if (ctl = nil) then exit;
 721   if (ctl.mParent <> nil) then exit;
 722   if (Length(mTitle) > 0) then myofs := 12 else myofs := 2;
 723   SetLength(mChildren, Length(mChildren)+1);
 724   mChildren[High(mChildren)] := ctl;
 725   ctl.mParent := self;
 726   Inc(ctl.mX, 2);
 727   Inc(ctl.mY, myofs);
 728   if (ctl.mWidth > 0) and (ctl.mHeight > 0) and
 729      (ctl.mX+ctl.mWidth > 2) and (ctl.mY+ctl.mHeight > myofs-2) then
 730   begin
 731     if (mWidth+2 < ctl.mX+ctl.mWidth) then mWidth := ctl.mX+ctl.mWidth+2;
 732     if (mHeight+2 < ctl.mY+ctl.mHeight) then mHeight := ctl.mY+ctl.mHeight+2;
 733   end;
 734   if (mFocused = nil) and ctl.mEnabled and ctl.mCanFocus and (ctl.mWidth > 0) and (ctl.mHeight > 0) then mFocused := ctl;
 735 end;
 736
 737
 738 procedure THTopWindow.drawControl (sx, sy: Integer);
 739 begin
 740   //if (mParent = nil) then darkenRect(sx, sy, mWidth, mHeight, 200);
 741   fillRect(sx, sy, mWidth, mHeight, 0, 0, 128);
 742 end;
 743
 744
 745 procedure THTopWindow.drawControlPost (sx, sy: Integer);
 746 var
 747   r, g, b: Integer;
 748 begin
 749   {
 750   if getFocused then
 751   begin
 752     r := 255;
 753     g := 255;
 754     b := 255;
 755   end
 756   else
 757   begin
 758     r := 127;
 759     g := 127;
 760     b := 127;
 761   end;
 762   }
 763   r := 255;
 764   g := 255;
 765   b := 255;
 766   drawRect(mX, mY, mWidth, mHeight, r, g, b);
 767   if (Length(mTitle) > 0) then
 768   begin
 769     fillRect(mX+1, mY+1, mWidth-2, 9, r, g, b);
 770     drawText8(mX+2, mY+1, mTitle, 0, 0, 0);
 771   end;
 772 end;
 773
 774
 775 procedure THTopWindow.blurred ();
 776 begin
 777   mDragging := false;
 778   inherited;
 779 end;
 780
 781
 782 function THTopWindow.mouseEvent (var ev: THMouseEvent): Boolean;
 783 var
 784   lx, ly: Integer;
 785 begin
 786   result := false;
 787   if not mEnabled then exit;
 788   if (mWidth < 1) or (mHeight < 1) then exit;
 789
 790   if mDragging then
 791   begin
 792     mX += ev.x-mDragStartX;
 793     mY += ev.y-mDragStartY;
 794     mDragStartX := ev.x;
 795     mDragStartY := ev.y;
 796     if (ev.kind = ev.Release) then mDragging := false;
 797     result := true;
 798     exit;
 799   end;
 800
 801   if (ev.kind = ev.Press) and (ev.but = ev.Left) then
 802   begin
 803     lx := ev.x;
 804     ly := ev.y;
 805     if toLocal(lx, ly) then
 806     begin
 807       if ((Length(mTitle) > 0) and (ly < 12)) or ((Length(mTitle) = 0) and (ly < 2)) then
 808       begin
 809         mDragging := true;
 810         mDragStartX := ev.x;
 811         mDragStartY := ev.y;
 812         result := true;
 813         exit;
 814       end;
 815     end;
 816   end;
 817
 818   result := inherited mouseEvent(ev);
 819 end;
 820
 821
 822 // ////////////////////////////////////////////////////////////////////////// //
 823 constructor THCtlCBListBox.Create (ax, ay: Integer; aparent: THControl=nil);
 824 begin
 825   mItems := nil;
 826   mChecks := nil;
 827   mCurIndex := -1;
 828   inherited Create(ax, ay, 4, 4);
 829 end;
 830
 831
 832 destructor THCtlCBListBox.Destroy ();
 833 begin
 834   mItems := nil;
 835   mChecks := nil;
 836   inherited;
 837 end;
 838
 839
 840 procedure THCtlCBListBox.appendItem (const atext: AnsiString; bv: PBoolean);
 841 begin
 842   if (Length(atext)*8+4+3*8+2 > mWidth) then mWidth := Length(atext)*8+4+3*8+2;
 843   SetLength(mItems, Length(mItems)+1);
 844   mItems[High(mItems)] := atext;
 845   SetLength(mChecks, Length(mChecks)+1);
 846   mChecks[High(mChecks)] := bv;
 847   if (Length(mItems)*8+4 > mHeight) then mHeight := Length(mItems)*8+4;
 848   if (mCurIndex < 0) then mCurIndex := 0;
 849 end;
 850
 851
 852 procedure THCtlCBListBox.drawControl (sx, sy: Integer);
 853 var
 854   f: Integer;
 855 begin
 856   //fillRect(sx, sy, mWidth, mHeight, 0, 128, 0);
 857   Inc(sx, 2);
 858   Inc(sy, 2);
 859   for f := 0 to High(mItems) do
 860   begin
 861     if (mCurIndex = f) then fillRect(sx-2, sy, mWidth, 8, 0, 128, 0);
 862     if (mChecks[f] <> nil) then
 863     begin
 864       drawText8(sx, sy, '[ ]', 255, 255, 255);
 865       if mChecks[f]^ then drawText8(sx+6, sy, 'x', 255, 255, 255);
 866       drawText8(sx+3*8+2, sy, mItems[f], 255, 255, 0);
 867     end;
 868     Inc(sy, 8);
 869   end;
 870 end;
 871
 872
 873 function THCtlCBListBox.mouseEvent (var ev: THMouseEvent): Boolean;
 874 var
 875   lx, ly: Integer;
 876 begin
 877   result := inherited mouseEvent(ev);
 878   if not result and (Length(mItems) > 0) and (ev.kind = ev.Press) then
 879   begin
 880     lx := ev.x;
 881     ly := ev.y;
 882     if toLocal(lx, ly) then
 883     begin
 884       if (ly < 2) then ly := 2;
 885       ly := ly div 8;
 886       if (ly < 0) then ly := 0 else if (ly > High(mItems)) then ly := High(mItems);
 887       mCurIndex := ly;
 888       if (mChecks[ly] <> nil) then mChecks[ly]^ := not mChecks[ly]^;
 889     end;
 890   end;
 891 end;
 892
 893
 894 function THCtlCBListBox.keyEvent (var ev: THKeyEvent): Boolean;
 895 begin
 896   result := inherited keyEvent(ev);
 897   if not getFocused then exit;
 898   //result := true;
 899   if (ev.kstate = 0) and (ev.kind = ev.Press) then
 900   begin
 901     case ev.scan of
 902       SDL_SCANCODE_HOME,
 903       SDL_SCANCODE_PAGEUP:
 904         begin
 905           result := true;
 906           mCurIndex := 0;
 907         end;
 908       SDL_SCANCODE_END,
 909       SDL_SCANCODE_PAGEDOWN:
 910         begin
 911           result := true;
 912           mCurIndex := High(mItems);
 913         end;
 914       SDL_SCANCODE_UP:
 915         begin
 916           result := true;
 917           if (Length(mItems) > 0) then
 918           begin
 919             if (mCurIndex < 0) then mCurIndex := Length(mItems);
 920             while (mCurIndex > 0) do
 921             begin
 922               Dec(mCurIndex);
 923               if (mChecks[mCurIndex] <> nil) then break;
 924             end;
 925           end
 926           else
 927           begin
 928             mCurIndex := -1;
 929           end;
 930         end;
 931       SDL_SCANCODE_DOWN:
 932         begin
 933           result := true;
 934           if (Length(mItems) > 0) then
 935           begin
 936             if (mCurIndex < 0) then mCurIndex := -1;
 937             while (mCurIndex < High(mItems)) do
 938             begin
 939               Inc(mCurIndex);
 940               if (mChecks[mCurIndex] <> nil) then break;
 941             end;
 942           end
 943           else
 944           begin
 945             mCurIndex := -1;
 946           end;
 947         end;
 948       SDL_SCANCODE_SPACE,
 949       SDL_SCANCODE_RETURN:
 950         begin
 951           result := true;
 952           if (mCurIndex >= 0) and (mCurIndex < Length(mChecks)) and (mChecks[mCurIndex] <> nil) then mChecks[mCurIndex]^ := not mChecks[mCurIndex]^;
 953         end;
 954     end;
 955   end;
 956 end;