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