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