src/game/g_gui.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 {$MODE DELPHI}
  17 unit g_gui;
  18
  19 interface
  20
  21 uses
  22   e_graphics, e_input, e_log, g_playermodel, g_basic, MAPSTRUCT, wadreader;
  23
  24 const
  25   MAINMENU_HEADER_COLOR: TRGB = (R:255; G:255; B:255);
  26   MAINMENU_ITEMS_COLOR: TRGB = (R:255; G:255; B:255);
  27   MAINMENU_UNACTIVEITEMS_COLOR: TRGB = (R:192; G:192; B:192);
  28   MAINMENU_CLICKSOUND = 'MENU_SELECT';
  29   MAINMENU_CHANGESOUND = 'MENU_CHANGE';
  30   MAINMENU_SPACE = 4;
  31   MAINMENU_MARKER1 = 'MAINMENU_MARKER1';
  32   MAINMENU_MARKER2 = 'MAINMENU_MARKER2';
  33   MAINMENU_MARKERDELAY = 24;
  34   WINDOW_CLOSESOUND = 'MENU_CLOSE';
  35   MENU_HEADERCOLOR: TRGB = (R:255; G:255; B:255);
  36   MENU_ITEMSTEXT_COLOR: TRGB = (R:255; G:255; B:255);
  37   MENU_UNACTIVEITEMS_COLOR: TRGB = (R:128; G:128; B:128);
  38   MENU_ITEMSCTRL_COLOR: TRGB = (R:255; G:0; B:0);
  39   MENU_VSPACE = 2;
  40   MENU_HSPACE = 32;
  41   MENU_CLICKSOUND = 'MENU_SELECT';
  42   MENU_CHANGESOUND = 'MENU_CHANGE';
  43   MENU_MARKERDELAY = 24;
  44   SCROLL_LEFT = 'SCROLL_LEFT';
  45   SCROLL_RIGHT = 'SCROLL_RIGHT';
  46   SCROLL_MIDDLE = 'SCROLL_MIDDLE';
  47   SCROLL_MARKER = 'SCROLL_MARKER';
  48   SCROLL_ADDSOUND = 'SCROLL_ADD';
  49   SCROLL_SUBSOUND = 'SCROLL_SUB';
  50   EDIT_LEFT = 'EDIT_LEFT';
  51   EDIT_RIGHT = 'EDIT_RIGHT';
  52   EDIT_MIDDLE = 'EDIT_MIDDLE';
  53   EDIT_CURSORCOLOR: TRGB = (R:200; G:0; B:0);
  54   EDIT_CURSORLEN = 10;
  55   KEYREAD_QUERY = '<...>';
  56   KEYREAD_CLEAR = '???';
  57   KEYREAD_TIMEOUT = 24;
  58   MAPPREVIEW_WIDTH = 8;
  59   MAPPREVIEW_HEIGHT = 8;
  60   BOX1 = 'BOX1';
  61   BOX2 = 'BOX2';
  62   BOX3 = 'BOX3';
  63   BOX4 = 'BOX4';
  64   BOX5 = 'BOX5';
  65   BOX6 = 'BOX6';
  66   BOX7 = 'BOX7';
  67   BOX8 = 'BOX8';
  68   BOX9 = 'BOX9';
  69   BSCROLL_UPA = 'BSCROLL_UP_A';
  70   BSCROLL_UPU = 'BSCROLL_UP_U';
  71   BSCROLL_DOWNA = 'BSCROLL_DOWN_A';
  72   BSCROLL_DOWNU = 'BSCROLL_DOWN_U';
  73   BSCROLL_MIDDLE = 'BSCROLL_MIDDLE';
  74   WM_KEYDOWN = 101;
  75   WM_CHAR    = 102;
  76   WM_USER    = 110;
  77
  78 type
  79   TMessage = record
  80     Msg: DWORD;
  81     wParam: LongInt;
  82     lParam: LongInt;
  83   end;
  84
  85   TFontType = (FONT_TEXTURE, FONT_CHAR);
  86
  87   TFont = class(TObject)
  88   private
  89     ID: DWORD;
  90     FScale: Single;
  91     FFontType: TFontType;
  92   public
  93     constructor Create(FontID: DWORD; FontType: TFontType);
  94     destructor Destroy; override;
  95     procedure Draw(X, Y: Integer; Text: string; R, G, B: Byte);
  96     procedure GetTextSize(Text: string; var w, h: Word);
  97     property Scale: Single read FScale write FScale;
  98   end;
  99
 100   TGUIControl = class;
 101   TGUIWindow = class;
 102
 103   TOnKeyDownEvent = procedure(Key: Byte);
 104   TOnKeyDownEventEx = procedure(win: TGUIWindow; Key: Byte);
 105   TOnCloseEvent = procedure;
 106   TOnShowEvent = procedure;
 107   TOnClickEvent = procedure;
 108   TOnChangeEvent = procedure(Sender: TGUIControl);
 109   TOnEnterEvent = procedure(Sender: TGUIControl);
 110
 111   TGUIControl = class
 112   private
 113     FX, FY: Integer;
 114     FEnabled: Boolean;
 115     FWindow : TGUIWindow;
 116     FName: string;
 117     FUserData: Pointer;
 118   public
 119     constructor Create;
 120     procedure OnMessage(var Msg: TMessage); virtual;
 121     procedure Update; virtual;
 122     procedure Draw; virtual;
 123     function WantActivationKey (key: LongInt): Boolean; virtual;
 124     property X: Integer read FX write FX;
 125     property Y: Integer read FY write FY;
 126     property Enabled: Boolean read FEnabled write FEnabled;
 127     property Name: string read FName write FName;
 128     property UserData: Pointer read FUserData write FUserData;
 129   end;
 130
 131   TGUIWindow = class
 132   private
 133     FActiveControl: TGUIControl;
 134     FDefControl: string;
 135     FPrevWindow: TGUIWindow;
 136     FName: string;
 137     FBackTexture: string;
 138     FMainWindow: Boolean;
 139     FOnKeyDown: TOnKeyDownEvent;
 140     FOnKeyDownEx: TOnKeyDownEventEx;
 141     FOnCloseEvent: TOnCloseEvent;
 142     FOnShowEvent: TOnShowEvent;
 143     FUserData: Pointer;
 144   public
 145     Childs: array of TGUIControl;
 146     constructor Create(Name: string);
 147     destructor Destroy; override;
 148     function AddChild(Child: TGUIControl): TGUIControl;
 149     procedure OnMessage(var Msg: TMessage);
 150     procedure Update;
 151     procedure Draw;
 152     procedure SetActive(Control: TGUIControl);
 153     function GetControl(Name: string): TGUIControl;
 154     property OnKeyDown: TOnKeyDownEvent read FOnKeyDown write FOnKeyDown;
 155     property OnKeyDownEx: TOnKeyDownEventEx read FOnKeyDownEx write FOnKeyDownEx;
 156     property OnClose: TOnCloseEvent read FOnCloseEvent write FOnCloseEvent;
 157     property OnShow: TOnShowEvent read FOnShowEvent write FOnShowEvent;
 158     property Name: string read FName;
 159     property DefControl: string read FDefControl write FDefControl;
 160     property BackTexture: string read FBackTexture write FBackTexture;
 161     property MainWindow: Boolean read FMainWindow write FMainWindow;
 162     property UserData: Pointer read FUserData write FUserData;
 163   end;
 164
 165   TGUITextButton = class(TGUIControl)
 166   private
 167     FText: string;
 168     FColor: TRGB;
 169     FFont: TFont;
 170     FSound: string;
 171     FShowWindow: string;
 172   public
 173     Proc: procedure;
 174     ProcEx: procedure (sender: TGUITextButton);
 175     constructor Create(Proc: Pointer; FontID: DWORD; Text: string);
 176     destructor Destroy(); override;
 177     procedure OnMessage(var Msg: TMessage); override;
 178     procedure Update(); override;
 179     procedure Draw(); override;
 180     function GetWidth(): Integer;
 181     function GetHeight(): Integer;
 182     procedure Click(Silent: Boolean = False);
 183     property Caption: string read FText write FText;
 184     property Color: TRGB read FColor write FColor;
 185     property Font: TFont read FFont write FFont;
 186     property ShowWindow: string read FShowWindow write FShowWindow;
 187   end;
 188
 189   TGUILabel = class(TGUIControl)
 190   private
 191     FText: string;
 192     FColor: TRGB;
 193     FFont: TFont;
 194     FFixedLen: Word;
 195     FOnClickEvent: TOnClickEvent;
 196   public
 197     constructor Create(Text: string; FontID: DWORD);
 198     procedure OnMessage(var Msg: TMessage); override;
 199     procedure Draw; override;
 200     function GetWidth: Integer;
 201     function GetHeight: Integer;
 202     property OnClick: TOnClickEvent read FOnClickEvent write FOnClickEvent;
 203     property FixedLength: Word read FFixedLen write FFixedLen;
 204     property Text: string read FText write FText;
 205     property Color: TRGB read FColor write FColor;
 206     property Font: TFont read FFont write FFont;
 207   end;
 208
 209   TGUIScroll = class(TGUIControl)
 210   private
 211     FValue: Integer;
 212     FMax: Word;
 213     FLeftID: DWORD;
 214     FRightID: DWORD;
 215     FMiddleID: DWORD;
 216     FMarkerID: DWORD;
 217     FOnChangeEvent: TOnChangeEvent;
 218     procedure FSetValue(a: Integer);
 219   public
 220     constructor Create();
 221     procedure OnMessage(var Msg: TMessage); override;
 222     procedure Update; override;
 223     procedure Draw; override;
 224     function GetWidth(): Word;
 225     property OnChange: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent;
 226     property Max: Word read FMax write FMax;
 227     property Value: Integer read FValue write FSetValue;
 228  end;
 229
 230   TGUISwitch = class(TGUIControl)
 231   private
 232     FFont: TFont;
 233     FItems: array of string;
 234     FIndex: Integer;
 235     FColor: TRGB;
 236     FOnChangeEvent: TOnChangeEvent;
 237   public
 238     constructor Create(FontID: DWORD);
 239     procedure OnMessage(var Msg: TMessage); override;
 240     procedure AddItem(Item: string);
 241     procedure Update; override;
 242     procedure Draw; override;
 243     function GetWidth(): Word;
 244     function GetText: string;
 245     property ItemIndex: Integer read FIndex write FIndex;
 246     property Color: TRGB read FColor write FColor;
 247     property Font: TFont read FFont write FFont;
 248     property OnChange: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent;
 249   end;
 250
 251   TGUIEdit = class(TGUIControl)
 252   private
 253     FFont: TFont;
 254     FCaretPos: Integer;
 255     FMaxLength: Word;
 256     FWidth: Word;
 257     FText: string;
 258     FColor: TRGB;
 259     FOnlyDigits: Boolean;
 260     FLeftID: DWORD;
 261     FRightID: DWORD;
 262     FMiddleID: DWORD;
 263     FOnChangeEvent: TOnChangeEvent;
 264     FOnEnterEvent: TOnEnterEvent;
 265     procedure SetText(Text: string);
 266   public
 267     constructor Create(FontID: DWORD);
 268     procedure OnMessage(var Msg: TMessage); override;
 269     procedure Update; override;
 270     procedure Draw; override;
 271     function GetWidth(): Word;
 272     property OnChange: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent;
 273     property OnEnter: TOnEnterEvent read FOnEnterEvent write FOnEnterEvent;
 274     property Width: Word read FWidth write FWidth;
 275     property MaxLength: Word read FMaxLength write FMaxLength;
 276     property OnlyDigits: Boolean read FOnlyDigits write FOnlyDigits;
 277     property Text: string read FText write SetText;
 278     property Color: TRGB read FColor write FColor;
 279     property Font: TFont read FFont write FFont;
 280   end;
 281
 282   TGUIKeyRead = class(TGUIControl)
 283   private
 284     FFont: TFont;
 285     FColor: TRGB;
 286     FKey: Word;
 287     FIsQuery: Boolean;
 288   public
 289     constructor Create(FontID: DWORD);
 290     procedure OnMessage(var Msg: TMessage); override;
 291     procedure Draw; override;
 292     function GetWidth(): Word;
 293     function WantActivationKey (key: LongInt): Boolean; override;
 294     property Key: Word read FKey write FKey;
 295     property Color: TRGB read FColor write FColor;
 296     property Font: TFont read FFont write FFont;
 297   end;
 298
 299   // can hold two keys
 300   TGUIKeyRead2 = class(TGUIControl)
 301   private
 302     FFont: TFont;
 303     FFontID: DWORD;
 304     FColor: TRGB;
 305     FKey0, FKey1: Word; // this should be an array. sorry.
 306     FKeyIdx: Integer;
 307     FIsQuery: Boolean;
 308     FMaxKeyNameWdt: Integer;
 309   public
 310     constructor Create(FontID: DWORD);
 311     procedure OnMessage(var Msg: TMessage); override;
 312     procedure Draw; override;
 313     function GetWidth(): Word;
 314     function WantActivationKey (key: LongInt): Boolean; override;
 315     property Key0: Word read FKey0 write FKey0;
 316     property Key1: Word read FKey1 write FKey1;
 317     property Color: TRGB read FColor write FColor;
 318     property Font: TFont read FFont write FFont;
 319   end;
 320
 321   TGUIModelView = class(TGUIControl)
 322   private
 323     FModel: TPlayerModel;
 324     a: Boolean;
 325   public
 326     constructor Create;
 327     destructor Destroy; override;
 328     procedure OnMessage(var Msg: TMessage); override;
 329     procedure SetModel(ModelName: string);
 330     procedure SetColor(Red, Green, Blue: Byte);
 331     procedure NextAnim();
 332     procedure NextWeapon();
 333     procedure Update; override;
 334     procedure Draw; override;
 335     property  Model: TPlayerModel read FModel;
 336   end;
 337
 338   TPreviewPanel = record
 339     X1, Y1, X2, Y2: Integer;
 340     PanelType: Word;
 341   end;
 342
 343   TGUIMapPreview = class(TGUIControl)
 344   private
 345     FMapData: array of TPreviewPanel;
 346     FMapSize: TPoint;
 347     FScale: Single;
 348   public
 349     constructor Create();
 350     destructor Destroy(); override;
 351     procedure OnMessage(var Msg: TMessage); override;
 352     procedure SetMap(Res: string);
 353     procedure ClearMap();
 354     procedure Update(); override;
 355     procedure Draw(); override;
 356     function GetScaleStr: String;
 357   end;
 358
 359   TGUIImage = class(TGUIControl)
 360   private
 361     FImageRes: string;
 362     FDefaultRes: string;
 363   public
 364     constructor Create();
 365     destructor Destroy(); override;
 366     procedure OnMessage(var Msg: TMessage); override;
 367     procedure SetImage(Res: string);
 368     procedure ClearImage();
 369     procedure Update(); override;
 370     procedure Draw(); override;
 371     property DefaultRes: string read FDefaultRes write FDefaultRes;
 372   end;
 373
 374   TGUIListBox = class(TGUIControl)
 375   private
 376     FItems: SArray;
 377     FActiveColor: TRGB;
 378     FUnActiveColor: TRGB;
 379     FFont: TFont;
 380     FStartLine: Integer;
 381     FIndex: Integer;
 382     FWidth: Word;
 383     FHeight: Word;
 384     FSort: Boolean;
 385     FDrawBack: Boolean;
 386     FDrawScroll: Boolean;
 387     FOnChangeEvent: TOnChangeEvent;
 388
 389     procedure FSetItems(Items: SArray);
 390     procedure FSetIndex(aIndex: Integer);
 391
 392   public
 393     constructor Create(FontID: DWORD; Width, Height: Word);
 394     procedure OnMessage(var Msg: TMessage); override;
 395     procedure Draw(); override;
 396     procedure AddItem(Item: String);
 397     procedure SelectItem(Item: String);
 398     procedure Clear();
 399     function  GetWidth(): Word;
 400     function  GetHeight(): Word;
 401     function  SelectedItem(): String;
 402
 403     property OnChange: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent;
 404     property Sort: Boolean read FSort write FSort;
 405     property ItemIndex: Integer read FIndex write FSetIndex;
 406     property Items: SArray read FItems write FSetItems;
 407     property DrawBack: Boolean read FDrawBack write FDrawBack;
 408     property DrawScrollBar: Boolean read FDrawScroll write FDrawScroll;
 409     property ActiveColor: TRGB read FActiveColor write FActiveColor;
 410     property UnActiveColor: TRGB read FUnActiveColor write FUnActiveColor;
 411     property Font: TFont read FFont write FFont;
 412   end;
 413
 414   TGUIFileListBox = class (TGUIListBox)
 415   private
 416     FBasePath: String;
 417     FPath: String;
 418     FFileMask: String;
 419     FDirs: Boolean;
 420
 421     procedure OpenDir(path: String);
 422
 423   public
 424     procedure OnMessage(var Msg: TMessage); override;
 425     procedure SetBase(path: String);
 426     function  SelectedItem(): String;
 427     procedure UpdateFileList();
 428
 429     property Dirs: Boolean read FDirs write FDirs;
 430     property FileMask: String read FFileMask write FFileMask;
 431     property Path: String read FPath;
 432   end;
 433
 434   TGUIMemo = class(TGUIControl)
 435   private
 436     FLines: SArray;
 437     FFont: TFont;
 438     FStartLine: Integer;
 439     FWidth: Word;
 440     FHeight: Word;
 441     FColor: TRGB;
 442     FDrawBack: Boolean;
 443     FDrawScroll: Boolean;
 444   public
 445     constructor Create(FontID: DWORD; Width, Height: Word);
 446     procedure OnMessage(var Msg: TMessage); override;
 447     procedure Draw; override;
 448     procedure Clear;
 449     function GetWidth(): Word;
 450     function GetHeight(): Word;
 451     procedure SetText(Text: string);
 452     property DrawBack: Boolean read FDrawBack write FDrawBack;
 453     property DrawScrollBar: Boolean read FDrawScroll write FDrawScroll;
 454     property Color: TRGB read FColor write FColor;
 455     property Font: TFont read FFont write FFont;
 456   end;
 457
 458   TGUIMainMenu = class(TGUIControl)
 459   private
 460     FButtons: array of TGUITextButton;
 461     FHeader: TGUILabel;
 462     FIndex: Integer;
 463     FFontID: DWORD;
 464     FCounter: Byte;
 465     FMarkerID1: DWORD;
 466     FMarkerID2: DWORD;
 467   public
 468     constructor Create(FontID: DWORD; Header: string);
 469     destructor Destroy; override;
 470     procedure OnMessage(var Msg: TMessage); override;
 471     function AddButton(fProc: Pointer; Caption: string; ShowWindow: string = ''): TGUITextButton;
 472     function GetButton(Name: string): TGUITextButton;
 473     procedure EnableButton(Name: string; e: Boolean);
 474     procedure AddSpace();
 475     procedure Update; override;
 476     procedure Draw; override;
 477   end;
 478
 479   TControlType = class of TGUIControl;
 480
 481   PMenuItem = ^TMenuItem;
 482   TMenuItem = record
 483     Text: TGUILabel;
 484     ControlType: TControlType;
 485     Control: TGUIControl;
 486   end;
 487
 488   TGUIMenu = class(TGUIControl)
 489   private
 490     FItems: array of TMenuItem;
 491     FHeader: TGUILabel;
 492     FIndex: Integer;
 493     FFontID: DWORD;
 494     FCounter: Byte;
 495     FAlign: Boolean;
 496     FLeft: Integer;
 497     FYesNo: Boolean;
 498     function NewItem(): Integer;
 499   public
 500     constructor Create(HeaderFont, ItemsFont: DWORD; Header: string);
 501     destructor Destroy; override;
 502     procedure OnMessage(var Msg: TMessage); override;
 503     procedure AddSpace();
 504     procedure AddLine(fText: string);
 505     procedure AddText(fText: string; MaxWidth: Word);
 506     function AddLabel(fText: string): TGUILabel;
 507     function AddButton(Proc: Pointer; fText: string; _ShowWindow: string = ''): TGUITextButton;
 508     function AddScroll(fText: string): TGUIScroll;
 509     function AddSwitch(fText: string): TGUISwitch;
 510     function AddEdit(fText: string): TGUIEdit;
 511     function AddKeyRead(fText: string): TGUIKeyRead;
 512     function AddKeyRead2(fText: string): TGUIKeyRead2;
 513     function AddList(fText: string; Width, Height: Word): TGUIListBox;
 514     function AddFileList(fText: string; Width, Height: Word): TGUIFileListBox;
 515     function AddMemo(fText: string; Width, Height: Word): TGUIMemo;
 516     procedure ReAlign();
 517     function GetControl(Name: string): TGUIControl;
 518     function GetControlsText(Name: string): TGUILabel;
 519     procedure Draw; override;
 520     procedure Update; override;
 521     procedure UpdateIndex();
 522     property Align: Boolean read FAlign write FAlign;
 523     property Left: Integer read FLeft write FLeft;
 524     property YesNo: Boolean read FYesNo write FYesNo;
 525   end;
 526
 527 var
 528   g_GUIWindows: array of TGUIWindow;
 529   g_ActiveWindow: TGUIWindow = nil;
 530
 531 procedure g_GUI_Init();
 532 function  g_GUI_AddWindow(Window: TGUIWindow): TGUIWindow;
 533 function  g_GUI_GetWindow(Name: string): TGUIWindow;
 534 procedure g_GUI_ShowWindow(Name: string);
 535 procedure g_GUI_HideWindow(PlaySound: Boolean = True);
 536 function  g_GUI_Destroy(): Boolean;
 537 procedure g_GUI_SaveMenuPos();
 538 procedure g_GUI_LoadMenuPos();
 539
 540 implementation
 541
 542 uses
 543   GL, GLExt, g_textures, g_sound, SysUtils,
 544   g_game, Math, StrUtils, g_player, g_options, MAPREADER,
 545   g_map, MAPDEF, g_weapons;
 546
 547 var
 548   Box: Array [0..8] of DWORD;
 549   Saved_Windows: SArray;
 550
 551 procedure g_GUI_Init();
 552 begin
 553   g_Texture_Get(BOX1, Box[0]);
 554   g_Texture_Get(BOX2, Box[1]);
 555   g_Texture_Get(BOX3, Box[2]);
 556   g_Texture_Get(BOX4, Box[3]);
 557   g_Texture_Get(BOX5, Box[4]);
 558   g_Texture_Get(BOX6, Box[5]);
 559   g_Texture_Get(BOX7, Box[6]);
 560   g_Texture_Get(BOX8, Box[7]);
 561   g_Texture_Get(BOX9, Box[8]);
 562 end;
 563
 564 function g_GUI_Destroy(): Boolean;
 565 var
 566   i: Integer;
 567 begin
 568   Result := (Length(g_GUIWindows) > 0);
 569
 570   for i := 0 to High(g_GUIWindows) do
 571     g_GUIWindows[i].Free();
 572
 573   g_GUIWindows := nil;
 574   g_ActiveWindow := nil;
 575 end;
 576
 577 function g_GUI_AddWindow(Window: TGUIWindow): TGUIWindow;
 578 begin
 579   SetLength(g_GUIWindows, Length(g_GUIWindows)+1);
 580   g_GUIWindows[High(g_GUIWindows)] := Window;
 581
 582   Result := Window;
 583 end;
 584
 585 function g_GUI_GetWindow(Name: string): TGUIWindow;
 586 var
 587   i: Integer;
 588 begin
 589   Result := nil;
 590
 591   if g_GUIWindows <> nil then
 592     for i := 0 to High(g_GUIWindows) do
 593       if g_GUIWindows[i].FName = Name then
 594       begin
 595         Result := g_GUIWindows[i];
 596         Break;
 597       end;
 598
 599   Assert(Result <> nil, 'GUI_Window "'+Name+'" not found');
 600 end;
 601
 602 procedure g_GUI_ShowWindow(Name: string);
 603 var
 604   i: Integer;
 605 begin
 606   if g_GUIWindows = nil then
 607     Exit;
 608
 609   for i := 0 to High(g_GUIWindows) do
 610     if g_GUIWindows[i].FName = Name then
 611     begin
 612       g_GUIWindows[i].FPrevWindow := g_ActiveWindow;
 613       g_ActiveWindow := g_GUIWindows[i];
 614
 615       if g_ActiveWindow.MainWindow then
 616         g_ActiveWindow.FPrevWindow := nil;
 617
 618       if g_ActiveWindow.FDefControl <> '' then
 619         g_ActiveWindow.SetActive(g_ActiveWindow.GetControl(g_ActiveWindow.FDefControl))
 620       else
 621         g_ActiveWindow.SetActive(nil);
 622
 623       if @g_ActiveWindow.FOnShowEvent <> nil then
 624         g_ActiveWindow.FOnShowEvent();
 625
 626       Break;
 627     end;
 628 end;
 629
 630 procedure g_GUI_HideWindow(PlaySound: Boolean = True);
 631 begin
 632   if g_ActiveWindow <> nil then
 633   begin
 634     if @g_ActiveWindow.OnClose <> nil then
 635       g_ActiveWindow.OnClose();
 636     g_ActiveWindow := g_ActiveWindow.FPrevWindow;
 637     if PlaySound then
 638       g_Sound_PlayEx(WINDOW_CLOSESOUND);
 639   end;
 640 end;
 641
 642 procedure g_GUI_SaveMenuPos();
 643 var
 644   len: Integer;
 645   win: TGUIWindow;
 646 begin
 647   SetLength(Saved_Windows, 0);
 648   win := g_ActiveWindow;
 649
 650   while win <> nil do
 651   begin
 652     len := Length(Saved_Windows);
 653     SetLength(Saved_Windows, len + 1);
 654
 655     Saved_Windows[len] := win.Name;
 656
 657     if win.MainWindow then
 658       win := nil
 659     else
 660       win := win.FPrevWindow;
 661   end;
 662 end;
 663
 664 procedure g_GUI_LoadMenuPos();
 665 var
 666   i, j, k, len: Integer;
 667   ok: Boolean;
 668 begin
 669   g_ActiveWindow := nil;
 670   len := Length(Saved_Windows);
 671
 672   if len = 0 then
 673     Exit;
 674
 675 // Îêíî ñ ãëàâíûì ìåíþ:
 676   g_GUI_ShowWindow(Saved_Windows[len-1]);
 677
 678 // Íå ïåðåêëþ÷èëîñü (èëè íåêóäà äàëüøå):
 679   if (len = 1) or (g_ActiveWindow = nil) then
 680     Exit;
 681
 682 // Èùåì êíîïêè â îñòàëüíûõ îêíàõ:
 683   for k := len-1 downto 1 do
 684   begin
 685     ok := False;
 686
 687     for i := 0 to Length(g_ActiveWindow.Childs)-1 do
 688     begin
 689       if g_ActiveWindow.Childs[i] is TGUIMainMenu then
 690         begin // GUI_MainMenu
 691           with TGUIMainMenu(g_ActiveWindow.Childs[i]) do
 692             for j := 0 to Length(FButtons)-1 do
 693               if FButtons[j].ShowWindow = Saved_Windows[k-1] then
 694               begin
 695                 FButtons[j].Click(True);
 696                 ok := True;
 697                 Break;
 698               end;
 699         end
 700       else // GUI_Menu
 701         if g_ActiveWindow.Childs[i] is TGUIMenu then
 702           with TGUIMenu(g_ActiveWindow.Childs[i]) do
 703             for j := 0 to Length(FItems)-1 do
 704               if FItems[j].ControlType = TGUITextButton then
 705                 if TGUITextButton(FItems[j].Control).ShowWindow = Saved_Windows[k-1] then
 706                 begin
 707                   TGUITextButton(FItems[j].Control).Click(True);
 708                   ok := True;
 709                   Break;
 710                 end;
 711
 712       if ok then
 713         Break;
 714     end;
 715
 716   // Íå ïåðåêëþ÷èëîñü:
 717     if (not ok) or
 718        (g_ActiveWindow.Name = Saved_Windows[k]) then
 719       Break;
 720   end;
 721 end;
 722
 723 procedure DrawBox(X, Y: Integer; Width, Height: Word);
 724 begin
 725   e_Draw(Box[0], X, Y, 0, False, False);
 726   e_DrawFill(Box[1], X+4, Y, Width*4, 1, 0, False, False);
 727   e_Draw(Box[2], X+4+Width*16, Y, 0, False, False);
 728   e_DrawFill(Box[3], X, Y+4, 1, Height*4, 0, False, False);
 729   e_DrawFill(Box[4], X+4, Y+4, Width, Height, 0, False, False);
 730   e_DrawFill(Box[5], X+4+Width*16, Y+4, 1, Height*4, 0, False, False);
 731   e_Draw(Box[6], X, Y+4+Height*16, 0, False, False);
 732   e_DrawFill(Box[7], X+4, Y+4+Height*16, Width*4, 1, 0, False, False);
 733   e_Draw(Box[8], X+4+Width*16, Y+4+Height*16, 0, False, False);
 734 end;
 735
 736 procedure DrawScroll(X, Y: Integer; Height: Word; Up, Down: Boolean);
 737 var
 738   ID: DWORD;
 739 begin
 740   if Height < 3 then Exit;
 741
 742   if Up then
 743     g_Texture_Get(BSCROLL_UPA, ID)
 744   else
 745     g_Texture_Get(BSCROLL_UPU, ID);
 746   e_Draw(ID, X, Y, 0, False, False);
 747
 748   if Down then
 749     g_Texture_Get(BSCROLL_DOWNA, ID)
 750   else
 751     g_Texture_Get(BSCROLL_DOWNU, ID);
 752   e_Draw(ID, X, Y+(Height-1)*16, 0, False, False);
 753
 754   g_Texture_Get(BSCROLL_MIDDLE, ID);
 755   e_DrawFill(ID, X, Y+16, 1, Height-2, 0, False, False);
 756 end;
 757
 758 { TGUIWindow }
 759
 760 constructor TGUIWindow.Create(Name: string);
 761 begin
 762   Childs := nil;
 763   FActiveControl := nil;
 764   FName := Name;
 765   FOnKeyDown := nil;
 766   FOnKeyDownEx := nil;
 767   FOnCloseEvent := nil;
 768   FOnShowEvent := nil;
 769 end;
 770
 771 destructor TGUIWindow.Destroy;
 772 var
 773   i: Integer;
 774 begin
 775   if Childs = nil then
 776     Exit;
 777
 778   for i := 0 to High(Childs) do
 779     Childs[i].Free();
 780 end;
 781
 782 function TGUIWindow.AddChild(Child: TGUIControl): TGUIControl;
 783 begin
 784   Child.FWindow := Self;
 785
 786   SetLength(Childs, Length(Childs) + 1);
 787   Childs[High(Childs)] := Child;
 788
 789   Result := Child;
 790 end;
 791
 792 procedure TGUIWindow.Update;
 793 var
 794   i: Integer;
 795 begin
 796   for i := 0 to High(Childs) do
 797     if Childs[i] <> nil then Childs[i].Update;
 798 end;
 799
 800 procedure TGUIWindow.Draw;
 801 var
 802   i: Integer;
 803   ID: DWORD;
 804 begin
 805   if FBackTexture <> '' then
 806     if g_Texture_Get(FBackTexture, ID) then
 807       e_DrawSize(ID, 0, 0, 0, False, False, gScreenWidth, gScreenHeight)
 808     else
 809       e_Clear(GL_COLOR_BUFFER_BIT, 0.5, 0.5, 0.5);
 810
 811   for i := 0 to High(Childs) do
 812     if Childs[i] <> nil then Childs[i].Draw;
 813 end;
 814
 815 procedure TGUIWindow.OnMessage(var Msg: TMessage);
 816 begin
 817   if FActiveControl <> nil then FActiveControl.OnMessage(Msg);
 818   if @FOnKeyDown <> nil then FOnKeyDown(Msg.wParam);
 819   if @FOnKeyDownEx <> nil then FOnKeyDownEx(self, Msg.wParam);
 820
 821   if Msg.Msg = WM_KEYDOWN then
 822     if Msg.wParam = IK_ESCAPE then
 823     begin
 824       g_GUI_HideWindow;
 825       Exit;
 826     end;
 827 end;
 828
 829 procedure TGUIWindow.SetActive(Control: TGUIControl);
 830 begin
 831   FActiveControl := Control;
 832 end;
 833
 834 function TGUIWindow.GetControl(Name: String): TGUIControl;
 835 var
 836   i: Integer;
 837 begin
 838   Result := nil;
 839
 840   if Childs <> nil then
 841     for i := 0 to High(Childs) do
 842       if Childs[i] <> nil then
 843         if LowerCase(Childs[i].FName) = LowerCase(Name) then
 844         begin
 845           Result := Childs[i];
 846           Break;
 847         end;
 848
 849   Assert(Result <> nil, 'Window Control "'+Name+'" not Found!');
 850 end;
 851
 852 { TGUIControl }
 853
 854 constructor TGUIControl.Create();
 855 begin
 856   FX := 0;
 857   FY := 0;
 858
 859   FEnabled := True;
 860 end;
 861
 862 procedure TGUIControl.OnMessage(var Msg: TMessage);
 863 begin
 864   if not FEnabled then
 865     Exit;
 866 end;
 867
 868 procedure TGUIControl.Update();
 869 begin
 870 end;
 871
 872 procedure TGUIControl.Draw();
 873 begin
 874 end;
 875
 876 function TGUIControl.WantActivationKey (key: LongInt): Boolean;
 877 begin
 878   result := false;
 879 end;
 880
 881 { TGUITextButton }
 882
 883 procedure TGUITextButton.Click(Silent: Boolean = False);
 884 begin
 885   if (FSound <> '') and (not Silent) then g_Sound_PlayEx(FSound);
 886
 887   if @Proc <> nil then Proc();
 888   if @ProcEx <> nil then ProcEx(self);
 889
 890   if FShowWindow <> '' then g_GUI_ShowWindow(FShowWindow);
 891 end;
 892
 893 constructor TGUITextButton.Create(Proc: Pointer; FontID: DWORD; Text: string);
 894 begin
 895   inherited Create();
 896
 897   Self.Proc := Proc;
 898   ProcEx := nil;
 899
 900   FFont := TFont.Create(FontID, FONT_CHAR);
 901
 902   FText := Text;
 903 end;
 904
 905 destructor TGUITextButton.Destroy;
 906 begin
 907
 908  inherited;
 909 end;
 910
 911 procedure TGUITextButton.Draw;
 912 begin
 913   FFont.Draw(FX, FY, FText, FColor.R, FColor.G, FColor.B)
 914 end;
 915
 916 function TGUITextButton.GetHeight: Integer;
 917 var
 918   w, h: Word;
 919 begin
 920   FFont.GetTextSize(FText, w, h);
 921   Result := h;
 922 end;
 923
 924 function TGUITextButton.GetWidth: Integer;
 925 var
 926   w, h: Word;
 927 begin
 928   FFont.GetTextSize(FText, w, h);
 929   Result := w;
 930 end;
 931
 932 procedure TGUITextButton.OnMessage(var Msg: TMessage);
 933 begin
 934   if not FEnabled then Exit;
 935
 936   inherited;
 937
 938   case Msg.Msg of
 939     WM_KEYDOWN:
 940       case Msg.wParam of
 941         IK_RETURN, IK_KPRETURN: Click();
 942       end;
 943   end;
 944 end;
 945
 946 procedure TGUITextButton.Update;
 947 begin
 948   inherited;
 949 end;
 950
 951 { TFont }
 952
 953 constructor TFont.Create(FontID: DWORD; FontType: TFontType);
 954 begin
 955   ID := FontID;
 956
 957   FScale := 1;
 958   FFontType := FontType;
 959 end;
 960
 961 destructor TFont.Destroy;
 962 begin
 963
 964   inherited;
 965 end;
 966
 967 procedure TFont.Draw(X, Y: Integer; Text: string; R, G, B: Byte);
 968 begin
 969   if FFontType = FONT_CHAR then e_CharFont_PrintEx(ID, X, Y, Text, _RGB(R, G, B), FScale)
 970   else e_TextureFontPrintEx(X, Y, Text, ID, R, G, B, FScale);
 971 end;
 972
 973 procedure TFont.GetTextSize(Text: string; var w, h: Word);
 974 var
 975   cw, ch: Byte;
 976 begin
 977   if FFontType = FONT_CHAR then e_CharFont_GetSize(ID, Text, w, h)
 978   else
 979   begin
 980     e_TextureFontGetSize(ID, cw, ch);
 981     w := cw*Length(Text);
 982     h := ch;
 983   end;
 984
 985   w := Round(w*FScale);
 986   h := Round(h*FScale);
 987 end;
 988
 989 { TGUIMainMenu }
 990
 991 function TGUIMainMenu.AddButton(fProc: Pointer; Caption: string; ShowWindow: string = ''): TGUITextButton;
 992 var
 993   a, _x: Integer;
 994   h, hh: Word;
 995 begin
 996   FIndex := 0;
 997
 998   SetLength(FButtons, Length(FButtons)+1);
 999   FButtons[High(FButtons)] := TGUITextButton.Create(fProc, FFontID, Caption);
