src/game/g_gui.pas

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