src/game/g_gui.pas

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