1000   FButtons[High(FButtons)].ShowWindow := ShowWindow;
1001   with FButtons[High(FButtons)] do
1002   begin
1003     if (fProc <> nil) or (ShowWindow <> '') then FColor := MAINMENU_ITEMS_COLOR
1004     else FColor := MAINMENU_UNACTIVEITEMS_COLOR;
1005     FSound := MAINMENU_CLICKSOUND;
1006   end;
1007
1008   _x := gScreenWidth div 2;
1009
1010   for a := 0 to High(FButtons) do
1011     if FButtons[a] <> nil then
1012       _x := Min(_x, (gScreenWidth div 2)-(FButtons[a].GetWidth div 2));
1013
1014   hh := FHeader.GetHeight;
1015
1016   h := hh*(2+Length(FButtons))+MAINMENU_SPACE*(Length(FButtons)-1);
1017   h := (gScreenHeight div 2)-(h div 2);
1018
1019   with FHeader do
1020   begin
1021     FX := _x;
1022     FY := h;
1023   end;
1024
1025   Inc(h, hh*2);
1026
1027   for a := 0 to High(FButtons) do
1028   begin
1029     if FButtons[a] <> nil then
1030     with FButtons[a] do
1031     begin
1032       FX := _x;
1033       FY := h;
1034     end;
1035
1036     Inc(h, hh+MAINMENU_SPACE);
1037   end;
1038
1039   Result := FButtons[High(FButtons)];
1040 end;
1041
1042 procedure TGUIMainMenu.AddSpace;
1043 begin
1044   SetLength(FButtons, Length(FButtons)+1);
1045   FButtons[High(FButtons)] := nil;
1046 end;
1047
1048 constructor TGUIMainMenu.Create(FontID: DWORD; Header: string);
1049 begin
1050   inherited Create();
1051
1052   FIndex := -1;
1053   FFontID := FontID;
1054   FCounter := MAINMENU_MARKERDELAY;
1055
1056   g_Texture_Get(MAINMENU_MARKER1, FMarkerID1);
1057   g_Texture_Get(MAINMENU_MARKER2, FMarkerID2);
1058
1059   FHeader := TGUILabel.Create(Header, FFontID);
1060   with FHeader do
1061   begin
1062     FColor := MAINMENU_HEADER_COLOR;
1063     FX := (gScreenWidth div 2)-(GetWidth div 2);
1064     FY := (gScreenHeight div 2)-(GetHeight div 2);
1065   end;
1066 end;
1067
1068 destructor TGUIMainMenu.Destroy;
1069 var
1070   a: Integer;
1071 begin
1072   if FButtons <> nil then
1073     for a := 0 to High(FButtons) do
1074       FButtons[a].Free();
1075
1076   FHeader.Free();
1077
1078   inherited;
1079 end;
1080
1081 procedure TGUIMainMenu.Draw;
1082 var
1083   a: Integer;
1084 begin
1085   inherited;
1086
1087   FHeader.Draw;
1088
1089   if FButtons <> nil then
1090   begin
1091     for a := 0 to High(FButtons) do
1092       if FButtons[a] <> nil then FButtons[a].Draw;
1093
1094     if FIndex <> -1 then
1095       e_Draw(FMarkerID1, FButtons[FIndex].FX-48, FButtons[FIndex].FY, 0, True, False);
1096   end;
1097 end;
1098
1099 procedure TGUIMainMenu.EnableButton(Name: string; e: Boolean);
1100 var
1101   a: Integer;
1102 begin
1103   if FButtons = nil then Exit;
1104
1105   for a := 0 to High(FButtons) do
1106     if (FButtons[a] <> nil) and (FButtons[a].Name = Name) then
1107     begin
1108       if e then FButtons[a].FColor := MAINMENU_ITEMS_COLOR
1109       else FButtons[a].FColor := MAINMENU_UNACTIVEITEMS_COLOR;
1110       FButtons[a].Enabled := e;
1111       Break;
1112     end;
1113 end;
1114
1115 function TGUIMainMenu.GetButton(Name: string): TGUITextButton;
1116 var
1117   a: Integer;
1118 begin
1119   Result := nil;
1120
1121   if FButtons = nil then Exit;
1122
1123   for a := 0 to High(FButtons) do
1124     if (FButtons[a] <> nil) and (FButtons[a].Name = Name) then
1125     begin
1126       Result := FButtons[a];
1127       Break;
1128     end;
1129 end;
1130
1131 procedure TGUIMainMenu.OnMessage(var Msg: TMessage);
1132 var
1133   ok: Boolean;
1134   a: Integer;
1135 begin
1136   if not FEnabled then Exit;
1137
1138   inherited;
1139
1140   if FButtons = nil then Exit;
1141
1142   ok := False;
1143   for a := 0 to High(FButtons) do
1144     if FButtons[a] <> nil then
1145     begin
1146       ok := True;
1147       Break;
1148     end;
1149
1150   if not ok then Exit;
1151
1152   case Msg.Msg of
1153     WM_KEYDOWN:
1154       case Msg.wParam of
1155         IK_UP, IK_KPUP:
1156         begin
1157           repeat
1158             Dec(FIndex);
1159             if FIndex < 0 then FIndex := High(FButtons);
1160           until FButtons[FIndex] <> nil;
1161
1162           g_Sound_PlayEx(MENU_CHANGESOUND);
1163         end;
1164         IK_DOWN, IK_KPDOWN:
1165         begin
1166           repeat
1167             Inc(FIndex);
1168             if FIndex > High(FButtons) then FIndex := 0;
1169           until FButtons[FIndex] <> nil;
1170
1171           g_Sound_PlayEx(MENU_CHANGESOUND);
1172         end;
1173         IK_RETURN, IK_KPRETURN: if (FIndex <> -1) and FButtons[FIndex].FEnabled then FButtons[FIndex].Click;
1174       end;
1175   end;
1176 end;
1177
1178 procedure TGUIMainMenu.Update;
1179 var
1180   t: DWORD;
1181 begin
1182   inherited;
1183
1184   if FCounter = 0 then
1185   begin
1186     t := FMarkerID1;
1187     FMarkerID1 := FMarkerID2;
1188     FMarkerID2 := t;
1189
1190     FCounter := MAINMENU_MARKERDELAY;
1191   end else Dec(FCounter);
1192 end;
1193
1194 { TGUILabel }
1195
1196 constructor TGUILabel.Create(Text: string; FontID: DWORD);
1197 begin
1198   inherited Create();
1199
1200   FFont := TFont.Create(FontID, FONT_CHAR);
1201
1202   FText := Text;
1203   FFixedLen := 0;
1204   FOnClickEvent := nil;
1205 end;
1206
1207 procedure TGUILabel.Draw;
1208 begin
1209   FFont.Draw(FX, FY, FText, FColor.R, FColor.G, FColor.B);
1210 end;
1211
1212 function TGUILabel.GetHeight: Integer;
1213 var
1214   w, h: Word;
1215 begin
1216   FFont.GetTextSize(FText, w, h);
1217   Result := h;
1218 end;
1219
1220 function TGUILabel.GetWidth: Integer;
1221 var
1222   w, h: Word;
1223 begin
1224   if FFixedLen = 0 then
1225     FFont.GetTextSize(FText, w, h)
1226   else
1227     w := e_CharFont_GetMaxWidth(FFont.ID)*FFixedLen;
1228   Result := w;
1229 end;
1230
1231 procedure TGUILabel.OnMessage(var Msg: TMessage);
1232 begin
1233   if not FEnabled then Exit;
1234
1235   inherited;
1236
1237   case Msg.Msg of
1238     WM_KEYDOWN:
1239       case Msg.wParam of
1240         IK_RETURN, IK_KPRETURN: if @FOnClickEvent <> nil then FOnClickEvent();
1241       end;
1242   end;
1243 end;
1244
1245 { TGUIMenu }
1246
1247 function TGUIMenu.AddButton(Proc: Pointer; fText: string; _ShowWindow: string = ''): TGUITextButton;
1248 var
1249   i: Integer;
1250 begin
1251   i := NewItem();
1252   with FItems[i] do
1253   begin
1254     Control := TGUITextButton.Create(Proc, FFontID, fText);
1255     with Control as TGUITextButton  do
1256     begin
1257       ShowWindow := _ShowWindow;
1258       FColor := MENU_ITEMSCTRL_COLOR;
1259     end;
1260
1261     Text := nil;
1262     ControlType := TGUITextButton;
1263
1264     Result := (Control as TGUITextButton);
1265   end;
1266
1267   if FIndex = -1 then FIndex := i;
1268
1269   ReAlign();
1270 end;
1271
1272 procedure TGUIMenu.AddLine(fText: string);
1273 var
1274   i: Integer;
1275 begin
1276   i := NewItem();
1277   with FItems[i] do
1278   begin
1279     Text := TGUILabel.Create(fText, FFontID);
1280     with Text do
1281     begin
1282       FColor := MENU_ITEMSTEXT_COLOR;
1283     end;
1284
1285     Control := nil;
1286   end;
1287
1288   ReAlign();
1289 end;
1290
1291 procedure TGUIMenu.AddText(fText: string; MaxWidth: Word);
1292 var
1293   a, i: Integer;
1294   l: SArray;
1295 begin
1296   l := GetLines(fText, FFontID, MaxWidth);
1297
1298   if l = nil then Exit;
1299
1300   for a := 0 to High(l) do
1301   begin
1302     i := NewItem();
1303     with FItems[i] do
1304     begin
1305       Text := TGUILabel.Create(l[a], FFontID);
1306       if FYesNo then
1307       begin
1308         with Text do begin FColor := _RGB(255, 0, 0); end;
1309       end
1310       else
1311       begin
1312         with Text do begin FColor := MENU_ITEMSTEXT_COLOR; end;
1313       end;
1314
1315       Control := nil;
1316     end;
1317   end;
1318
1319   ReAlign();
1320 end;
1321
1322 procedure TGUIMenu.AddSpace;
1323 var
1324   i: Integer;
1325 begin
1326   i := NewItem();
1327   with FItems[i] do
1328   begin
1329     Text := nil;
1330     Control := nil;
1331   end;
1332
1333   ReAlign();
1334 end;
1335
1336 constructor TGUIMenu.Create(HeaderFont, ItemsFont: DWORD; Header: string);
1337 begin
1338   inherited Create();
1339
1340   FItems := nil;
1341   FIndex := -1;
1342   FFontID := ItemsFont;
1343   FCounter := MENU_MARKERDELAY;
1344   FAlign := True;
1345   FYesNo := false;
1346
1347   FHeader := TGUILabel.Create(Header, HeaderFont);
1348   with FHeader do
1349   begin
1350     FX := (gScreenWidth div 2)-(GetWidth div 2);
1351     FY := 0;
1352     FColor := MAINMENU_HEADER_COLOR;
1353   end;
1354 end;
1355
1356 destructor TGUIMenu.Destroy;
1357 var
1358   a: Integer;
1359 begin
1360   if FItems <> nil then
1361     for a := 0 to High(FItems) do
1362       with FItems[a] do
1363       begin
1364         Text.Free();
1365         Control.Free();
1366       end;
1367
1368   FItems := nil;
1369
1370   FHeader.Free();
1371
1372   inherited;
1373 end;
1374
1375 procedure TGUIMenu.Draw;
1376 var
1377   a, x, y: Integer;
1378 begin
1379   inherited;
1380
1381   if FHeader <> nil then FHeader.Draw;
1382
1383   if FItems <> nil then
1384     for a := 0 to High(FItems) do
1385     begin
1386       if FItems[a].Text <> nil then FItems[a].Text.Draw;
1387       if FItems[a].Control <> nil then FItems[a].Control.Draw;
1388     end;
1389
1390   if (FIndex <> -1) and (FCounter > MENU_MARKERDELAY div 2) then
1391   begin
1392     x := 0;
1393     y := 0;
1394
1395     if FItems[FIndex].Text <> nil then
1396     begin
1397       x := FItems[FIndex].Text.FX;
1398       y := FItems[FIndex].Text.FY;
1399     end
1400     else if FItems[FIndex].Control <> nil then
1401     begin
1402       x := FItems[FIndex].Control.FX;
1403       y := FItems[FIndex].Control.FY;
1404     end;
1405
1406     x := x-e_CharFont_GetMaxWidth(FFontID);
1407
1408     e_CharFont_PrintEx(FFontID, x, y, #16, _RGB(255, 0, 0));
1409   end;
1410 end;
1411
1412 function TGUIMenu.GetControl(Name: String): TGUIControl;
1413 var
1414   a: Integer;
1415 begin
1416   Result := nil;
1417
1418   if FItems <> nil then
1419     for a := 0 to High(FItems) do
1420       if FItems[a].Control <> nil then
1421         if LowerCase(FItems[a].Control.Name) = LowerCase(Name) then
1422         begin
1423           Result := FItems[a].Control;
1424           Break;
1425         end;
1426
1427   Assert(Result <> nil, 'GUI control "'+Name+'" not found!');
1428 end;
1429
1430 function TGUIMenu.GetControlsText(Name: String): TGUILabel;
1431 var
1432   a: Integer;
1433 begin
1434   Result := nil;
1435
1436   if FItems <> nil then
1437     for a := 0 to High(FItems) do
1438       if FItems[a].Control <> nil then
1439         if LowerCase(FItems[a].Control.Name) = LowerCase(Name) then
1440         begin
1441           Result := FItems[a].Text;
1442           Break;
1443         end;
1444
1445   Assert(Result <> nil, 'GUI control''s text "'+Name+'" not found!');
1446 end;
1447
1448 function TGUIMenu.NewItem: Integer;
1449 begin
1450   SetLength(FItems, Length(FItems)+1);
1451   Result := High(FItems);
1452 end;
1453
1454 procedure TGUIMenu.OnMessage(var Msg: TMessage);
1455 var
1456   ok: Boolean;
1457   a, c: Integer;
1458 begin
1459   if not FEnabled then Exit;
1460
1461   inherited;
1462
1463   if FItems = nil then Exit;
1464
1465   ok := False;
1466   for a := 0 to High(FItems) do
1467     if FItems[a].Control <> nil then
1468     begin
1469       ok := True;
1470       Break;
1471     end;
1472
1473   if not ok then Exit;
1474
1475   if (Msg.Msg = WM_KEYDOWN) and (FIndex <> -1) and (FItems[FIndex].Control <> nil) and
1476      (FItems[FIndex].Control.WantActivationKey(Msg.wParam)) then
1477   begin
1478     FItems[FIndex].Control.OnMessage(Msg);
1479     g_Sound_PlayEx(MENU_CLICKSOUND);
1480     exit;
1481   end;
1482
1483   case Msg.Msg of
1484     WM_KEYDOWN:
1485     begin
1486       case Msg.wParam of
1487         IK_UP, IK_KPUP:
1488         begin
1489           c := 0;
1490           repeat
1491             c := c+1;
1492             if c > Length(FItems) then
1493             begin
1494               FIndex := -1;
1495               Break;
1496             end;
1497
1498             Dec(FIndex);
1499             if FIndex < 0 then FIndex := High(FItems);
1500           until (FItems[FIndex].Control <> nil) and
1501                 (FItems[FIndex].Control.Enabled);
1502
1503           FCounter := 0;
1504
1505           g_Sound_PlayEx(MENU_CHANGESOUND);
1506         end;
1507
1508         IK_DOWN, IK_KPDOWN:
1509         begin
1510           c := 0;
1511           repeat
1512             c := c+1;
1513             if c > Length(FItems) then
1514             begin
1515               FIndex := -1;
1516               Break;
1517             end;
1518
1519             Inc(FIndex);
1520             if FIndex > High(FItems) then FIndex := 0;
1521           until (FItems[FIndex].Control <> nil) and
1522                 (FItems[FIndex].Control.Enabled);
1523
1524           FCounter := 0;
1525
1526           g_Sound_PlayEx(MENU_CHANGESOUND);
1527         end;
1528
1529         IK_LEFT, IK_RIGHT, IK_KPLEFT, IK_KPRIGHT:
1530         begin
1531           if FIndex <> -1 then
1532             if FItems[FIndex].Control <> nil then
1533               FItems[FIndex].Control.OnMessage(Msg);
1534         end;
1535         IK_RETURN, IK_KPRETURN:
1536         begin
1537           if FIndex <> -1 then
1538           begin
1539             if FItems[FIndex].Control <> nil then FItems[FIndex].Control.OnMessage(Msg);
1540           end;
1541           g_Sound_PlayEx(MENU_CLICKSOUND);
1542         end;
1543         // dirty hacks
1544         IK_Y:
1545           if FYesNo and (length(FItems) > 1) then
1546           begin
1547             Msg.wParam := IK_RETURN; // to register keypress
1548             FIndex := High(FItems)-1;
1549             if FItems[FIndex].Control <> nil then FItems[FIndex].Control.OnMessage(Msg);
1550           end;
1551         IK_N:
1552           if FYesNo and (length(FItems) > 1) then
1553           begin
1554             Msg.wParam := IK_RETURN; // to register keypress
1555             FIndex := High(FItems);
1556             if FItems[FIndex].Control <> nil then FItems[FIndex].Control.OnMessage(Msg);
1557           end;
1558       end;
1559     end;
1560   end;
1561 end;
1562
1563 procedure TGUIMenu.ReAlign();
1564 var
1565   a, tx, cx, w, h: Integer;
1566 begin
1567   if FItems = nil then Exit;
1568
1569   if not FAlign then tx := FLeft else
1570   begin
1571     tx := gScreenWidth;
1572     for a := 0 to High(FItems) do
1573     begin
1574       w := 0;
1575       if FItems[a].Text <> nil then w := FItems[a].Text.GetWidth;
1576       if FItems[a].Control <> nil then
1577       begin
1578         w := w+MENU_HSPACE;
1579
1580         if FItems[a].ControlType = TGUILabel then
1581           w := w+(FItems[a].Control as TGUILabel).GetWidth
1582         else if FItems[a].ControlType = TGUITextButton then
1583           w := w+(FItems[a].Control as TGUITextButton).GetWidth
1584         else if FItems[a].ControlType = TGUIScroll then
1585           w := w+(FItems[a].Control as TGUIScroll).GetWidth
1586         else if FItems[a].ControlType = TGUISwitch then
1587           w := w+(FItems[a].Control as TGUISwitch).GetWidth
1588         else if FItems[a].ControlType = TGUIEdit then
1589           w := w+(FItems[a].Control as TGUIEdit).GetWidth
1590         else if FItems[a].ControlType = TGUIKeyRead then
1591           w := w+(FItems[a].Control as TGUIKeyRead).GetWidth
1592         else if FItems[a].ControlType = TGUIKeyRead2 then
1593           w := w+(FItems[a].Control as TGUIKeyRead2).GetWidth
1594         else if (FItems[a].ControlType = TGUIListBox) then
1595           w := w+(FItems[a].Control as TGUIListBox).GetWidth
1596         else if (FItems[a].ControlType = TGUIFileListBox) then
1597           w := w+(FItems[a].Control as TGUIFileListBox).GetWidth
1598         else if FItems[a].ControlType = TGUIMemo then
1599           w := w+(FItems[a].Control as TGUIMemo).GetWidth;
1600       end;
1601
1602       tx := Min(tx, (gScreenWidth div 2)-(w div 2));
1603     end;
1604   end;
1605
1606   cx := 0;
1607   for a := 0 to High(FItems) do
1608   begin
1609     with FItems[a] do
1610     begin
1611       if (Text <> nil) and (Control = nil) then Continue;
1612       w := 0;
1613       if Text <> nil then w := tx+Text.GetWidth;
1614       if w > cx then cx := w;
1615     end;
1616   end;
1617
1618   cx := cx+MENU_HSPACE;
1619
1620   h := FHeader.GetHeight*2+MENU_VSPACE*(Length(FItems)-1);
1621
1622   for a := 0 to High(FItems) do
1623   begin
1624     with FItems[a] do
1625     begin
1626       if (ControlType = TGUIListBox) or (ControlType = TGUIFileListBox) then
1627         h := h+(FItems[a].Control as TGUIListBox).GetHeight()
1628       else
1629         h := h+e_CharFont_GetMaxHeight(FFontID);
1630     end;
1631   end;
1632
1633   h := (gScreenHeight div 2)-(h div 2);
1634
1635   with FHeader do
1636   begin
1637     FX := (gScreenWidth div 2)-(GetWidth div 2);
1638     FY := h;
1639
1640     Inc(h, GetHeight*2);
1641   end;
1642
1643   for a := 0 to High(FItems) do
1644     with FItems[a] do
1645     begin
1646       if Text <> nil then
1647         with Text do
1648         begin
1649           FX := tx;
1650           FY := h;
1651         end;
1652
1653         if Control <> nil then
1654           with Control do
1655             if Text <> nil then
1656             begin
1657               FX := cx;
1658               FY := h;
1659             end
1660             else
1661             begin
1662               FX := tx;
1663               FY := h;
1664             end;
1665
1666         if (ControlType = TGUIListBox) or (ControlType = TGUIFileListBox) then
1667           Inc(h, (Control as TGUIListBox).GetHeight+MENU_VSPACE)
1668         else if ControlType = TGUIMemo then
1669           Inc(h, (Control as TGUIMemo).GetHeight+MENU_VSPACE)
1670         else
1671           Inc(h, e_CharFont_GetMaxHeight(FFontID)+MENU_VSPACE);
1672     end;
1673
1674   // another ugly hack
1675   if FYesNo and (length(FItems) > 1) then
1676   begin
1677     w := -1;
1678     for a := High(FItems)-1 to High(FItems) do
1679     begin
1680       if (FItems[a].Control <> nil) and (FItems[a].ControlType = TGUITextButton) then
1681       begin
1682         cx := (FItems[a].Control as TGUITextButton).GetWidth;
1683         if cx > w then w := cx;
1684       end;
1685     end;
1686     if w > 0 then
1687     begin
1688       for a := High(FItems)-1 to High(FItems) do
1689       begin
1690         if (FItems[a].Control <> nil) and (FItems[a].ControlType = TGUITextButton) then
1691         begin
1692           FItems[a].Control.FX := (gScreenWidth-w) div 2;
1693         end;
1694       end;
1695     end;
1696   end;
1697 end;
1698
1699 function TGUIMenu.AddScroll(fText: string): TGUIScroll;
1700 var
1701   i: Integer;
1702 begin
1703   i := NewItem();
1704   with FItems[i] do
1705   begin
1706     Control := TGUIScroll.Create();
1707
1708     Text := TGUILabel.Create(fText, FFontID);
1709     with Text do
1710     begin
1711       FColor := MENU_ITEMSTEXT_COLOR;
1712     end;
1713
1714     ControlType := TGUIScroll;
1715
1716     Result := (Control as TGUIScroll);
1717   end;
1718
1719   if FIndex = -1 then FIndex := i;
1720
1721   ReAlign();
1722 end;
1723
1724 function TGUIMenu.AddSwitch(fText: string): TGUISwitch;
1725 var
1726   i: Integer;
1727 begin
1728   i := NewItem();
1729   with FItems[i] do
1730   begin
1731     Control := TGUISwitch.Create(FFontID);
1732    (Control as TGUISwitch).FColor := MENU_ITEMSCTRL_COLOR;
1733
1734     Text := TGUILabel.Create(fText, FFontID);
1735     with Text do
1736     begin
1737       FColor := MENU_ITEMSTEXT_COLOR;
1738     end;
1739
1740     ControlType := TGUISwitch;
1741
1742     Result := (Control as TGUISwitch);
1743   end;
1744
1745   if FIndex = -1 then FIndex := i;
1746
1747   ReAlign();
1748 end;
1749
1750 function TGUIMenu.AddEdit(fText: string): TGUIEdit;
1751 var
1752   i: Integer;
1753 begin
1754   i := NewItem();
1755   with FItems[i] do
1756   begin
1757     Control := TGUIEdit.Create(FFontID);
1758     with Control as TGUIEdit do
1759     begin
1760       FWindow := Self.FWindow;
1761       FColor := MENU_ITEMSCTRL_COLOR;
1762     end;
1763
1764     if fText = '' then Text := nil else
1765     begin
1766       Text := TGUILabel.Create(fText, FFontID);
1767       Text.FColor := MENU_ITEMSTEXT_COLOR;
1768     end;
1769
1770     ControlType := TGUIEdit;
1771
1772     Result := (Control as TGUIEdit);
1773   end;
1774
1775   if FIndex = -1 then FIndex := i;
1776
1777   ReAlign();
1778 end;
1779
1780 procedure TGUIMenu.Update;
1781 var
1782   a: Integer;
1783 begin
1784   inherited;
1785
1786   if FCounter = 0 then FCounter := MENU_MARKERDELAY else Dec(FCounter);
1787
1788   if FItems <> nil then
1789     for a := 0 to High(FItems) do
1790       if FItems[a].Control <> nil then
1791         (FItems[a].Control as FItems[a].ControlType).Update;
1792 end;
1793
1794 function TGUIMenu.AddKeyRead(fText: string): TGUIKeyRead;
1795 var
1796   i: Integer;
1797 begin
1798   i := NewItem();
1799   with FItems[i] do
1800   begin
1801     Control := TGUIKeyRead.Create(FFontID);
1802     with Control as TGUIKeyRead do
1803     begin
1804       FWindow := Self.FWindow;
1805       FColor := MENU_ITEMSCTRL_COLOR;
1806     end;
1807
1808     Text := TGUILabel.Create(fText, FFontID);
1809     with Text do
1810     begin
1811       FColor := MENU_ITEMSTEXT_COLOR;
1812     end;
1813
1814     ControlType := TGUIKeyRead;
1815
1816     Result := (Control as TGUIKeyRead);
1817   end;
1818
1819   if FIndex = -1 then FIndex := i;
1820
1821   ReAlign();
1822 end;
1823
1824 function TGUIMenu.AddKeyRead2(fText: string): TGUIKeyRead2;
1825 var
1826   i: Integer;
1827 begin
1828   i := NewItem();
1829   with FItems[i] do
1830   begin
1831     Control := TGUIKeyRead2.Create(FFontID);
1832     with Control as TGUIKeyRead2 do
1833     begin
1834       FWindow := Self.FWindow;
1835       FColor := MENU_ITEMSCTRL_COLOR;
1836     end;
1837
1838     Text := TGUILabel.Create(fText, FFontID);
1839     with Text do
1840     begin
1841       FColor := MENU_ITEMSTEXT_COLOR;
1842     end;
1843
1844     ControlType := TGUIKeyRead2;
1845
1846     Result := (Control as TGUIKeyRead2);
1847   end;
1848
1849   if FIndex = -1 then FIndex := i;
1850
1851   ReAlign();
1852 end;
1853
1854 function TGUIMenu.AddList(fText: string; Width, Height: Word): TGUIListBox;
1855 var
1856   i: Integer;
1857 begin
1858   i := NewItem();
1859   with FItems[i] do
1860   begin
1861     Control := TGUIListBox.Create(FFontID, Width, Height);
1862     with Control as TGUIListBox do
1863     begin
1864       FWindow := Self.FWindow;
1865       FActiveColor := MENU_ITEMSCTRL_COLOR;
1866       FUnActiveColor := MENU_ITEMSTEXT_COLOR;
1867     end;
1868
1869     Text := TGUILabel.Create(fText, FFontID);
1870     with Text do
1871     begin
1872       FColor := MENU_ITEMSTEXT_COLOR;
1873     end;
1874
1875     ControlType := TGUIListBox;
1876
1877     Result := (Control as TGUIListBox);
1878   end;
1879
1880   if FIndex = -1 then FIndex := i;
1881
1882   ReAlign();
1883 end;
1884
1885 function TGUIMenu.AddFileList(fText: string; Width, Height: Word): TGUIFileListBox;
1886 var
1887   i: Integer;
1888 begin
1889   i := NewItem();
1890   with FItems[i] do
1891   begin
1892     Control := TGUIFileListBox.Create(FFontID, Width, Height);
1893     with Control as TGUIFileListBox do
1894     begin
1895       FWindow := Self.FWindow;
1896       FActiveColor := MENU_ITEMSCTRL_COLOR;
1897       FUnActiveColor := MENU_ITEMSTEXT_COLOR;
1898     end;
1899
1900     if fText = '' then Text := nil else
1901     begin
1902       Text := TGUILabel.Create(fText, FFontID);
1903       Text.FColor := MENU_ITEMSTEXT_COLOR;
1904     end;
1905
1906     ControlType := TGUIFileListBox;
1907
1908     Result := (Control as TGUIFileListBox);
1909   end;
1910
1911   if FIndex = -1 then FIndex := i;
1912
1913   ReAlign();
1914 end;
1915
1916 function TGUIMenu.AddLabel(fText: string): TGUILabel;
1917 var
1918   i: Integer;
1919 begin
1920   i := NewItem();
1921   with FItems[i] do
1922   begin
1923     Control := TGUILabel.Create('', FFontID);
1924     with Control as TGUILabel do
1925     begin
1926       FWindow := Self.FWindow;
1927       FColor := MENU_ITEMSCTRL_COLOR;
1928     end;
1929
1930     Text := TGUILabel.Create(fText, FFontID);
1931     with Text do
1932     begin
1933       FColor := MENU_ITEMSTEXT_COLOR;
1934     end;
1935
1936     ControlType := TGUILabel;
1937
1938     Result := (Control as TGUILabel);
1939   end;
1940
1941   if FIndex = -1 then FIndex := i;
1942
1943   ReAlign();
1944 end;
1945
1946 function TGUIMenu.AddMemo(fText: string; Width, Height: Word): TGUIMemo;
1947 var
1948   i: Integer;
1949 begin
1950   i := NewItem();
1951   with FItems[i] do
1952   begin
1953     Control := TGUIMemo.Create(FFontID, Width, Height);
1954     with Control as TGUIMemo do
1955     begin
1956       FWindow := Self.FWindow;
1957       FColor := MENU_ITEMSTEXT_COLOR;
1958     end;
1959
1960     if fText = '' then Text := nil else
1961     begin
1962       Text := TGUILabel.Create(fText, FFontID);
1963       Text.FColor := MENU_ITEMSTEXT_COLOR;
1964     end;
1965
1966     ControlType := TGUIMemo;
1967
1968     Result := (Control as TGUIMemo);
1969   end;
1970
1971   if FIndex = -1 then FIndex := i;
1972
1973   ReAlign();
1974 end;
1975
1976 procedure TGUIMenu.UpdateIndex();
1977 var
1978   res: Boolean;
1979 begin
1980   res := True;
1981
1982   while res do
1983   begin
1984     if (FIndex < 0) or (FIndex > High(FItems)) then
1985       begin
1986         FIndex := -1;
1987         res := False;
1988       end
1989     else
1990       if FItems[FIndex].Control.Enabled then
1991         res := False
1992       else
1993         Inc(FIndex);
1994   end;
1995 end;
1996
1997 { TGUIScroll }
1998
1999 constructor TGUIScroll.Create;
2000 begin
2001   inherited Create();
2002
2003   FMax := 0;
2004   FOnChangeEvent := nil;
2005
2006   g_Texture_Get(SCROLL_LEFT, FLeftID);
2007   g_Texture_Get(SCROLL_RIGHT, FRightID);
2008   g_Texture_Get(SCROLL_MIDDLE, FMiddleID);
2009   g_Texture_Get(SCROLL_MARKER, FMarkerID);
2010 end;
2011
2012 procedure TGUIScroll.Draw;
2013 var
2014   a: Integer;
2015 begin
2016   inherited;
2017
2018   e_Draw(FLeftID, FX, FY, 0, True, False);
2019   e_Draw(FRightID, FX+8+(FMax+1)*8, FY, 0, True, False);
2020
2021   for a := 0 to FMax do
2022     e_Draw(FMiddleID, FX+8+a*8, FY, 0, True, False);
2023
2024   e_Draw(FMarkerID, FX+8+FValue*8, FY, 0, True, False);
2025 end;
2026
2027 procedure TGUIScroll.FSetValue(a: Integer);
2028 begin
2029   if a > FMax then FValue := FMax else FValue := a;
2030 end;
2031
2032 function TGUIScroll.GetWidth: Word;
2033 begin
2034   Result := 16+(FMax+1)*8;
2035 end;
2036
2037 procedure TGUIScroll.OnMessage(var Msg: TMessage);
2038 begin
2039   if not FEnabled then Exit;
2040
2041   inherited;
2042
2043   case Msg.Msg of
2044     WM_KEYDOWN:
2045     begin
2046       case Msg.wParam of
2047         IK_LEFT, IK_KPLEFT:
2048           if FValue > 0 then
2049           begin
2050             Dec(FValue);
2051             g_Sound_PlayEx(SCROLL_SUBSOUND);
2052             if @FOnChangeEvent <> nil then FOnChangeEvent(Self);
2053           end;
2054         IK_RIGHT, IK_KPRIGHT:
2055           if FValue < FMax then
2056           begin
2057             Inc(FValue);
2058             g_Sound_PlayEx(SCROLL_ADDSOUND);
2059             if @FOnChangeEvent <> nil then FOnChangeEvent(Self);
2060           end;
2061       end;
2062     end;
2063   end;
2064 end;
2065
2066 procedure TGUIScroll.Update;
2067 begin
2068   inherited;
2069
2070 end;
2071
2072 { TGUISwitch }
2073
2074 procedure TGUISwitch.AddItem(Item: string);
2075 begin
2076   SetLength(FItems, Length(FItems)+1);
2077   FItems[High(FItems)] := Item;
2078
2079   if FIndex = -1 then FIndex := 0;
2080 end;
2081
2082 constructor TGUISwitch.Create(FontID: DWORD);
2083 begin
2084   inherited Create();
2085
2086   FIndex := -1;
2087
2088   FFont := TFont.Create(FontID, FONT_CHAR);
2089 end;
2090
2091 procedure TGUISwitch.Draw;
2092 begin
2093   inherited;
2094
2095   FFont.Draw(FX, FY, FItems[FIndex], FColor.R, FColor.G, FColor.B);
2096 end;
2097
2098 function TGUISwitch.GetText: string;
2099 begin
2100   if FIndex <> -1 then Result := FItems[FIndex]
2101   else Result := '';
2102 end;
2103
2104 function TGUISwitch.GetWidth: Word;
2105 var
2106   a: Integer;
2107   w, h: Word;
2108 begin
2109   Result := 0;
2110
2111   if FItems = nil then Exit;
2112
2113   for a := 0 to High(FItems) do
2114   begin
2115     FFont.GetTextSize(FItems[a], w, h);
2116     if w > Result then Result := w;
2117   end;
2118 end;
2119
2120 procedure TGUISwitch.OnMessage(var Msg: TMessage);
2121 begin
2122   if not FEnabled then Exit;
2123
2124   inherited;
2125
2126   if FItems = nil then Exit;
2127
2128   case Msg.Msg of
2129     WM_KEYDOWN:
2130       case Msg.wParam of
2131         IK_RETURN, IK_RIGHT, IK_KPRETURN, IK_KPRIGHT:
2132         begin
2133           if FIndex < High(FItems) then
2134             Inc(FIndex)
2135           else
2136             FIndex := 0;
2137
2138           if @FOnChangeEvent <> nil then
2139             FOnChangeEvent(Self);
2140         end;
2141
2142     IK_LEFT, IK_KPLEFT:
2143       begin
2144         if FIndex > 0 then
2145           Dec(FIndex)
2146         else
2147           FIndex := High(FItems);
2148
2149         if @FOnChangeEvent <> nil then
2150           FOnChangeEvent(Self);
2151       end;
2152     end;
2153   end;
2154 end;
2155
2156 procedure TGUISwitch.Update;
2157 begin
2158   inherited;
2159
2160 end;
2161
2162 { TGUIEdit }
2163
2164 constructor TGUIEdit.Create(FontID: DWORD);
2165 begin
2166   inherited Create();
2167
2168   FFont := TFont.Create(FontID, FONT_CHAR);
2169
2170   FMaxLength := 0;
2171   FWidth := 0;
2172
2173   g_Texture_Get(EDIT_LEFT, FLeftID);
2174   g_Texture_Get(EDIT_RIGHT, FRightID);
2175   g_Texture_Get(EDIT_MIDDLE, FMiddleID);
2176 end;
2177
2178 procedure TGUIEdit.Draw;
2179 var
2180   c, w, h: Word;
2181 begin
2182   inherited;
2183
2184   e_Draw(FLeftID, FX, FY, 0, True, False);
2185   e_Draw(FRightID, FX+8+FWidth*16, FY, 0, True, False);
2186
2187   for c := 0 to FWidth-1 do
2188     e_Draw(FMiddleID, FX+8+c*16, FY, 0, True, False);
2189
2190   FFont.Draw(FX+8, FY, FText, FColor.R, FColor.G, FColor.B);
2191
2192   if FWindow.FActiveControl = Self then
2193   begin
2194     FFont.GetTextSize(Copy(FText, 1, FCaretPos), w, h);
2195     h := e_CharFont_GetMaxHeight(FFont.ID);
2196     e_DrawLine(2, FX+8+w, FY+h-3, FX+8+w+EDIT_CURSORLEN, FY+h-3,
2197                EDIT_CURSORCOLOR.R, EDIT_CURSORCOLOR.G, EDIT_CURSORCOLOR.B);
2198   end;
2199 end;
2200
2201 function TGUIEdit.GetWidth: Word;
2202 begin
2203   Result := 16+FWidth*16;
2204 end;
2205
2206 procedure TGUIEdit.OnMessage(var Msg: TMessage);
2207 begin
2208   if not FEnabled then Exit;
2209
2210   inherited;
2211
2212   with Msg do
2213     case Msg of
2214       WM_CHAR:
2215         if FOnlyDigits then
2216         begin
2217           if (wParam in [48..57]) and (Chr(wParam) <> '`') then
2218             if Length(Text) < FMaxLength then
2219             begin
2220               Insert(Chr(wParam), FText, FCaretPos + 1);
2221               Inc(FCaretPos);
2222             end;
2223         end
2224         else
2225         begin
2226           if (wParam in [32..255]) and (Chr(wParam) <> '`') then
2227             if Length(Text) < FMaxLength then
2228             begin
2229               Insert(Chr(wParam), FText, FCaretPos + 1);
2230               Inc(FCaretPos);
2231             end;
2232         end;
2233       WM_KEYDOWN:
2234         case wParam of
2235           IK_BACKSPACE:
2236           begin
2237             Delete(FText, FCaretPos, 1);
2238             if FCaretPos > 0 then Dec(FCaretPos);
2239           end;
2240           IK_DELETE: Delete(FText, FCaretPos + 1, 1);
2241           IK_END, IK_KPEND: FCaretPos := Length(FText);
2242           IK_HOME, IK_KPHOME: FCaretPos := 0;
2243           IK_LEFT, IK_KPLEFT: if FCaretPos > 0 then Dec(FCaretPos);
2244           IK_RIGHT, IK_KPRIGHT: if FCaretPos < Length(FText) then Inc(FCaretPos);
2245           IK_RETURN, IK_KPRETURN:
2246             with FWindow do
2247             begin
2248               if FActiveControl <> Self then
2249               begin
2250                 SetActive(Self);
2251                 if @FOnEnterEvent <> nil then FOnEnterEvent(Self);
2252               end
2253               else
2254               begin
2255                 if FDefControl <> '' then SetActive(GetControl(FDefControl))
2256                 else SetActive(nil);
2257                 if @FOnChangeEvent <> nil then FOnChangeEvent(Self);
2258               end;
2259             end;
2260         end;
2261     end;
2262 end;
2263
2264 procedure TGUIEdit.SetText(Text: string);
2265 begin
2266   if Length(Text) > FMaxLength then SetLength(Text, FMaxLength);
2267   FText := Text;
2268   FCaretPos := Length(FText);
2269 end;
2270
2271 procedure TGUIEdit.Update;
2272 begin
2273   inherited;
2274 end;
2275
2276 { TGUIKeyRead }
2277
2278 constructor TGUIKeyRead.Create(FontID: DWORD);
2279 begin
2280   inherited Create();
2281   FKey := 0;
2282   FIsQuery := false;
2283
2284   FFont := TFont.Create(FontID, FONT_CHAR);
2285 end;
2286
2287 procedure TGUIKeyRead.Draw;
2288 begin
2289   inherited;
2290
2291   FFont.Draw(FX, FY, IfThen(FIsQuery, KEYREAD_QUERY, IfThen(FKey <> 0, e_KeyNames[FKey], KEYREAD_CLEAR)),
2292              FColor.R, FColor.G, FColor.B);
2293 end;
2294
2295 function TGUIKeyRead.GetWidth: Word;
2296 var
2297   a: Byte;
2298   w, h: Word;
2299 begin
2300   Result := 0;
2301
2302   for a := 0 to 255 do
2303   begin
2304     FFont.GetTextSize(e_KeyNames[a], w, h);
2305     Result := Max(Result, w);
2306   end;
2307
2308   FFont.GetTextSize(KEYREAD_QUERY, w, h);
2309   if w > Result then Result := w;
2310
2311   FFont.GetTextSize(KEYREAD_CLEAR, w, h);
2312   if w > Result then Result := w;
2313 end;
2314
2315 function TGUIKeyRead.WantActivationKey (key: LongInt): Boolean;
2316 begin
2317   result :=
2318     (key = IK_BACKSPACE) or
2319     false; // oops
2320 end;
2321
2322 procedure TGUIKeyRead.OnMessage(var Msg: TMessage);
2323   procedure actDefCtl ();
2324   begin
2325     with FWindow do
2326       if FDefControl <> '' then
2327         SetActive(GetControl(FDefControl))
2328       else
2329         SetActive(nil);
2330   end;
2331
2332 begin
2333   inherited;
2334
2335   if not FEnabled then
2336     Exit;
2337
2338   with Msg do
2339     case Msg of
2340       WM_KEYDOWN:
2341         case wParam of
2342           IK_ESCAPE:
2343             begin
2344               if FIsQuery then actDefCtl();
2345               FIsQuery := False;
2346             end;
2347           IK_RETURN, IK_KPRETURN:
2348             begin
2349               if not FIsQuery then
2350                 begin
2351                   with FWindow do
2352                     if FActiveControl <> Self then
2353                       SetActive(Self);
2354
2355                   FIsQuery := True;
2356                 end
2357               else
2358                 begin
2359                   FKey := IK_ENTER; // <Enter>
2360                   FIsQuery := False;
2361                   actDefCtl();
2362                 end;
2363             end;
2364           IK_BACKSPACE: // clear keybinding if we aren't waiting for a key
2365             begin
2366               if not FIsQuery then
2367               begin
2368                 FKey := 0;
2369                 actDefCtl();
2370               end;
2371             end;
2372         end;
2373
2374       MESSAGE_DIKEY:
2375         begin
2376           if not FIsQuery and (wParam = IK_BACKSPACE) then
2377           begin
2378             FKey := 0;
2379             actDefCtl();
2380           end
2381           else if FIsQuery and (wParam <> IK_ENTER) and (wParam <> IK_KPRETURN) then // Not <Enter
2382           begin
2383             if e_KeyNames[wParam] <> '' then
2384               FKey := wParam;
2385             FIsQuery := False;
2386             actDefCtl();
2387           end;
2388         end;
2389     end;
2390 end;
2391
2392 { TGUIKeyRead2 }
2393
2394 constructor TGUIKeyRead2.Create(FontID: DWORD);
2395 var
2396   a: Byte;
2397   w, h: Word;
2398 begin
2399   inherited Create();
2400
2401   FKey0 := 0;
2402   FKey1 := 0;
2403   FKeyIdx := 0;
2404   FIsQuery := False;
2405
2406   FFontID := FontID;
2407   FFont := TFont.Create(FontID, FONT_CHAR);
2408
2409   FMaxKeyNameWdt := 0;
2410   for a := 0 to 255 do
2411   begin
2412     FFont.GetTextSize(e_KeyNames[a], w, h);
2413     FMaxKeyNameWdt := Max(FMaxKeyNameWdt, w);
2414   end;
2415
2416   FFont.GetTextSize(KEYREAD_QUERY, w, h);
2417   if w > FMaxKeyNameWdt then FMaxKeyNameWdt := w;
2418
2419   FFont.GetTextSize(KEYREAD_CLEAR, w, h);
2420   if w > FMaxKeyNameWdt then FMaxKeyNameWdt := w;
2421 end;
2422
2423 procedure TGUIKeyRead2.Draw;
2424   procedure drawText (idx: Integer);
2425   var
2426     x, y: Integer;
2427     r, g, b: Byte;
2428     kk: DWORD;
2429   begin
2430     if idx = 0 then kk := FKey0 else kk := FKey1;
2431     y := FY;
2432     if idx = 0 then x := FX+8 else x := FX+8+FMaxKeyNameWdt+16;
2433     r := 255;
2434     g := 0;
2435     b := 0;
2436     if FKeyIdx = idx then g := 127;
2437     if FIsQuery and (FKeyIdx = idx) then
2438       FFont.Draw(x, y, KEYREAD_QUERY, r, g, b)
2439     else
2440       FFont.Draw(x, y, IfThen(kk <> 0, e_KeyNames[kk], KEYREAD_CLEAR), r, g, b);
2441   end;
2442
2443 begin
2444   inherited;
2445
2446   //FFont.Draw(FX+8, FY, IfThen(FIsQuery and (FKeyIdx = 0), KEYREAD_QUERY, IfThen(FKey0 <> 0, e_KeyNames[FKey0], KEYREAD_CLEAR)), FColor.R, FColor.G, FColor.B);
2447   //FFont.Draw(FX+8+FMaxKeyNameWdt+16, FY, IfThen(FIsQuery and (FKeyIdx = 1), KEYREAD_QUERY, IfThen(FKey1 <> 0, e_KeyNames[FKey1], KEYREAD_CLEAR)), FColor.R, FColor.G, FColor.B);
2448   drawText(0);
2449   drawText(1);
2450 end;
2451
2452 function TGUIKeyRead2.GetWidth: Word;
2453 begin
2454   Result := FMaxKeyNameWdt*2+8+8+16;
2455 end;
2456
2457 function TGUIKeyRead2.WantActivationKey (key: LongInt): Boolean;
2458 begin
2459   result :=
2460     (key = IK_BACKSPACE) or
2461     (key = IK_LEFT) or (key = IK_RIGHT) or
2462     (key = IK_KPLEFT) or (key = IK_KPRIGHT) or
2463     false; // oops
2464 end;
2465
2466 procedure TGUIKeyRead2.OnMessage(var Msg: TMessage);
2467   procedure actDefCtl ();
2468   begin
2469     with FWindow do
2470       if FDefControl <> '' then
2471         SetActive(GetControl(FDefControl))
2472       else
2473         SetActive(nil);
2474   end;
2475
2476 begin
2477   inherited;
2478
2479   if not FEnabled then
2480     Exit;
2481
2482   with Msg do
2483     case Msg of
2484       WM_KEYDOWN:
2485         case wParam of
2486           IK_ESCAPE:
2487             begin
2488               if FIsQuery then actDefCtl();
2489               FIsQuery := False;
2490             end;
2491           IK_RETURN, IK_KPRETURN:
2492             begin
2493               if not FIsQuery then
2494                 begin
2495                   with FWindow do
2496                     if FActiveControl <> Self then
2497                       SetActive(Self);
2498
2499                   FIsQuery := True;
2500                 end
2501               else
2502                 begin
2503                   if (FKeyIdx = 0) then FKey0 := IK_ENTER else FKey1 := IK_ENTER; // <Enter>
2504                   FIsQuery := False;
2505                   actDefCtl();
2506                 end;
2507             end;
2508           IK_BACKSPACE: // clear keybinding if we aren't waiting for a key
2509             begin
2510               if not FIsQuery then
2511               begin
2512                 if (FKeyIdx = 0) then FKey0 := 0 else FKey1 := 0;
2513                 actDefCtl();
2514               end;
2515             end;
2516           IK_LEFT, IK_KPLEFT:
2517             if not FIsQuery then
2518             begin
2519               FKeyIdx := 0;
2520               actDefCtl();
2521             end;
2522           IK_RIGHT, IK_KPRIGHT:
2523             if not FIsQuery then
2524             begin
2525               FKeyIdx := 1;
2526               actDefCtl();
2527             end;
2528         end;
2529
2530       MESSAGE_DIKEY:
2531         begin
2532           if not FIsQuery and (wParam = IK_BACKSPACE) then
2533           begin
2534             if (FKeyIdx = 0) then FKey0 := 0 else FKey1 := 0;
2535             actDefCtl();
2536           end
2537           else if FIsQuery and (wParam <> IK_ENTER) and (wParam <> IK_KPRETURN) then // Not <Enter
2538           begin
2539             if e_KeyNames[wParam] <> '' then
2540             begin
2541               if (FKeyIdx = 0) then FKey0 := wParam else FKey1 := wParam;
2542             end;
2543             FIsQuery := False;
2544             actDefCtl();
2545           end;
2546         end;
2547     end;
2548 end;
2549
2550
2551 { TGUIModelView }
2552
2553 constructor TGUIModelView.Create;
2554 begin
2555   inherited Create();
2556
2557   FModel := nil;
2558 end;
2559
2560 destructor TGUIModelView.Destroy;
2561 begin
2562   FModel.Free();
2563
2564   inherited;
2565 end;
2566
2567 procedure TGUIModelView.Draw;
2568 begin
2569   inherited;
2570
2571   DrawBox(FX, FY, 4, 4);
2572
2573   if FModel <> nil then FModel.Draw(FX+4, FY+4);
2574 end;
2575
2576 procedure TGUIModelView.NextAnim();
2577 begin
2578   if FModel = nil then
2579     Exit;
2580
2581   if FModel.Animation < A_PAIN then
2582     FModel.ChangeAnimation(FModel.Animation+1, True)
2583   else
2584     FModel.ChangeAnimation(A_STAND, True);
2585 end;
2586
2587 procedure TGUIModelView.NextWeapon();
2588 begin
2589   if FModel = nil then
2590     Exit;
2591
2592   if FModel.Weapon < WEAPON_SUPERPULEMET then
2593     FModel.SetWeapon(FModel.Weapon+1)
2594   else
2595     FModel.SetWeapon(WEAPON_KASTET);
2596 end;
2597
2598 procedure TGUIModelView.OnMessage(var Msg: TMessage);
2599 begin
2600   inherited;
2601
2602 end;
2603
2604 procedure TGUIModelView.SetColor(Red, Green, Blue: Byte);
2605 begin
2606   if FModel <> nil then FModel.SetColor(Red, Green, Blue);
2607 end;
2608
2609 procedure TGUIModelView.SetModel(ModelName: string);
2610 begin
2611   FModel.Free();
2612
2613   FModel := g_PlayerModel_Get(ModelName);
2614 end;
2615
2616 procedure TGUIModelView.Update;
2617 begin
2618   inherited;
2619
2620   a := not a;
2621   if a then Exit;
2622
2623   if FModel <> nil then FModel.Update;
2624 end;
2625
2626 { TGUIMapPreview }
2627
2628 constructor TGUIMapPreview.Create();
2629 begin
2630   inherited Create();
2631   ClearMap;
2632 end;
2633
2634 destructor TGUIMapPreview.Destroy();
2635 begin
2636   ClearMap;
2637   inherited;
2638 end;
2639
2640 procedure TGUIMapPreview.Draw();
2641 var
2642   a: Integer;
2643   r, g, b: Byte;
2644 begin
2645   inherited;
2646
2647   DrawBox(FX, FY, MAPPREVIEW_WIDTH, MAPPREVIEW_HEIGHT);
2648
2649   if (FMapSize.X <= 0) or (FMapSize.Y <= 0) then
2650     Exit;
2651
2652   e_DrawFillQuad(FX+4, FY+4,
2653     FX+4 + Trunc(FMapSize.X / FScale) - 1,
2654     FY+4 + Trunc(FMapSize.Y / FScale) - 1,
2655     32, 32, 32, 0);
2656
2657   if FMapData <> nil then
2658     for a := 0 to High(FMapData) do
2659       with FMapData[a] do
2660       begin
2661         if X1 > MAPPREVIEW_WIDTH*16 then Continue;
2662         if Y1 > MAPPREVIEW_HEIGHT*16 then Continue;
2663
2664         if X2 < 0 then Continue;
2665         if Y2 < 0 then Continue;
2666
2667         if X2 > MAPPREVIEW_WIDTH*16 then X2 := MAPPREVIEW_WIDTH*16;
2668         if Y2 > MAPPREVIEW_HEIGHT*16 then Y2 := MAPPREVIEW_HEIGHT*16;
2669
2670         if X1 < 0 then X1 := 0;
2671         if Y1 < 0 then Y1 := 0;
2672
2673         case PanelType of
2674           PANEL_WALL:
2675             begin
2676               r := 255;
2677               g := 255;
2678               b := 255;
2679             end;
2680           PANEL_CLOSEDOOR:
2681             begin
2682               r := 255;
2683               g := 255;
2684               b := 0;
2685             end;
2686           PANEL_WATER:
2687             begin
2688               r := 0;
2689               g := 0;
2690               b := 192;
2691             end;
2692           PANEL_ACID1:
2693             begin
2694               r := 0;
2695               g := 176;
2696               b := 0;
2697             end;
2698           PANEL_ACID2:
2699             begin
2700               r := 176;
2701               g := 0;
2702               b := 0;
2703             end;
2704           else
2705             begin
2706               r := 128;
2707               g := 128;
2708               b := 128;
2709             end;
2710         end;
2711
2712         if ((X2-X1) > 0) and ((Y2-Y1) > 0) then
2713           e_DrawFillQuad(FX+4 + X1, FY+4 + Y1,
2714             FX+4 + X2 - 1, FY+4 + Y2 - 1, r, g, b, 0);
2715       end;
2716 end;
2717
2718 procedure TGUIMapPreview.OnMessage(var Msg: TMessage);
2719 begin
2720   inherited;
2721
2722 end;
2723
2724 procedure TGUIMapPreview.SetMap(Res: string);
2725 var
2726   WAD: TWADFile;
2727   MapReader: TMapReader_1;
2728   panels: TPanelsRec1Array;
2729   header: TMapHeaderRec_1;
2730   a: Integer;
2731   FileName: string;
2732   Data: Pointer;
2733   Len: Integer;
2734   rX, rY: Single;
2735 begin
2736   FileName := g_ExtractWadName(Res);
2737
2738   WAD := TWADFile.Create();
2739   if not WAD.ReadFile(FileName) then
2740   begin
2741     WAD.Free();
2742     Exit;
2743   end;
2744
2745   //k8: ignores path again
2746   if not WAD.GetMapResource(g_ExtractFileName(Res), Data, Len) then
2747   begin
2748     WAD.Free();
2749     Exit;
2750   end;
2751
2752   WAD.Free();
2753
2754   MapReader := TMapReader_1.Create();
2755
2756   if not MapReader.LoadMap(Data) then
2757   begin
2758     FreeMem(Data);
2759     MapReader.Free();
2760     FMapSize.X := 0;
2761     FMapSize.Y := 0;
2762     FScale := 0.0;
2763     FMapData := nil;
2764     Exit;
2765   end;
2766
2767   FreeMem(Data);
2768
2769   panels := MapReader.GetPanels();
2770   header := MapReader.GetMapHeader();
2771
2772   FMapSize.X := header.Width div 16;
2773   FMapSize.Y := header.Height div 16;
2774
2775   rX := Ceil(header.Width / (MAPPREVIEW_WIDTH*256.0));
2776   rY := Ceil(header.Height / (MAPPREVIEW_HEIGHT*256.0));
2777   FScale := max(rX, rY);
2778
2779   FMapData := nil;
2780
2781   if panels <> nil then
2782     for a := 0 to High(panels) do
2783       if WordBool(panels[a].PanelType and (PANEL_WALL or PANEL_CLOSEDOOR or
2784                                            PANEL_STEP or PANEL_WATER or
2785                                            PANEL_ACID1 or PANEL_ACID2)) then
2786       begin
2787         SetLength(FMapData, Length(FMapData)+1);
2788         with FMapData[High(FMapData)] do
2789         begin
2790           X1 := panels[a].X div 16;
2791           Y1 := panels[a].Y div 16;
2792
2793           X2 := (panels[a].X + panels[a].Width) div 16;
2794           Y2 := (panels[a].Y + panels[a].Height) div 16;
2795
2796           X1 := Trunc(X1/FScale + 0.5);
2797           Y1 := Trunc(Y1/FScale + 0.5);
2798           X2 := Trunc(X2/FScale + 0.5);
2799           Y2 := Trunc(Y2/FScale + 0.5);
2800
2801           if (X1 <> X2) or (Y1 <> Y2) then
2802           begin
2803             if X1 = X2 then
2804               X2 := X2 + 1;
2805             if Y1 = Y2 then
2806               Y2 := Y2 + 1;
2807           end;
2808
2809           PanelType := panels[a].PanelType;
2810       end;
2811    end;
2812
2813   panels := nil;
2814
2815   MapReader.Free();
2816 end;
2817
2818 procedure TGUIMapPreview.ClearMap();
2819 begin
2820   SetLength(FMapData, 0);
2821   FMapData := nil;
2822   FMapSize.X := 0;
2823   FMapSize.Y := 0;
2824   FScale := 0.0;
2825 end;
2826
2827 procedure TGUIMapPreview.Update();
2828 begin
2829   inherited;
2830
2831 end;
2832
2833 function TGUIMapPreview.GetScaleStr(): String;
2834 begin
2835   if FScale > 0.0 then
2836     begin
2837       Result := FloatToStrF(FScale*16.0, ffFixed, 3, 3);
2838       while (Result[Length(Result)] = '0') do
2839         Delete(Result, Length(Result), 1);
2840       if (Result[Length(Result)] = ',') or (Result[Length(Result)] = '.') then
2841         Delete(Result, Length(Result), 1);
2842       Result := '1 : ' + Result;
2843     end
2844   else
2845     Result := '';
2846 end;
2847
2848 { TGUIListBox }
2849
2850 procedure TGUIListBox.AddItem(Item: string);
2851 begin
2852   SetLength(FItems, Length(FItems)+1);
2853   FItems[High(FItems)] := Item;
2854
2855   if FSort then g_Basic.Sort(FItems);
2856 end;
2857
2858 procedure TGUIListBox.Clear();
2859 begin
2860   FItems := nil;
2861
2862   FStartLine := 0;
2863   FIndex := -1;
2864 end;
2865
2866 constructor TGUIListBox.Create(FontID: DWORD; Width, Height: Word);
2867 begin
2868   inherited Create();
2869
2870   FFont := TFont.Create(FontID, FONT_CHAR);
2871
2872   FWidth := Width;
2873   FHeight := Height;
2874   FIndex := -1;
2875   FOnChangeEvent := nil;
2876   FDrawBack := True;
2877   FDrawScroll := True;
2878 end;
2879
2880 procedure TGUIListBox.Draw;
2881 var
2882   w2, h2: Word;
2883   a: Integer;
2884   s: string;
2885 begin
2886   inherited;
2887
2888   if FDrawBack then DrawBox(FX, FY, FWidth+1, FHeight);
2889   if FDrawScroll then
2890     DrawScroll(FX+4+FWidth*16, FY+4, FHeight, (FStartLine > 0) and (FItems <> nil),
2891               (FStartLine+FHeight-1 < High(FItems)) and (FItems <> nil));
2892
2893   if FItems <> nil then
2894     for a := FStartLine to Min(High(FItems), FStartLine+FHeight-1) do
2895     begin
2896       s := Items[a];
2897
2898       FFont.GetTextSize(s, w2, h2);
2899       while (Length(s) > 0) and (w2 > FWidth*16) do
2900       begin
2901         SetLength(s, Length(s)-1);
2902         FFont.GetTextSize(s, w2, h2);
2903       end;
2904
2905       if a = FIndex then
2906         FFont.Draw(FX+4, FY+4+(a-FStartLine)*16, s, FActiveColor.R, FActiveColor.G, FActiveColor.B)
2907       else
2908         FFont.Draw(FX+4, FY+4+(a-FStartLine)*16, s, FUnActiveColor.R, FUnActiveColor.G, FUnActiveColor.B);
2909     end;
2910 end;
2911
2912 function TGUIListBox.GetHeight: Word;
2913 begin
2914   Result := 8+FHeight*16;
2915 end;
2916
2917 function TGUIListBox.GetWidth: Word;
2918 begin
2919   Result := 8+(FWidth+1)*16;
2920 end;
2921
2922 procedure TGUIListBox.OnMessage(var Msg: TMessage);
2923 var
2924   a: Integer;
2925 begin
2926   if not FEnabled then Exit;
2927
2928   inherited;
2929
2930   if FItems = nil then Exit;
2931
2932   with Msg do
2933     case Msg of
2934       WM_KEYDOWN:
2935         case wParam of
2936           IK_HOME, IK_KPHOME:
2937           begin
2938             FIndex := 0;
2939             FStartLine := 0;
2940           end;
2941           IK_END, IK_KPEND:
2942           begin
2943             FIndex := High(FItems);
2944             FStartLine := Max(High(FItems)-FHeight+1, 0);
2945           end;
2946           IK_UP, IK_LEFT, IK_KPUP, IK_KPLEFT:
2947             if FIndex > 0 then
2948             begin
2949               Dec(FIndex);
2950               if FIndex < FStartLine then Dec(FStartLine);
2951               if @FOnChangeEvent <> nil then FOnChangeEvent(Self);
2952             end;
2953           IK_DOWN, IK_RIGHT, IK_KPDOWN, IK_KPRIGHT:
2954             if FIndex < High(FItems) then
2955             begin
2956               Inc(FIndex);
2957               if FIndex > FStartLine+FHeight-1 then Inc(FStartLine);
2958               if @FOnChangeEvent <> nil then FOnChangeEvent(Self);
2959             end;
2960           IK_RETURN, IK_KPRETURN:
2961             with FWindow do
2962             begin
2963               if FActiveControl <> Self then SetActive(Self)
2964               else
2965                 if FDefControl <> '' then SetActive(GetControl(FDefControl))
2966                 else SetActive(nil);
2967             end;
2968         end;
2969       WM_CHAR:
2970         for a := 0 to High(FItems) do
2971           if (Length(FItems[a]) > 0) and (LowerCase(FItems[a][1]) = LowerCase(Chr(wParam))) then
2972           begin
2973             FIndex := a;
2974             FStartLine := Min(Max(FIndex-1, 0), Length(FItems)-FHeight);
2975             if @FOnChangeEvent <> nil then FOnChangeEvent(Self);
2976             Break;
2977           end;
2978     end;
2979 end;
2980
2981 function TGUIListBox.SelectedItem(): String;
2982 begin
2983   Result := '';
2984
2985   if (FIndex < 0) or (FItems = nil) or
2986      (FIndex > High(FItems)) then
2987     Exit;
2988
2989   Result := FItems[FIndex];
2990 end;
2991
2992 procedure TGUIListBox.FSetItems(Items: SArray);
2993 begin
2994   if FItems <> nil then
2995     FItems := nil;
2996
2997   FItems := Items;
2998
2999   FStartLine := 0;
3000   FIndex := -1;
3001
3002   if FSort then g_Basic.Sort(FItems);
3003 end;
3004
3005 procedure TGUIListBox.SelectItem(Item: String);
3006 var
3007   a: Integer;
3008 begin
3009   if FItems = nil then
3010     Exit;
3011
3012   FIndex := 0;
3013   Item := LowerCase(Item);
3014
3015   for a := 0 to High(FItems) do
3016     if LowerCase(FItems[a]) = Item then
3017     begin
3018       FIndex := a;
3019       Break;
3020     end;
3021
3022   if FIndex < FHeight then
3023     FStartLine := 0
3024   else
3025     FStartLine := Min(FIndex, Length(FItems)-FHeight);
3026 end;
3027
3028 procedure TGUIListBox.FSetIndex(aIndex: Integer);
3029 begin
3030   if FItems = nil then
3031     Exit;
3032
3033   if (aIndex < 0) or (aIndex > High(FItems)) then
3034     Exit;
3035
3036   FIndex := aIndex;
3037
3038   if FIndex <= FHeight then
3039     FStartLine := 0
3040   else
3041     FStartLine := Min(FIndex, Length(FItems)-FHeight);
3042 end;
3043
3044 { TGUIFileListBox }
3045
3046 procedure TGUIFileListBox.OnMessage(var Msg: TMessage);
3047 var
3048   a: Integer;
3049 begin
3050   if not FEnabled then
3051     Exit;
3052
3053   if FItems = nil then
3054     Exit;
3055
3056   with Msg do
3057     case Msg of
3058       WM_KEYDOWN:
3059         case wParam of
3060           IK_HOME, IK_KPHOME:
3061             begin
3062               FIndex := 0;
3063               FStartLine := 0;
3064               if @FOnChangeEvent <> nil then
3065                 FOnChangeEvent(Self);
3066             end;
3067
3068           IK_END, IK_KPEND:
3069             begin
3070               FIndex := High(FItems);
3071               FStartLine := Max(High(FItems)-FHeight+1, 0);
3072               if @FOnChangeEvent <> nil then
3073                 FOnChangeEvent(Self);
3074             end;
3075
3076           IK_PAGEUP, IK_KPPAGEUP:
3077             begin
3078               if FIndex > FHeight then
3079                 FIndex := FIndex-FHeight
3080               else
3081                 FIndex := 0;
3082
3083               if FStartLine > FHeight then
3084                 FStartLine := FStartLine-FHeight
3085               else
3086                 FStartLine := 0;
3087             end;
3088
3089           IK_PAGEDN, IK_KPPAGEDN:
3090             begin
3091               if FIndex < High(FItems)-FHeight then
3092                 FIndex := FIndex+FHeight
3093               else
3094                 FIndex := High(FItems);
3095
3096               if FStartLine < High(FItems)-FHeight then
3097                 FStartLine := FStartLine+FHeight
3098               else
3099                 FStartLine := High(FItems)-FHeight+1;
3100             end;
3101
3102           IK_UP, IK_LEFT, IK_KPUP, IK_KPLEFT:
3103             if FIndex > 0 then
3104             begin
3105               Dec(FIndex);
3106               if FIndex < FStartLine then
3107                 Dec(FStartLine);
3108               if @FOnChangeEvent <> nil then
3109                 FOnChangeEvent(Self);
3110             end;
3111
3112           IK_DOWN, IK_RIGHT, IK_KPDOWN, IK_KPRIGHT:
3113             if FIndex < High(FItems) then
3114             begin
3115               Inc(FIndex);
3116               if FIndex > FStartLine+FHeight-1 then
3117                 Inc(FStartLine);
3118               if @FOnChangeEvent <> nil then
3119                 FOnChangeEvent(Self);
3120             end;
3121
3122           IK_RETURN, IK_KPRETURN:
3123             with FWindow do
3124             begin
3125               if FActiveControl <> Self then
3126                 SetActive(Self)
3127               else
3128                 begin
3129                   if FItems[FIndex][1] = #29 then // Ïàïêà
3130                   begin
3131                     OpenDir(FPath+Copy(FItems[FIndex], 2, 255));
3132                     FIndex := 0;
3133                     Exit;
3134                   end;
3135
3136                   if FDefControl <> '' then
3137                     SetActive(GetControl(FDefControl))
3138                   else
3139                     SetActive(nil);
3140                 end;
3141             end;
3142         end;
3143
3144       WM_CHAR:
3145         for a := 0 to High(FItems) do
3146           if ( (Length(FItems[a]) > 0) and
3147                (LowerCase(FItems[a][1]) = LowerCase(Chr(wParam))) ) or
3148              ( (Length(FItems[a]) > 1) and
3149                (FItems[a][1] = #29) and // Ïàïêà
3150                (LowerCase(FItems[a][2]) = LowerCase(Chr(wParam))) ) then
3151           begin
3152             FIndex := a;
3153             FStartLine := Min(Max(FIndex-1, 0), Length(FItems)-FHeight);
3154             if @FOnChangeEvent <> nil then
3155               FOnChangeEvent(Self);
3156             Break;
3157           end;
3158     end;
3159 end;
3160
3161 procedure TGUIFileListBox.OpenDir(path: String);
3162 var
3163   SR: TSearchRec;
3164   i: Integer;
3165   sm, sc: string;
3166 begin
3167   Clear();
3168
3169   path := IncludeTrailingPathDelimiter(path);
3170   path := ExpandFileName(path);
3171
3172   // Êàòàëîãè:
3173   if FDirs then
3174   begin
3175     if FindFirst(path+'*', faDirectory, SR) = 0 then
3176     repeat
3177       if not LongBool(SR.Attr and faDirectory) then
3178         Continue;
3179       if (SR.Name = '.') or
3180          ((SR.Name = '..') and (path = ExpandFileName(FBasePath))) then
3181         Continue;
3182
3183       AddItem(#1 + SR.Name);
3184     until FindNext(SR) <> 0;
3185
3186     FindClose(SR);
3187   end;
3188
3189   // Ôàéëû:
3190   sm := FFileMask;
3191   while sm <> '' do
3192   begin
3193     i := Pos('|', sm);
3194     if i = 0 then i := length(sm)+1;
3195     sc := Copy(sm, 1, i-1);
3196     Delete(sm, 1, i);
3197     if FindFirst(path+sc, faAnyFile, SR) = 0 then repeat AddItem(SR.Name); until FindNext(SR) <> 0;
3198     FindClose(SR);
3199   end;
3200
3201   for i := 0 to High(FItems) do
3202     if FItems[i][1] = #1 then
3203       FItems[i][1] := #29;
3204
3205   FPath := path;
3206 end;
3207
3208 procedure TGUIFileListBox.SetBase(path: String);
3209 begin
3210   FBasePath := path;
3211   OpenDir(FBasePath);
3212 end;
3213
3214 function TGUIFileListBox.SelectedItem(): String;
3215 begin
3216   Result := '';
3217
3218   if (FIndex = -1) or (FItems = nil) or
3219      (FIndex > High(FItems)) or
3220      (FItems[FIndex][1] = '/') or
3221      (FItems[FIndex][1] = '\') then
3222     Exit;
3223
3224   Result := FPath + FItems[FIndex];
3225 end;
3226
3227 procedure TGUIFileListBox.UpdateFileList();
3228 var
3229   fn: String;
3230 begin
3231   if (FIndex = -1) or (FItems = nil) or
3232      (FIndex > High(FItems)) or
3233      (FItems[FIndex][1] = '/') or
3234      (FItems[FIndex][1] = '\') then
3235     fn := ''
3236   else
3237     fn := FItems[FIndex];
3238
3239   OpenDir(FPath);
3240
3241   if fn <> '' then
3242     SelectItem(fn);
3243 end;
3244
3245 { TGUIMemo }
3246
3247 procedure TGUIMemo.Clear;
3248 begin
3249   FLines := nil;
3250   FStartLine := 0;
3251 end;
3252
3253 constructor TGUIMemo.Create(FontID: DWORD; Width, Height: Word);
3254 begin
3255   inherited Create();
3256
3257   FFont := TFont.Create(FontID, FONT_CHAR);
3258
3259   FWidth := Width;
3260   FHeight := Height;
3261   FDrawBack := True;
3262   FDrawScroll := True;
3263 end;
3264
3265 procedure TGUIMemo.Draw;
3266 var
3267   a: Integer;
3268 begin
3269   inherited;
3270
3271   if FDrawBack then DrawBox(FX, FY, FWidth+1, FHeight);
3272   if FDrawScroll then
3273     DrawScroll(FX+4+FWidth*16, FY+4, FHeight, (FStartLine > 0) and (FLines <> nil),
3274               (FStartLine+FHeight-1 < High(FLines)) and (FLines <> nil));
3275
3276   if FLines <> nil then
3277     for a := FStartLine to Min(High(FLines), FStartLine+FHeight-1) do
3278       FFont.Draw(FX+4, FY+4+(a-FStartLine)*16, FLines[a], FColor.R, FColor.G, FColor.B);
3279 end;
3280
3281 function TGUIMemo.GetHeight: Word;
3282 begin
3283   Result := 8+FHeight*16;
3284 end;
3285
3286 function TGUIMemo.GetWidth: Word;
3287 begin
3288   Result := 8+(FWidth+1)*16;
3289 end;
3290
3291 procedure TGUIMemo.OnMessage(var Msg: TMessage);
3292 begin
3293   if not FEnabled then Exit;
3294
3295   inherited;
3296
3297   if FLines = nil then Exit;
3298
3299   with Msg do
3300     case Msg of
3301       WM_KEYDOWN:
3302         case wParam of
3303           IK_UP, IK_LEFT, IK_KPUP, IK_KPLEFT:
3304             if FStartLine > 0 then
3305               Dec(FStartLine);
3306           IK_DOWN, IK_RIGHT, IK_KPDOWN, IK_KPRIGHT:
3307             if FStartLine < Length(FLines)-FHeight then
3308               Inc(FStartLine);
3309           IK_RETURN, IK_KPRETURN:
3310             with FWindow do
3311             begin
3312               if FActiveControl <> Self then
3313               begin
3314                 SetActive(Self);
3315                 {FStartLine := 0;}
3316               end
3317               else
3318               if FDefControl <> '' then SetActive(GetControl(FDefControl))
3319                 else SetActive(nil);
3320             end;
3321         end;
3322     end;
3323 end;
3324
3325 procedure TGUIMemo.SetText(Text: string);
3326 begin
3327   FStartLine := 0;
3328   FLines := GetLines(Text, FFont.ID, FWidth*16);
3329 end;
3330
3331 { TGUIimage }
3332
3333 procedure TGUIimage.ClearImage();
3334 begin
3335   if FImageRes = '' then Exit;
3336
3337   g_Texture_Delete(FImageRes);
3338   FImageRes := '';
3339 end;
3340
3341 constructor TGUIimage.Create();
3342 begin
3343   inherited Create();
3344
3345   FImageRes := '';
3346 end;
3347
3348 destructor TGUIimage.Destroy();
3349 begin
3350   inherited;
3351 end;
3352
3353 procedure TGUIimage.Draw();
3354 var
3355   ID: DWORD;
3356 begin
3357   inherited;
3358
3359   if FImageRes = '' then
3360   begin
3361     if g_Texture_Get(FDefaultRes, ID) then e_Draw(ID, FX, FY, 0, True, False);
3362   end
3363   else
3364     if g_Texture_Get(FImageRes, ID) then e_Draw(ID, FX, FY, 0, True, False);
3365 end;
3366
3367 procedure TGUIimage.OnMessage(var Msg: TMessage);
3368 begin
3369   inherited;
3370 end;
3371
3372 procedure TGUIimage.SetImage(Res: string);
3373 begin
3374   ClearImage();
3375
3376   if g_Texture_CreateWADEx(Res, Res) then FImageRes := Res;
3377 end;
3378
3379 procedure TGUIimage.Update();
3380 begin
3381   inherited;
3382 end;
3383
3384 end.