src/game/g_gui.pas

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