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