DEADSOFTWARE

960ba747cc4f083b5b29019809632ec9242b54cf
[d2df-sdl.git] / 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;
18 interface
20 uses
21 {$IFDEF USE_MEMPOOL}mempool,{$ENDIF}
22 g_base, r_graphics, e_input, e_log, g_playermodel, g_basic, g_touch, MAPDEF, utils;
24 const
25 MAINMENU_HEADER_COLOR: TRGB = (R:255; G:255; B:255);
26 MAINMENU_ITEMS_COLOR: TRGB = (R:255; G:255; B:255);
27 MAINMENU_UNACTIVEITEMS_COLOR: TRGB = (R:192; G:192; B:192);
28 MAINMENU_CLICKSOUND = 'MENU_SELECT';
29 MAINMENU_CHANGESOUND = 'MENU_CHANGE';
30 MAINMENU_SPACE = 4;
31 MAINMENU_MARKER1 = 'MAINMENU_MARKER1';
32 MAINMENU_MARKER2 = 'MAINMENU_MARKER2';
33 MAINMENU_MARKERDELAY = 24;
34 WINDOW_CLOSESOUND = 'MENU_CLOSE';
35 MENU_HEADERCOLOR: TRGB = (R:255; G:255; B:255);
36 MENU_ITEMSTEXT_COLOR: TRGB = (R:255; G:255; B:255);
37 MENU_UNACTIVEITEMS_COLOR: TRGB = (R:128; G:128; B:128);
38 MENU_ITEMSCTRL_COLOR: TRGB = (R:255; G:0; B:0);
39 MENU_VSPACE = 2;
40 MENU_HSPACE = 32;
41 MENU_CLICKSOUND = 'MENU_SELECT';
42 MENU_CHANGESOUND = 'MENU_CHANGE';
43 MENU_MARKERDELAY = 24;
44 SCROLL_LEFT = 'SCROLL_LEFT';
45 SCROLL_RIGHT = 'SCROLL_RIGHT';
46 SCROLL_MIDDLE = 'SCROLL_MIDDLE';
47 SCROLL_MARKER = 'SCROLL_MARKER';
48 SCROLL_ADDSOUND = 'SCROLL_ADD';
49 SCROLL_SUBSOUND = 'SCROLL_SUB';
50 EDIT_LEFT = 'EDIT_LEFT';
51 EDIT_RIGHT = 'EDIT_RIGHT';
52 EDIT_MIDDLE = 'EDIT_MIDDLE';
53 EDIT_CURSORCOLOR: TRGB = (R:200; G:0; B:0);
54 EDIT_CURSORLEN = 10;
55 KEYREAD_QUERY = '<...>';
56 KEYREAD_CLEAR = '???';
57 KEYREAD_TIMEOUT = 24;
58 MAPPREVIEW_WIDTH = 8;
59 MAPPREVIEW_HEIGHT = 8;
60 BOX1 = 'BOX1';
61 BOX2 = 'BOX2';
62 BOX3 = 'BOX3';
63 BOX4 = 'BOX4';
64 BOX5 = 'BOX5';
65 BOX6 = 'BOX6';
66 BOX7 = 'BOX7';
67 BOX8 = 'BOX8';
68 BOX9 = 'BOX9';
69 BSCROLL_UPA = 'BSCROLL_UP_A';
70 BSCROLL_UPU = 'BSCROLL_UP_U';
71 BSCROLL_DOWNA = 'BSCROLL_DOWN_A';
72 BSCROLL_DOWNU = 'BSCROLL_DOWN_U';
73 BSCROLL_MIDDLE = 'BSCROLL_MIDDLE';
74 WM_KEYDOWN = 101;
75 WM_CHAR = 102;
76 WM_USER = 110;
78 type
79 TMessage = record
80 Msg: DWORD;
81 wParam: LongInt;
82 lParam: LongInt;
83 end;
85 TFontType = (Texture, Character);
87 TFont = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF}
88 private
89 ID: DWORD;
90 FScale: Single;
91 FFontType: TFontType;
92 public
93 constructor Create(FontID: DWORD; FontType: TFontType);
94 destructor Destroy; override;
95 procedure Draw(X, Y: Integer; Text: string; R, G, B: Byte);
96 procedure GetTextSize(Text: string; var w, h: Word);
97 property Scale: Single read FScale write FScale;
98 end;
100 TGUIControl = class;
101 TGUIWindow = class;
103 TOnKeyDownEvent = procedure(Key: Byte);
104 TOnKeyDownEventEx = procedure(win: TGUIWindow; Key: Byte);
105 TOnCloseEvent = procedure;
106 TOnShowEvent = procedure;
107 TOnClickEvent = procedure;
108 TOnChangeEvent = procedure(Sender: TGUIControl);
109 TOnEnterEvent = procedure(Sender: TGUIControl);
111 TGUIControl = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF}
112 private
113 FX, FY: Integer;
114 FEnabled: Boolean;
115 FWindow : TGUIWindow;
116 FName: string;
117 FUserData: Pointer;
118 FRightAlign: Boolean; //HACK! this works only for "normal" menus, only for menu text labels, and generally sux. sorry.
119 FMaxWidth: Integer; //HACK! used for right-aligning labels
120 public
121 constructor Create;
122 procedure OnMessage(var Msg: TMessage); virtual;
123 procedure Update; virtual;
124 procedure Draw; virtual;
125 function GetWidth(): Integer; virtual;
126 function GetHeight(): Integer; virtual;
127 function WantActivationKey (key: LongInt): Boolean; virtual;
128 property X: Integer read FX write FX;
129 property Y: Integer read FY write FY;
130 property Enabled: Boolean read FEnabled write FEnabled;
131 property Name: string read FName write FName;
132 property UserData: Pointer read FUserData write FUserData;
133 property RightAlign: Boolean read FRightAlign write FRightAlign; // for menu
134 end;
136 TGUIWindow = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF}
137 private
138 FActiveControl: TGUIControl;
139 FDefControl: string;
140 FPrevWindow: TGUIWindow;
141 FName: string;
142 FBackTexture: string;
143 FMainWindow: Boolean;
144 FOnKeyDown: TOnKeyDownEvent;
145 FOnKeyDownEx: TOnKeyDownEventEx;
146 FOnCloseEvent: TOnCloseEvent;
147 FOnShowEvent: TOnShowEvent;
148 FUserData: Pointer;
149 public
150 Childs: array of TGUIControl;
151 constructor Create(Name: string);
152 destructor Destroy; override;
153 function AddChild(Child: TGUIControl): TGUIControl;
154 procedure OnMessage(var Msg: TMessage);
155 procedure Update;
156 procedure Draw;
157 procedure SetActive(Control: TGUIControl);
158 function GetControl(Name: string): TGUIControl;
159 property OnKeyDown: TOnKeyDownEvent read FOnKeyDown write FOnKeyDown;
160 property OnKeyDownEx: TOnKeyDownEventEx read FOnKeyDownEx write FOnKeyDownEx;
161 property OnClose: TOnCloseEvent read FOnCloseEvent write FOnCloseEvent;
162 property OnShow: TOnShowEvent read FOnShowEvent write FOnShowEvent;
163 property Name: string read FName;
164 property DefControl: string read FDefControl write FDefControl;
165 property BackTexture: string read FBackTexture write FBackTexture;
166 property MainWindow: Boolean read FMainWindow write FMainWindow;
167 property UserData: Pointer read FUserData write FUserData;
168 end;
170 TGUITextButton = class(TGUIControl)
171 private
172 FText: string;
173 FColor: TRGB;
174 FFont: TFont;
175 FSound: string;
176 FShowWindow: string;
177 public
178 Proc: procedure;
179 ProcEx: procedure (sender: TGUITextButton);
180 constructor Create(aProc: Pointer; FontID: DWORD; Text: string);
181 destructor Destroy(); override;
182 procedure OnMessage(var Msg: TMessage); override;
183 procedure Update(); override;
184 procedure Draw(); override;
185 function GetWidth(): Integer; override;
186 function GetHeight(): Integer; override;
187 procedure Click(Silent: Boolean = False);
188 property Caption: string read FText write FText;
189 property Color: TRGB read FColor write FColor;
190 property Font: TFont read FFont write FFont;
191 property ShowWindow: string read FShowWindow write FShowWindow;
192 end;
194 TGUILabel = class(TGUIControl)
195 private
196 FText: string;
197 FColor: TRGB;
198 FFont: TFont;
199 FFixedLen: Word;
200 FOnClickEvent: TOnClickEvent;
201 public
202 constructor Create(Text: string; FontID: DWORD);
203 procedure OnMessage(var Msg: TMessage); override;
204 procedure Draw; override;
205 function GetWidth: Integer; override;
206 function GetHeight: Integer; override;
207 property OnClick: TOnClickEvent read FOnClickEvent write FOnClickEvent;
208 property FixedLength: Word read FFixedLen write FFixedLen;
209 property Text: string read FText write FText;
210 property Color: TRGB read FColor write FColor;
211 property Font: TFont read FFont write FFont;
212 end;
214 TGUIScroll = class(TGUIControl)
215 private
216 FValue: Integer;
217 FMax: Word;
218 FLeftID: DWORD;
219 FRightID: DWORD;
220 FMiddleID: DWORD;
221 FMarkerID: DWORD;
222 FOnChangeEvent: TOnChangeEvent;
223 procedure FSetValue(a: Integer);
224 public
225 constructor Create();
226 procedure OnMessage(var Msg: TMessage); override;
227 procedure Update; override;
228 procedure Draw; override;
229 function GetWidth(): Integer; override;
230 property OnChange: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent;
231 property Max: Word read FMax write FMax;
232 property Value: Integer read FValue write FSetValue;
233 end;
235 TGUISwitch = class(TGUIControl)
236 private
237 FFont: TFont;
238 FItems: array of string;
239 FIndex: Integer;
240 FColor: TRGB;
241 FOnChangeEvent: TOnChangeEvent;
242 public
243 constructor Create(FontID: DWORD);
244 procedure OnMessage(var Msg: TMessage); override;
245 procedure AddItem(Item: string);
246 procedure Update; override;
247 procedure Draw; override;
248 function GetWidth(): Integer; override;
249 function GetText: string;
250 property ItemIndex: Integer read FIndex write FIndex;
251 property Color: TRGB read FColor write FColor;
252 property Font: TFont read FFont write FFont;
253 property OnChange: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent;
254 end;
256 TGUIEdit = class(TGUIControl)
257 private
258 FFont: TFont;
259 FCaretPos: Integer;
260 FMaxLength: Word;
261 FWidth: Word;
262 FText: string;
263 FColor: TRGB;
264 FOnlyDigits: Boolean;
265 FLeftID: DWORD;
266 FRightID: DWORD;
267 FMiddleID: DWORD;
268 FOnChangeEvent: TOnChangeEvent;
269 FOnEnterEvent: TOnEnterEvent;
270 FInvalid: Boolean;
271 procedure SetText(Text: string);
272 public
273 constructor Create(FontID: DWORD);
274 procedure OnMessage(var Msg: TMessage); override;
275 procedure Update; override;
276 procedure Draw; override;
277 function GetWidth(): Integer; override;
278 property OnChange: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent;
279 property OnEnter: TOnEnterEvent read FOnEnterEvent write FOnEnterEvent;
280 property Width: Word read FWidth write FWidth;
281 property MaxLength: Word read FMaxLength write FMaxLength;
282 property OnlyDigits: Boolean read FOnlyDigits write FOnlyDigits;
283 property Text: string read FText write SetText;
284 property Color: TRGB read FColor write FColor;
285 property Font: TFont read FFont write FFont;
286 property Invalid: Boolean read FInvalid write FInvalid;
287 end;
289 TGUIKeyRead = class(TGUIControl)
290 private
291 FFont: TFont;
292 FColor: TRGB;
293 FKey: Word;
294 FIsQuery: Boolean;
295 public
296 constructor Create(FontID: DWORD);
297 procedure OnMessage(var Msg: TMessage); override;
298 procedure Draw; override;
299 function GetWidth(): Integer; override;
300 function WantActivationKey (key: LongInt): Boolean; override;
301 property Key: Word read FKey write FKey;
302 property Color: TRGB read FColor write FColor;
303 property Font: TFont read FFont write FFont;
304 end;
306 // can hold two keys
307 TGUIKeyRead2 = class(TGUIControl)
308 private
309 FFont: TFont;
310 FFontID: DWORD;
311 FColor: TRGB;
312 FKey0, FKey1: Word; // this should be an array. sorry.
313 FKeyIdx: Integer;
314 FIsQuery: Boolean;
315 FMaxKeyNameWdt: Integer;
316 public
317 constructor Create(FontID: DWORD);
318 procedure OnMessage(var Msg: TMessage); override;
319 procedure Draw; override;
320 function GetWidth(): Integer; override;
321 function WantActivationKey (key: LongInt): Boolean; override;
322 property Key0: Word read FKey0 write FKey0;
323 property Key1: Word read FKey1 write FKey1;
324 property Color: TRGB read FColor write FColor;
325 property Font: TFont read FFont write FFont;
326 end;
328 TGUIModelView = class(TGUIControl)
329 private
330 FModel: TPlayerModel;
331 a: Boolean;
332 public
333 constructor Create;
334 destructor Destroy; override;
335 procedure OnMessage(var Msg: TMessage); override;
336 procedure SetModel(ModelName: string);
337 procedure SetColor(Red, Green, Blue: Byte);
338 procedure NextAnim();
339 procedure NextWeapon();
340 procedure Update; override;
341 procedure Draw; override;
342 property Model: TPlayerModel read FModel;
343 end;
345 TPreviewPanel = record
346 X1, Y1, X2, Y2: Integer;
347 PanelType: Word;
348 end;
350 TGUIMapPreview = class(TGUIControl)
351 private
352 FMapData: array of TPreviewPanel;
353 FMapSize: TDFPoint;
354 FScale: Single;
355 public
356 constructor Create();
357 destructor Destroy(); override;
358 procedure OnMessage(var Msg: TMessage); override;
359 procedure SetMap(Res: string);
360 procedure ClearMap();
361 procedure Update(); override;
362 procedure Draw(); override;
363 function GetScaleStr: String;
364 end;
366 TGUIImage = class(TGUIControl)
367 private
368 FImageRes: string;
369 FDefaultRes: string;
370 public
371 constructor Create();
372 destructor Destroy(); override;
373 procedure OnMessage(var Msg: TMessage); override;
374 procedure SetImage(Res: string);
375 procedure ClearImage();
376 procedure Update(); override;
377 procedure Draw(); override;
378 property DefaultRes: string read FDefaultRes write FDefaultRes;
379 end;
381 TGUIListBox = class(TGUIControl)
382 private
383 FItems: SSArray;
384 FActiveColor: TRGB;
385 FUnActiveColor: TRGB;
386 FFont: TFont;
387 FStartLine: Integer;
388 FIndex: Integer;
389 FWidth: Word;
390 FHeight: Word;
391 FSort: Boolean;
392 FDrawBack: Boolean;
393 FDrawScroll: Boolean;
394 FOnChangeEvent: TOnChangeEvent;
396 procedure FSetItems(Items: SSArray);
397 procedure FSetIndex(aIndex: Integer);
399 public
400 constructor Create(FontID: DWORD; Width, Height: Word);
401 procedure OnMessage(var Msg: TMessage); override;
402 procedure Draw(); override;
403 procedure AddItem(Item: String);
404 function ItemExists (item: String): Boolean;
405 procedure SelectItem(Item: String);
406 procedure Clear();
407 function GetWidth(): Integer; override;
408 function GetHeight(): Integer; override;
409 function SelectedItem(): String;
411 property OnChange: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent;
412 property Sort: Boolean read FSort write FSort;
413 property ItemIndex: Integer read FIndex write FSetIndex;
414 property Items: SSArray read FItems write FSetItems;
415 property DrawBack: Boolean read FDrawBack write FDrawBack;
416 property DrawScrollBar: Boolean read FDrawScroll write FDrawScroll;
417 property ActiveColor: TRGB read FActiveColor write FActiveColor;
418 property UnActiveColor: TRGB read FUnActiveColor write FUnActiveColor;
419 property Font: TFont read FFont write FFont;
420 end;
422 TGUIFileListBox = class(TGUIListBox)
423 private
424 FSubPath: String;
425 FFileMask: String;
426 FDirs: Boolean;
427 FBaseList: SSArray; // highter index have highter priority
429 procedure ScanDirs;
431 public
432 procedure OnMessage (var Msg: TMessage); override;
433 procedure SetBase (dirs: SSArray; path: String = '');
434 function SelectedItem(): String;
435 procedure UpdateFileList;
437 property Dirs: Boolean read FDirs write FDirs;
438 property FileMask: String read FFileMask write FFileMask;
439 end;
441 TGUIMemo = class(TGUIControl)
442 private
443 FLines: SSArray;
444 FFont: TFont;
445 FStartLine: Integer;
446 FWidth: Word;
447 FHeight: Word;
448 FColor: TRGB;
449 FDrawBack: Boolean;
450 FDrawScroll: Boolean;
451 public
452 constructor Create(FontID: DWORD; Width, Height: Word);
453 procedure OnMessage(var Msg: TMessage); override;
454 procedure Draw; override;
455 procedure Clear;
456 function GetWidth(): Integer; override;
457 function GetHeight(): Integer; override;
458 procedure SetText(Text: string);
459 property DrawBack: Boolean read FDrawBack write FDrawBack;
460 property DrawScrollBar: Boolean read FDrawScroll write FDrawScroll;
461 property Color: TRGB read FColor write FColor;
462 property Font: TFont read FFont write FFont;
463 end;
465 TGUIMainMenu = class(TGUIControl)
466 private
467 FButtons: array of TGUITextButton;
468 FHeader: TGUILabel;
469 FLogo: DWord;
470 FIndex: Integer;
471 FFontID: DWORD;
472 FCounter: Byte;
473 FMarkerID1: DWORD;
474 FMarkerID2: DWORD;
475 public
476 constructor Create(FontID: DWORD; Logo, Header: string);
477 destructor Destroy; override;
478 procedure OnMessage(var Msg: TMessage); override;
479 function AddButton(fProc: Pointer; Caption: string; ShowWindow: string = ''): TGUITextButton;
480 function GetButton(aName: string): TGUITextButton;
481 procedure EnableButton(aName: string; e: Boolean);
482 procedure AddSpace();
483 procedure Update; override;
484 procedure Draw; override;
485 end;
487 TControlType = class of TGUIControl;
489 PMenuItem = ^TMenuItem;
490 TMenuItem = record
491 Text: TGUILabel;
492 ControlType: TControlType;
493 Control: TGUIControl;
494 end;
496 TGUIMenu = class(TGUIControl)
497 private
498 FItems: array of TMenuItem;
499 FHeader: TGUILabel;
500 FIndex: Integer;
501 FFontID: DWORD;
502 FCounter: Byte;
503 FAlign: Boolean;
504 FLeft: Integer;
505 FYesNo: Boolean;
506 function NewItem(): Integer;
507 public
508 constructor Create(HeaderFont, ItemsFont: DWORD; Header: string);
509 destructor Destroy; override;
510 procedure OnMessage(var Msg: TMessage); override;
511 procedure AddSpace();
512 procedure AddLine(fText: string);
513 procedure AddText(fText: string; MaxWidth: Word);
514 function AddLabel(fText: string): TGUILabel;
515 function AddButton(Proc: Pointer; fText: string; _ShowWindow: string = ''): TGUITextButton;
516 function AddScroll(fText: string): TGUIScroll;
517 function AddSwitch(fText: string): TGUISwitch;
518 function AddEdit(fText: string): TGUIEdit;
519 function AddKeyRead(fText: string): TGUIKeyRead;
520 function AddKeyRead2(fText: string): TGUIKeyRead2;
521 function AddList(fText: string; Width, Height: Word): TGUIListBox;
522 function AddFileList(fText: string; Width, Height: Word): TGUIFileListBox;
523 function AddMemo(fText: string; Width, Height: Word): TGUIMemo;
524 procedure ReAlign();
525 function GetControl(aName: string): TGUIControl;
526 function GetControlsText(aName: string): TGUILabel;
527 procedure Draw; override;
528 procedure Update; override;
529 procedure UpdateIndex();
530 property Align: Boolean read FAlign write FAlign;
531 property Left: Integer read FLeft write FLeft;
532 property YesNo: Boolean read FYesNo write FYesNo;
533 end;
535 var
536 g_GUIWindows: array of TGUIWindow;
537 g_ActiveWindow: TGUIWindow = nil;
538 g_GUIGrabInput: Boolean = False;
540 procedure g_GUI_Init();
541 function g_GUI_AddWindow(Window: TGUIWindow): TGUIWindow;
542 function g_GUI_GetWindow(Name: string): TGUIWindow;
543 procedure g_GUI_ShowWindow(Name: string);
544 procedure g_GUI_HideWindow(PlaySound: Boolean = True);
545 function g_GUI_Destroy(): Boolean;
546 procedure g_GUI_SaveMenuPos();
547 procedure g_GUI_LoadMenuPos();
550 implementation
552 uses
553 g_sound, SysUtils, e_res, r_textures,
554 g_game, Math, StrUtils, g_player, g_options, r_playermodel,
555 g_map, g_weapons, xdynrec, wadreader;
558 var
559 Box: Array [0..8] of DWORD;
560 Saved_Windows: SSArray;
562 function GetLines (Text: string; FontID: DWORD; MaxWidth: Word): SSArray;
563 var i, j, len, lines: Integer;
565 function GetLine (j, i: Integer): String;
566 begin
567 result := Copy(text, j, i - j + 1);
568 end;
570 function GetWidth (j, i: Integer): Integer;
571 var w, h: Word;
572 begin
573 e_CharFont_GetSize(FontID, GetLine(j, i), w, h);
574 result := w
575 end;
577 begin
578 result := nil; lines := 0;
579 j := 1; i := 1; len := Length(Text);
580 // e_LogWritefln('GetLines @%s len=%s [%s]', [MaxWidth, len, Text]);
581 while j <= len do
582 begin
583 (* --- Get longest possible sequence --- *)
584 while (i + 1 <= len) and (GetWidth(j, i + 1) <= MaxWidth) do Inc(i);
585 (* --- Do not include part of word --- *)
586 if (i < len) and (text[i] <> ' ') then
587 while (i >= j) and (text[i] <> ' ') do Dec(i);
588 (* --- Do not include spaces --- *)
589 while (i >= j) and (text[i] = ' ') do Dec(i);
590 (* --- Add line --- *)
591 SetLength(result, lines + 1);
592 result[lines] := GetLine(j, i);
593 // e_LogWritefln(' -> (%s:%s::%s) [%s]', [j, i, GetWidth(j, i), result[lines]]);
594 Inc(lines);
595 (* --- Skip spaces --- *)
596 while (i <= len) and (text[i] = ' ') do Inc(i);
597 j := i + 2;
598 end;
599 end;
601 procedure Sort (var a: SSArray);
602 var i, j: Integer; s: string;
603 begin
604 if a = nil then Exit;
606 for i := High(a) downto Low(a) do
607 for j := Low(a) to High(a) - 1 do
608 if LowerCase(a[j]) > LowerCase(a[j + 1]) then
609 begin
610 s := a[j];
611 a[j] := a[j + 1];
612 a[j + 1] := s;
613 end;
614 end;
616 procedure g_GUI_Init();
617 begin
618 g_Texture_Get(BOX1, Box[0]);
619 g_Texture_Get(BOX2, Box[1]);
620 g_Texture_Get(BOX3, Box[2]);
621 g_Texture_Get(BOX4, Box[3]);
622 g_Texture_Get(BOX5, Box[4]);
623 g_Texture_Get(BOX6, Box[5]);
624 g_Texture_Get(BOX7, Box[6]);
625 g_Texture_Get(BOX8, Box[7]);
626 g_Texture_Get(BOX9, Box[8]);
627 end;
629 function g_GUI_Destroy(): Boolean;
630 var
631 i: Integer;
632 begin
633 Result := (Length(g_GUIWindows) > 0);
635 for i := 0 to High(g_GUIWindows) do
636 g_GUIWindows[i].Free();
638 g_GUIWindows := nil;
639 g_ActiveWindow := nil;
640 end;
642 function g_GUI_AddWindow(Window: TGUIWindow): TGUIWindow;
643 begin
644 SetLength(g_GUIWindows, Length(g_GUIWindows)+1);
645 g_GUIWindows[High(g_GUIWindows)] := Window;
647 Result := Window;
648 end;
650 function g_GUI_GetWindow(Name: string): TGUIWindow;
651 var
652 i: Integer;
653 begin
654 Result := nil;
656 if g_GUIWindows <> nil then
657 for i := 0 to High(g_GUIWindows) do
658 if g_GUIWindows[i].FName = Name then
659 begin
660 Result := g_GUIWindows[i];
661 Break;
662 end;
664 Assert(Result <> nil, 'GUI_Window "'+Name+'" not found');
665 end;
667 procedure g_GUI_ShowWindow(Name: string);
668 var
669 i: Integer;
670 begin
671 if g_GUIWindows = nil then
672 Exit;
674 for i := 0 to High(g_GUIWindows) do
675 if g_GUIWindows[i].FName = Name then
676 begin
677 g_GUIWindows[i].FPrevWindow := g_ActiveWindow;
678 g_ActiveWindow := g_GUIWindows[i];
680 if g_ActiveWindow.MainWindow then
681 g_ActiveWindow.FPrevWindow := nil;
683 if g_ActiveWindow.FDefControl <> '' then
684 g_ActiveWindow.SetActive(g_ActiveWindow.GetControl(g_ActiveWindow.FDefControl))
685 else
686 g_ActiveWindow.SetActive(nil);
688 if @g_ActiveWindow.FOnShowEvent <> nil then
689 g_ActiveWindow.FOnShowEvent();
691 Break;
692 end;
693 end;
695 procedure g_GUI_HideWindow(PlaySound: Boolean = True);
696 begin
697 if g_ActiveWindow <> nil then
698 begin
699 if @g_ActiveWindow.OnClose <> nil then
700 g_ActiveWindow.OnClose();
701 g_ActiveWindow := g_ActiveWindow.FPrevWindow;
702 if PlaySound then
703 g_Sound_PlayEx(WINDOW_CLOSESOUND);
704 end;
705 end;
707 procedure g_GUI_SaveMenuPos();
708 var
709 len: Integer;
710 win: TGUIWindow;
711 begin
712 SetLength(Saved_Windows, 0);
713 win := g_ActiveWindow;
715 while win <> nil do
716 begin
717 len := Length(Saved_Windows);
718 SetLength(Saved_Windows, len + 1);
720 Saved_Windows[len] := win.Name;
722 if win.MainWindow then
723 win := nil
724 else
725 win := win.FPrevWindow;
726 end;
727 end;
729 procedure g_GUI_LoadMenuPos();
730 var
731 i, j, k, len: Integer;
732 ok: Boolean;
733 begin
734 g_ActiveWindow := nil;
735 len := Length(Saved_Windows);
737 if len = 0 then
738 Exit;
740 // Îêíî ñ ãëàâíûì ìåíþ:
741 g_GUI_ShowWindow(Saved_Windows[len-1]);
743 // Íå ïåðåêëþ÷èëîñü (èëè íåêóäà äàëüøå):
744 if (len = 1) or (g_ActiveWindow = nil) then
745 Exit;
747 // Èùåì êíîïêè â îñòàëüíûõ îêíàõ:
748 for k := len-1 downto 1 do
749 begin
750 ok := False;
752 for i := 0 to Length(g_ActiveWindow.Childs)-1 do
753 begin
754 if g_ActiveWindow.Childs[i] is TGUIMainMenu then
755 begin // GUI_MainMenu
756 with TGUIMainMenu(g_ActiveWindow.Childs[i]) do
757 for j := 0 to Length(FButtons)-1 do
758 if FButtons[j].ShowWindow = Saved_Windows[k-1] then
759 begin
760 FButtons[j].Click(True);
761 ok := True;
762 Break;
763 end;
764 end
765 else // GUI_Menu
766 if g_ActiveWindow.Childs[i] is TGUIMenu then
767 with TGUIMenu(g_ActiveWindow.Childs[i]) do
768 for j := 0 to Length(FItems)-1 do
769 if FItems[j].ControlType = TGUITextButton then
770 if TGUITextButton(FItems[j].Control).ShowWindow = Saved_Windows[k-1] then
771 begin
772 TGUITextButton(FItems[j].Control).Click(True);
773 ok := True;
774 Break;
775 end;
777 if ok then
778 Break;
779 end;
781 // Íå ïåðåêëþ÷èëîñü:
782 if (not ok) or
783 (g_ActiveWindow.Name = Saved_Windows[k]) then
784 Break;
785 end;
786 end;
788 procedure DrawBox(X, Y: Integer; Width, Height: Word);
789 begin
790 e_Draw(Box[0], X, Y, 0, False, False);
791 e_DrawFill(Box[1], X+4, Y, Width*4, 1, 0, False, False);
792 e_Draw(Box[2], X+4+Width*16, Y, 0, False, False);
793 e_DrawFill(Box[3], X, Y+4, 1, Height*4, 0, False, False);
794 e_DrawFill(Box[4], X+4, Y+4, Width, Height, 0, False, False);
795 e_DrawFill(Box[5], X+4+Width*16, Y+4, 1, Height*4, 0, False, False);
796 e_Draw(Box[6], X, Y+4+Height*16, 0, False, False);
797 e_DrawFill(Box[7], X+4, Y+4+Height*16, Width*4, 1, 0, False, False);
798 e_Draw(Box[8], X+4+Width*16, Y+4+Height*16, 0, False, False);
799 end;
801 procedure DrawScroll(X, Y: Integer; Height: Word; Up, Down: Boolean);
802 var
803 ID: DWORD;
804 begin
805 if Height < 3 then Exit;
807 if Up then
808 g_Texture_Get(BSCROLL_UPA, ID)
809 else
810 g_Texture_Get(BSCROLL_UPU, ID);
811 e_Draw(ID, X, Y, 0, False, False);
813 if Down then
814 g_Texture_Get(BSCROLL_DOWNA, ID)
815 else
816 g_Texture_Get(BSCROLL_DOWNU, ID);
817 e_Draw(ID, X, Y+(Height-1)*16, 0, False, False);
819 g_Texture_Get(BSCROLL_MIDDLE, ID);
820 e_DrawFill(ID, X, Y+16, 1, Height-2, 0, False, False);
821 end;
823 { TGUIWindow }
825 constructor TGUIWindow.Create(Name: string);
826 begin
827 Childs := nil;
828 FActiveControl := nil;
829 FName := Name;
830 FOnKeyDown := nil;
831 FOnKeyDownEx := nil;
832 FOnCloseEvent := nil;
833 FOnShowEvent := nil;
834 end;
836 destructor TGUIWindow.Destroy;
837 var
838 i: Integer;
839 begin
840 if Childs = nil then
841 Exit;
843 for i := 0 to High(Childs) do
844 Childs[i].Free();
845 end;
847 function TGUIWindow.AddChild(Child: TGUIControl): TGUIControl;
848 begin
849 Child.FWindow := Self;
851 SetLength(Childs, Length(Childs) + 1);
852 Childs[High(Childs)] := Child;
854 Result := Child;
855 end;
857 procedure TGUIWindow.Update;
858 var
859 i: Integer;
860 begin
861 for i := 0 to High(Childs) do
862 if Childs[i] <> nil then Childs[i].Update;
863 end;
865 procedure TGUIWindow.Draw;
866 var
867 i: Integer;
868 ID: DWORD;
869 tw, th: Word;
870 begin
871 if FBackTexture <> '' then // Here goes code duplication from g_game.pas:DrawMenuBackground()
872 if g_Texture_Get(FBackTexture, ID) then
873 begin
874 e_Clear(0, 0, 0);
875 e_GetTextureSize(ID, @tw, @th);
876 if tw = th then
877 tw := round(tw * 1.333 * (gScreenHeight / th))
878 else
879 tw := trunc(tw * (gScreenHeight / th));
880 e_DrawSize(ID, (gScreenWidth - tw) div 2, 0, 0, False, False, tw, gScreenHeight);
881 end
882 else
883 e_Clear(0.5, 0.5, 0.5);
885 // small hack here
886 if FName = 'AuthorsMenu' then
887 e_DarkenQuadWH(0, 0, gScreenWidth, gScreenHeight, 150);
889 for i := 0 to High(Childs) do
890 if Childs[i] <> nil then Childs[i].Draw;
891 end;
893 procedure TGUIWindow.OnMessage(var Msg: TMessage);
894 begin
895 if FActiveControl <> nil then FActiveControl.OnMessage(Msg);
896 if @FOnKeyDown <> nil then FOnKeyDown(Msg.wParam);
897 if @FOnKeyDownEx <> nil then FOnKeyDownEx(self, Msg.wParam);
899 if Msg.Msg = WM_KEYDOWN then
900 begin
901 case Msg.wParam of
902 VK_ESCAPE:
903 begin
904 g_GUI_HideWindow;
905 Exit
906 end
907 end
908 end
909 end;
911 procedure TGUIWindow.SetActive(Control: TGUIControl);
912 begin
913 FActiveControl := Control;
914 end;
916 function TGUIWindow.GetControl(Name: String): TGUIControl;
917 var
918 i: Integer;
919 begin
920 Result := nil;
922 if Childs <> nil then
923 for i := 0 to High(Childs) do
924 if Childs[i] <> nil then
925 if LowerCase(Childs[i].FName) = LowerCase(Name) then
926 begin
927 Result := Childs[i];
928 Break;
929 end;
931 Assert(Result <> nil, 'Window Control "'+Name+'" not Found!');
932 end;
934 { TGUIControl }
936 constructor TGUIControl.Create();
937 begin
938 FX := 0;
939 FY := 0;
941 FEnabled := True;
942 FRightAlign := false;
943 FMaxWidth := -1;
944 end;
946 procedure TGUIControl.OnMessage(var Msg: TMessage);
947 begin
948 if not FEnabled then
949 Exit;
950 end;
952 procedure TGUIControl.Update();
953 begin
954 end;
956 procedure TGUIControl.Draw();
957 begin
958 end;
960 function TGUIControl.WantActivationKey (key: LongInt): Boolean;
961 begin
962 result := false;
963 end;
965 function TGUIControl.GetWidth(): Integer;
966 begin
967 result := 0;
968 end;
970 function TGUIControl.GetHeight(): Integer;
971 begin
972 result := 0;
973 end;
975 { TGUITextButton }
977 procedure TGUITextButton.Click(Silent: Boolean = False);
978 begin
979 if (FSound <> '') and (not Silent) then g_Sound_PlayEx(FSound);
981 if @Proc <> nil then Proc();
982 if @ProcEx <> nil then ProcEx(self);
984 if FShowWindow <> '' then g_GUI_ShowWindow(FShowWindow);
985 end;
987 constructor TGUITextButton.Create(aProc: Pointer; FontID: DWORD; Text: string);
988 begin
989 inherited Create();
991 Self.Proc := aProc;
992 ProcEx := nil;
994 FFont := TFont.Create(FontID, TFontType.Character);
996 FText := Text;
997 end;
999 destructor TGUITextButton.Destroy;
1000 begin
1002 inherited;
1003 end;
1005 procedure TGUITextButton.Draw;
1006 begin
1007 FFont.Draw(FX, FY, FText, FColor.R, FColor.G, FColor.B)
1008 end;
1010 function TGUITextButton.GetHeight: Integer;
1011 var
1012 w, h: Word;
1013 begin
1014 FFont.GetTextSize(FText, w, h);
1015 Result := h;
1016 end;
1018 function TGUITextButton.GetWidth: Integer;
1019 var
1020 w, h: Word;
1021 begin
1022 FFont.GetTextSize(FText, w, h);
1023 Result := w;
1024 end;
1026 procedure TGUITextButton.OnMessage(var Msg: TMessage);
1027 begin
1028 if not FEnabled then Exit;
1030 inherited;
1032 case Msg.Msg of
1033 WM_KEYDOWN:
1034 case Msg.wParam of
1035 IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK: Click();
1036 end;
1037 end;
1038 end;
1040 procedure TGUITextButton.Update;
1041 begin
1042 inherited;
1043 end;
1045 { TFont }
1047 constructor TFont.Create(FontID: DWORD; FontType: TFontType);
1048 begin
1049 ID := FontID;
1051 FScale := 1;
1052 FFontType := FontType;
1053 end;
1055 destructor TFont.Destroy;
1056 begin
1058 inherited;
1059 end;
1061 procedure TFont.Draw(X, Y: Integer; Text: string; R, G, B: Byte);
1062 begin
1063 if FFontType = TFontType.Character then e_CharFont_PrintEx(ID, X, Y, Text, _RGB(R, G, B), FScale)
1064 else e_TextureFontPrintEx(X, Y, Text, ID, R, G, B, FScale);
1065 end;
1067 procedure TFont.GetTextSize(Text: string; var w, h: Word);
1068 var
1069 cw, ch: Byte;
1070 begin
1071 if FFontType = TFontType.Character then e_CharFont_GetSize(ID, Text, w, h)
1072 else
1073 begin
1074 e_TextureFontGetSize(ID, cw, ch);
1075 w := cw*Length(Text);
1076 h := ch;
1077 end;
1079 w := Round(w*FScale);
1080 h := Round(h*FScale);
1081 end;
1083 { TGUIMainMenu }
1085 function TGUIMainMenu.AddButton(fProc: Pointer; Caption: string; ShowWindow: string = ''): TGUITextButton;
1086 var
1087 a, _x: Integer;
1088 h, hh: Word;
1089 lh: Word = 0;
1090 begin
1091 FIndex := 0;
1093 SetLength(FButtons, Length(FButtons)+1);
1094 FButtons[High(FButtons)] := TGUITextButton.Create(fProc, FFontID, Caption);
1095 FButtons[High(FButtons)].ShowWindow := ShowWindow;
1096 with FButtons[High(FButtons)] do
1097 begin
1098 if (fProc <> nil) or (ShowWindow <> '') then FColor := MAINMENU_ITEMS_COLOR
1099 else FColor := MAINMENU_UNACTIVEITEMS_COLOR;
1100 FSound := MAINMENU_CLICKSOUND;
1101 end;
1103 _x := gScreenWidth div 2;
1105 for a := 0 to High(FButtons) do
1106 if FButtons[a] <> nil then
1107 _x := Min(_x, (gScreenWidth div 2)-(FButtons[a].GetWidth div 2));
1109 if FLogo <> 0 then e_GetTextureSize(FLogo, nil, @lh);
1110 hh := FButtons[High(FButtons)].GetHeight;
1112 if FLogo <> 0 then h := lh + hh * (1 + Length(FButtons)) + MAINMENU_SPACE * (Length(FButtons) - 1)
1113 else h := hh * (2 + Length(FButtons)) + MAINMENU_SPACE * (Length(FButtons) - 1);
1114 h := (gScreenHeight div 2) - (h div 2);
1116 if FHeader <> nil then with FHeader do
1117 begin
1118 FX := _x;
1119 FY := h;
1120 end;
1122 if FLogo <> 0 then Inc(h, lh)
1123 else Inc(h, hh*2);
1125 for a := 0 to High(FButtons) do
1126 begin
1127 if FButtons[a] <> nil then
1128 with FButtons[a] do
1129 begin
1130 FX := _x;
1131 FY := h;
1132 end;
1134 Inc(h, hh+MAINMENU_SPACE);
1135 end;
1137 Result := FButtons[High(FButtons)];
1138 end;
1140 procedure TGUIMainMenu.AddSpace;
1141 begin
1142 SetLength(FButtons, Length(FButtons)+1);
1143 FButtons[High(FButtons)] := nil;
1144 end;
1146 constructor TGUIMainMenu.Create(FontID: DWORD; Logo, Header: string);
1147 begin
1148 inherited Create();
1150 FIndex := -1;
1151 FFontID := FontID;
1152 FCounter := MAINMENU_MARKERDELAY;
1154 g_Texture_Get(MAINMENU_MARKER1, FMarkerID1);
1155 g_Texture_Get(MAINMENU_MARKER2, FMarkerID2);
1157 if not g_Texture_Get(Logo, FLogo) then
1158 begin
1159 FHeader := TGUILabel.Create(Header, FFontID);
1160 with FHeader do
1161 begin
1162 FColor := MAINMENU_HEADER_COLOR;
1163 FX := (gScreenWidth div 2)-(GetWidth div 2);
1164 FY := (gScreenHeight div 2)-(GetHeight div 2);
1165 end;
1166 end;
1167 end;
1169 destructor TGUIMainMenu.Destroy;
1170 var
1171 a: Integer;
1172 begin
1173 if FButtons <> nil then
1174 for a := 0 to High(FButtons) do
1175 FButtons[a].Free();
1177 FHeader.Free();
1179 inherited;
1180 end;
1182 procedure TGUIMainMenu.Draw;
1183 var
1184 a: Integer;
1185 w, h: Word;
1187 begin
1188 inherited;
1190 if FHeader <> nil then FHeader.Draw
1191 else begin
1192 e_GetTextureSize(FLogo, @w, @h);
1193 e_Draw(FLogo, ((gScreenWidth div 2) - (w div 2)), FButtons[0].FY - FButtons[0].GetHeight - h, 0, True, False);
1194 end;
1196 if FButtons <> nil then
1197 begin
1198 for a := 0 to High(FButtons) do
1199 if FButtons[a] <> nil then FButtons[a].Draw;
1201 if FIndex <> -1 then
1202 e_Draw(FMarkerID1, FButtons[FIndex].FX-48, FButtons[FIndex].FY, 0, True, False);
1203 end;
1204 end;
1206 procedure TGUIMainMenu.EnableButton(aName: string; e: Boolean);
1207 var
1208 a: Integer;
1209 begin
1210 if FButtons = nil then Exit;
1212 for a := 0 to High(FButtons) do
1213 if (FButtons[a] <> nil) and (FButtons[a].Name = aName) then
1214 begin
1215 if e then FButtons[a].FColor := MAINMENU_ITEMS_COLOR
1216 else FButtons[a].FColor := MAINMENU_UNACTIVEITEMS_COLOR;
1217 FButtons[a].Enabled := e;
1218 Break;
1219 end;
1220 end;
1222 function TGUIMainMenu.GetButton(aName: string): TGUITextButton;
1223 var
1224 a: Integer;
1225 begin
1226 Result := nil;
1228 if FButtons = nil then Exit;
1230 for a := 0 to High(FButtons) do
1231 if (FButtons[a] <> nil) and (FButtons[a].Name = aName) then
1232 begin
1233 Result := FButtons[a];
1234 Break;
1235 end;
1236 end;
1238 procedure TGUIMainMenu.OnMessage(var Msg: TMessage);
1239 var
1240 ok: Boolean;
1241 a: Integer;
1242 begin
1243 if not FEnabled then Exit;
1245 inherited;
1247 if FButtons = nil then Exit;
1249 ok := False;
1250 for a := 0 to High(FButtons) do
1251 if FButtons[a] <> nil then
1252 begin
1253 ok := True;
1254 Break;
1255 end;
1257 if not ok then Exit;
1259 case Msg.Msg of
1260 WM_KEYDOWN:
1261 case Msg.wParam of
1262 IK_UP, IK_KPUP, VK_UP, JOY0_UP, JOY1_UP, JOY2_UP, JOY3_UP:
1263 begin
1264 repeat
1265 Dec(FIndex);
1266 if FIndex < 0 then FIndex := High(FButtons);
1267 until FButtons[FIndex] <> nil;
1269 g_Sound_PlayEx(MENU_CHANGESOUND);
1270 end;
1271 IK_DOWN, IK_KPDOWN, VK_DOWN, JOY0_DOWN, JOY1_DOWN, JOY2_DOWN, JOY3_DOWN:
1272 begin
1273 repeat
1274 Inc(FIndex);
1275 if FIndex > High(FButtons) then FIndex := 0;
1276 until FButtons[FIndex] <> nil;
1278 g_Sound_PlayEx(MENU_CHANGESOUND);
1279 end;
1280 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;
1281 end;
1282 end;
1283 end;
1285 procedure TGUIMainMenu.Update;
1286 var
1287 t: DWORD;
1288 begin
1289 inherited;
1291 if FCounter = 0 then
1292 begin
1293 t := FMarkerID1;
1294 FMarkerID1 := FMarkerID2;
1295 FMarkerID2 := t;
1297 FCounter := MAINMENU_MARKERDELAY;
1298 end else Dec(FCounter);
1299 end;
1301 { TGUILabel }
1303 constructor TGUILabel.Create(Text: string; FontID: DWORD);
1304 begin
1305 inherited Create();
1307 FFont := TFont.Create(FontID, TFontType.Character);
1309 FText := Text;
1310 FFixedLen := 0;
1311 FOnClickEvent := nil;
1312 end;
1314 procedure TGUILabel.Draw;
1315 var
1316 w, h: Word;
1317 begin
1318 if RightAlign then
1319 begin
1320 FFont.GetTextSize(FText, w, h);
1321 FFont.Draw(FX+FMaxWidth-w, FY, FText, FColor.R, FColor.G, FColor.B);
1322 end
1323 else
1324 begin
1325 FFont.Draw(FX, FY, FText, FColor.R, FColor.G, FColor.B);
1326 end;
1327 end;
1329 function TGUILabel.GetHeight: Integer;
1330 var
1331 w, h: Word;
1332 begin
1333 FFont.GetTextSize(FText, w, h);
1334 Result := h;
1335 end;
1337 function TGUILabel.GetWidth: Integer;
1338 var
1339 w, h: Word;
1340 begin
1341 if FFixedLen = 0 then
1342 FFont.GetTextSize(FText, w, h)
1343 else
1344 w := e_CharFont_GetMaxWidth(FFont.ID)*FFixedLen;
1345 Result := w;
1346 end;
1348 procedure TGUILabel.OnMessage(var Msg: TMessage);
1349 begin
1350 if not FEnabled then Exit;
1352 inherited;
1354 case Msg.Msg of
1355 WM_KEYDOWN:
1356 case Msg.wParam of
1357 IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK: if @FOnClickEvent <> nil then FOnClickEvent();
1358 end;
1359 end;
1360 end;
1362 { TGUIMenu }
1364 function TGUIMenu.AddButton(Proc: Pointer; fText: string; _ShowWindow: string = ''): TGUITextButton;
1365 var
1366 i: Integer;
1367 begin
1368 i := NewItem();
1369 with FItems[i] do
1370 begin
1371 Control := TGUITextButton.Create(Proc, FFontID, fText);
1372 with Control as TGUITextButton do
1373 begin
1374 ShowWindow := _ShowWindow;
1375 FColor := MENU_ITEMSCTRL_COLOR;
1376 end;
1378 Text := nil;
1379 ControlType := TGUITextButton;
1381 Result := (Control as TGUITextButton);
1382 end;
1384 if FIndex = -1 then FIndex := i;
1386 ReAlign();
1387 end;
1389 procedure TGUIMenu.AddLine(fText: string);
1390 var
1391 i: Integer;
1392 begin
1393 i := NewItem();
1394 with FItems[i] do
1395 begin
1396 Text := TGUILabel.Create(fText, FFontID);
1397 with Text do
1398 begin
1399 FColor := MENU_ITEMSTEXT_COLOR;
1400 end;
1402 Control := nil;
1403 end;
1405 ReAlign();
1406 end;
1408 procedure TGUIMenu.AddText(fText: string; MaxWidth: Word);
1409 var
1410 a, i: Integer;
1411 l: SSArray;
1412 begin
1413 l := GetLines(fText, FFontID, MaxWidth);
1415 if l = nil then Exit;
1417 for a := 0 to High(l) do
1418 begin
1419 i := NewItem();
1420 with FItems[i] do
1421 begin
1422 Text := TGUILabel.Create(l[a], FFontID);
1423 if FYesNo then
1424 begin
1425 with Text do begin FColor := _RGB(255, 0, 0); end;
1426 end
1427 else
1428 begin
1429 with Text do begin FColor := MENU_ITEMSTEXT_COLOR; end;
1430 end;
1432 Control := nil;
1433 end;
1434 end;
1436 ReAlign();
1437 end;
1439 procedure TGUIMenu.AddSpace;
1440 var
1441 i: Integer;
1442 begin
1443 i := NewItem();
1444 with FItems[i] do
1445 begin
1446 Text := nil;
1447 Control := nil;
1448 end;
1450 ReAlign();
1451 end;
1453 constructor TGUIMenu.Create(HeaderFont, ItemsFont: DWORD; Header: string);
1454 begin
1455 inherited Create();
1457 FItems := nil;
1458 FIndex := -1;
1459 FFontID := ItemsFont;
1460 FCounter := MENU_MARKERDELAY;
1461 FAlign := True;
1462 FYesNo := false;
1464 FHeader := TGUILabel.Create(Header, HeaderFont);
1465 with FHeader do
1466 begin
1467 FX := (gScreenWidth div 2)-(GetWidth div 2);
1468 FY := 0;
1469 FColor := MAINMENU_HEADER_COLOR;
1470 end;
1471 end;
1473 destructor TGUIMenu.Destroy;
1474 var
1475 a: Integer;
1476 begin
1477 if FItems <> nil then
1478 for a := 0 to High(FItems) do
1479 with FItems[a] do
1480 begin
1481 Text.Free();
1482 Control.Free();
1483 end;
1485 FItems := nil;
1487 FHeader.Free();
1489 inherited;
1490 end;
1492 procedure TGUIMenu.Draw;
1493 var
1494 a, locx, locy: Integer;
1495 begin
1496 inherited;
1498 if FHeader <> nil then FHeader.Draw;
1500 if FItems <> nil then
1501 for a := 0 to High(FItems) do
1502 begin
1503 if FItems[a].Text <> nil then FItems[a].Text.Draw;
1504 if FItems[a].Control <> nil then FItems[a].Control.Draw;
1505 end;
1507 if (FIndex <> -1) and (FCounter > MENU_MARKERDELAY div 2) then
1508 begin
1509 locx := 0;
1510 locy := 0;
1512 if FItems[FIndex].Text <> nil then
1513 begin
1514 locx := FItems[FIndex].Text.FX;
1515 locy := FItems[FIndex].Text.FY;
1516 //HACK!
1517 if FItems[FIndex].Text.RightAlign then
1518 begin
1519 locx := locx+FItems[FIndex].Text.FMaxWidth-FItems[FIndex].Text.GetWidth;
1520 end;
1521 end
1522 else if FItems[FIndex].Control <> nil then
1523 begin
1524 locx := FItems[FIndex].Control.FX;
1525 locy := FItems[FIndex].Control.FY;
1526 end;
1528 locx := locx-e_CharFont_GetMaxWidth(FFontID);
1530 e_CharFont_PrintEx(FFontID, locx, locy, #16, _RGB(255, 0, 0));
1531 end;
1532 end;
1534 function TGUIMenu.GetControl(aName: String): TGUIControl;
1535 var
1536 a: Integer;
1537 begin
1538 Result := nil;
1540 if FItems <> nil then
1541 for a := 0 to High(FItems) do
1542 if FItems[a].Control <> nil then
1543 if LowerCase(FItems[a].Control.Name) = LowerCase(aName) then
1544 begin
1545 Result := FItems[a].Control;
1546 Break;
1547 end;
1549 Assert(Result <> nil, 'GUI control "'+aName+'" not found!');
1550 end;
1552 function TGUIMenu.GetControlsText(aName: String): TGUILabel;
1553 var
1554 a: Integer;
1555 begin
1556 Result := nil;
1558 if FItems <> nil then
1559 for a := 0 to High(FItems) do
1560 if FItems[a].Control <> nil then
1561 if LowerCase(FItems[a].Control.Name) = LowerCase(aName) then
1562 begin
1563 Result := FItems[a].Text;
1564 Break;
1565 end;
1567 Assert(Result <> nil, 'GUI control''s text "'+aName+'" not found!');
1568 end;
1570 function TGUIMenu.NewItem: Integer;
1571 begin
1572 SetLength(FItems, Length(FItems)+1);
1573 Result := High(FItems);
1574 end;
1576 procedure TGUIMenu.OnMessage(var Msg: TMessage);
1577 var
1578 ok: Boolean;
1579 a, c: Integer;
1580 begin
1581 if not FEnabled then Exit;
1583 inherited;
1585 if FItems = nil then Exit;
1587 ok := False;
1588 for a := 0 to High(FItems) do
1589 if FItems[a].Control <> nil then
1590 begin
1591 ok := True;
1592 Break;
1593 end;
1595 if not ok then Exit;
1597 if (Msg.Msg = WM_KEYDOWN) and (FIndex <> -1) and (FItems[FIndex].Control <> nil) and
1598 (FItems[FIndex].Control.WantActivationKey(Msg.wParam)) then
1599 begin
1600 FItems[FIndex].Control.OnMessage(Msg);
1601 g_Sound_PlayEx(MENU_CLICKSOUND);
1602 exit;
1603 end;
1605 case Msg.Msg of
1606 WM_KEYDOWN:
1607 begin
1608 case Msg.wParam of
1609 IK_UP, IK_KPUP, VK_UP,JOY0_UP, JOY1_UP, JOY2_UP, JOY3_UP:
1610 begin
1611 c := 0;
1612 repeat
1613 c := c+1;
1614 if c > Length(FItems) then
1615 begin
1616 FIndex := -1;
1617 Break;
1618 end;
1620 Dec(FIndex);
1621 if FIndex < 0 then FIndex := High(FItems);
1622 until (FItems[FIndex].Control <> nil) and
1623 (FItems[FIndex].Control.Enabled);
1625 FCounter := 0;
1627 g_Sound_PlayEx(MENU_CHANGESOUND);
1628 end;
1630 IK_DOWN, IK_KPDOWN, VK_DOWN, JOY0_DOWN, JOY1_DOWN, JOY2_DOWN, JOY3_DOWN:
1631 begin
1632 c := 0;
1633 repeat
1634 c := c+1;
1635 if c > Length(FItems) then
1636 begin
1637 FIndex := -1;
1638 Break;
1639 end;
1641 Inc(FIndex);
1642 if FIndex > High(FItems) then FIndex := 0;
1643 until (FItems[FIndex].Control <> nil) and
1644 (FItems[FIndex].Control.Enabled);
1646 FCounter := 0;
1648 g_Sound_PlayEx(MENU_CHANGESOUND);
1649 end;
1651 IK_LEFT, IK_RIGHT, IK_KPLEFT, IK_KPRIGHT, VK_LEFT, VK_RIGHT,
1652 JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT,
1653 JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT:
1654 begin
1655 if FIndex <> -1 then
1656 if FItems[FIndex].Control <> nil then
1657 FItems[FIndex].Control.OnMessage(Msg);
1658 end;
1659 IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK:
1660 begin
1661 if FIndex <> -1 then
1662 begin
1663 if FItems[FIndex].Control <> nil then FItems[FIndex].Control.OnMessage(Msg);
1664 end;
1665 g_Sound_PlayEx(MENU_CLICKSOUND);
1666 end;
1667 // dirty hacks
1668 IK_Y:
1669 if FYesNo and (length(FItems) > 1) then
1670 begin
1671 Msg.wParam := IK_RETURN; // to register keypress
1672 FIndex := High(FItems)-1;
1673 if FItems[FIndex].Control <> nil then FItems[FIndex].Control.OnMessage(Msg);
1674 end;
1675 IK_N:
1676 if FYesNo and (length(FItems) > 1) then
1677 begin
1678 Msg.wParam := IK_RETURN; // to register keypress
1679 FIndex := High(FItems);
1680 if FItems[FIndex].Control <> nil then FItems[FIndex].Control.OnMessage(Msg);
1681 end;
1682 end;
1683 end;
1684 end;
1685 end;
1687 procedure TGUIMenu.ReAlign();
1688 var
1689 a, tx, cx, w, h: Integer;
1690 cww: array of Integer; // cached widths
1691 maxcww: Integer;
1692 begin
1693 if FItems = nil then Exit;
1695 SetLength(cww, length(FItems));
1696 maxcww := 0;
1697 for a := 0 to High(FItems) do
1698 begin
1699 if FItems[a].Text <> nil then
1700 begin
1701 cww[a] := FItems[a].Text.GetWidth;
1702 if maxcww < cww[a] then maxcww := cww[a];
1703 end;
1704 end;
1706 if not FAlign then
1707 begin
1708 tx := FLeft;
1709 end
1710 else
1711 begin
1712 tx := gScreenWidth;
1713 for a := 0 to High(FItems) do
1714 begin
1715 w := 0;
1716 if FItems[a].Text <> nil then w := FItems[a].Text.GetWidth;
1717 if FItems[a].Control <> nil then
1718 begin
1719 w := w+MENU_HSPACE;
1720 if FItems[a].ControlType = TGUILabel then w := w+(FItems[a].Control as TGUILabel).GetWidth
1721 else if FItems[a].ControlType = TGUITextButton then w := w+(FItems[a].Control as TGUITextButton).GetWidth
1722 else if FItems[a].ControlType = TGUIScroll then w := w+(FItems[a].Control as TGUIScroll).GetWidth
1723 else if FItems[a].ControlType = TGUISwitch then w := w+(FItems[a].Control as TGUISwitch).GetWidth
1724 else if FItems[a].ControlType = TGUIEdit then w := w+(FItems[a].Control as TGUIEdit).GetWidth
1725 else if FItems[a].ControlType = TGUIKeyRead then w := w+(FItems[a].Control as TGUIKeyRead).GetWidth
1726 else if FItems[a].ControlType = TGUIKeyRead2 then w := w+(FItems[a].Control as TGUIKeyRead2).GetWidth
1727 else if FItems[a].ControlType = TGUIListBox then w := w+(FItems[a].Control as TGUIListBox).GetWidth
1728 else if FItems[a].ControlType = TGUIFileListBox then w := w+(FItems[a].Control as TGUIFileListBox).GetWidth
1729 else if FItems[a].ControlType = TGUIMemo then w := w+(FItems[a].Control as TGUIMemo).GetWidth;
1730 end;
1731 tx := Min(tx, (gScreenWidth div 2)-(w div 2));
1732 end;
1733 end;
1735 cx := 0;
1736 for a := 0 to High(FItems) do
1737 begin
1738 with FItems[a] do
1739 begin
1740 if (Text <> nil) and (Control = nil) then Continue;
1741 w := 0;
1742 if Text <> nil then w := tx+Text.GetWidth;
1743 if w > cx then cx := w;
1744 end;
1745 end;
1747 cx := cx+MENU_HSPACE;
1749 h := FHeader.GetHeight*2+MENU_VSPACE*(Length(FItems)-1);
1751 for a := 0 to High(FItems) do
1752 begin
1753 with FItems[a] do
1754 begin
1755 if (ControlType = TGUIListBox) or (ControlType = TGUIFileListBox) then
1756 h := h+(FItems[a].Control as TGUIListBox).GetHeight()
1757 else
1758 h := h+e_CharFont_GetMaxHeight(FFontID);
1759 end;
1760 end;
1762 h := (gScreenHeight div 2)-(h div 2);
1764 with FHeader do
1765 begin
1766 FX := (gScreenWidth div 2)-(GetWidth div 2);
1767 FY := h;
1769 Inc(h, GetHeight*2);
1770 end;
1772 for a := 0 to High(FItems) do
1773 begin
1774 with FItems[a] do
1775 begin
1776 if Text <> nil then
1777 begin
1778 with Text do
1779 begin
1780 FX := tx;
1781 FY := h;
1782 end;
1783 //HACK!
1784 if Text.RightAlign and (length(cww) > a) then
1785 begin
1786 //Text.FX := Text.FX+maxcww;
1787 Text.FMaxWidth := maxcww;
1788 end;
1789 end;
1791 if Control <> nil then
1792 begin
1793 with Control do
1794 begin
1795 if Text <> nil then
1796 begin
1797 FX := cx;
1798 FY := h;
1799 end
1800 else
1801 begin
1802 FX := tx;
1803 FY := h;
1804 end;
1805 end;
1806 end;
1808 if (ControlType = TGUIListBox) or (ControlType = TGUIFileListBox) then Inc(h, (Control as TGUIListBox).GetHeight+MENU_VSPACE)
1809 else if ControlType = TGUIMemo then Inc(h, (Control as TGUIMemo).GetHeight+MENU_VSPACE)
1810 else Inc(h, e_CharFont_GetMaxHeight(FFontID)+MENU_VSPACE);
1811 end;
1812 end;
1814 // another ugly hack
1815 if FYesNo and (length(FItems) > 1) then
1816 begin
1817 w := -1;
1818 for a := High(FItems)-1 to High(FItems) do
1819 begin
1820 if (FItems[a].Control <> nil) and (FItems[a].ControlType = TGUITextButton) then
1821 begin
1822 cx := (FItems[a].Control as TGUITextButton).GetWidth;
1823 if cx > w then w := cx;
1824 end;
1825 end;
1826 if w > 0 then
1827 begin
1828 for a := High(FItems)-1 to High(FItems) do
1829 begin
1830 if (FItems[a].Control <> nil) and (FItems[a].ControlType = TGUITextButton) then
1831 begin
1832 FItems[a].Control.FX := (gScreenWidth-w) div 2;
1833 end;
1834 end;
1835 end;
1836 end;
1837 end;
1839 function TGUIMenu.AddScroll(fText: string): TGUIScroll;
1840 var
1841 i: Integer;
1842 begin
1843 i := NewItem();
1844 with FItems[i] do
1845 begin
1846 Control := TGUIScroll.Create();
1848 Text := TGUILabel.Create(fText, FFontID);
1849 with Text do
1850 begin
1851 FColor := MENU_ITEMSTEXT_COLOR;
1852 end;
1854 ControlType := TGUIScroll;
1856 Result := (Control as TGUIScroll);
1857 end;
1859 if FIndex = -1 then FIndex := i;
1861 ReAlign();
1862 end;
1864 function TGUIMenu.AddSwitch(fText: string): TGUISwitch;
1865 var
1866 i: Integer;
1867 begin
1868 i := NewItem();
1869 with FItems[i] do
1870 begin
1871 Control := TGUISwitch.Create(FFontID);
1872 (Control as TGUISwitch).FColor := MENU_ITEMSCTRL_COLOR;
1874 Text := TGUILabel.Create(fText, FFontID);
1875 with Text do
1876 begin
1877 FColor := MENU_ITEMSTEXT_COLOR;
1878 end;
1880 ControlType := TGUISwitch;
1882 Result := (Control as TGUISwitch);
1883 end;
1885 if FIndex = -1 then FIndex := i;
1887 ReAlign();
1888 end;
1890 function TGUIMenu.AddEdit(fText: string): TGUIEdit;
1891 var
1892 i: Integer;
1893 begin
1894 i := NewItem();
1895 with FItems[i] do
1896 begin
1897 Control := TGUIEdit.Create(FFontID);
1898 with Control as TGUIEdit do
1899 begin
1900 FWindow := Self.FWindow;
1901 FColor := MENU_ITEMSCTRL_COLOR;
1902 end;
1904 if fText = '' then Text := nil else
1905 begin
1906 Text := TGUILabel.Create(fText, FFontID);
1907 Text.FColor := MENU_ITEMSTEXT_COLOR;
1908 end;
1910 ControlType := TGUIEdit;
1912 Result := (Control as TGUIEdit);
1913 end;
1915 if FIndex = -1 then FIndex := i;
1917 ReAlign();
1918 end;
1920 procedure TGUIMenu.Update;
1921 var
1922 a: Integer;
1923 begin
1924 inherited;
1926 if FCounter = 0 then FCounter := MENU_MARKERDELAY else Dec(FCounter);
1928 if FItems <> nil then
1929 for a := 0 to High(FItems) do
1930 if FItems[a].Control <> nil then
1931 (FItems[a].Control as FItems[a].ControlType).Update;
1932 end;
1934 function TGUIMenu.AddKeyRead(fText: string): TGUIKeyRead;
1935 var
1936 i: Integer;
1937 begin
1938 i := NewItem();
1939 with FItems[i] do
1940 begin
1941 Control := TGUIKeyRead.Create(FFontID);
1942 with Control as TGUIKeyRead do
1943 begin
1944 FWindow := Self.FWindow;
1945 FColor := MENU_ITEMSCTRL_COLOR;
1946 end;
1948 Text := TGUILabel.Create(fText, FFontID);
1949 with Text do
1950 begin
1951 FColor := MENU_ITEMSTEXT_COLOR;
1952 end;
1954 ControlType := TGUIKeyRead;
1956 Result := (Control as TGUIKeyRead);
1957 end;
1959 if FIndex = -1 then FIndex := i;
1961 ReAlign();
1962 end;
1964 function TGUIMenu.AddKeyRead2(fText: string): TGUIKeyRead2;
1965 var
1966 i: Integer;
1967 begin
1968 i := NewItem();
1969 with FItems[i] do
1970 begin
1971 Control := TGUIKeyRead2.Create(FFontID);
1972 with Control as TGUIKeyRead2 do
1973 begin
1974 FWindow := Self.FWindow;
1975 FColor := MENU_ITEMSCTRL_COLOR;
1976 end;
1978 Text := TGUILabel.Create(fText, FFontID);
1979 with Text do
1980 begin
1981 FColor := MENU_ITEMSCTRL_COLOR; //MENU_ITEMSTEXT_COLOR;
1982 RightAlign := true;
1983 end;
1985 ControlType := TGUIKeyRead2;
1987 Result := (Control as TGUIKeyRead2);
1988 end;
1990 if FIndex = -1 then FIndex := i;
1992 ReAlign();
1993 end;
1995 function TGUIMenu.AddList(fText: string; Width, Height: Word): TGUIListBox;
1996 var
1997 i: Integer;
1998 begin
1999 i := NewItem();
2000 with FItems[i] do
2001 begin
2002 Control := TGUIListBox.Create(FFontID, Width, Height);
2003 with Control as TGUIListBox do
2004 begin
2005 FWindow := Self.FWindow;
2006 FActiveColor := MENU_ITEMSCTRL_COLOR;
2007 FUnActiveColor := MENU_ITEMSTEXT_COLOR;
2008 end;
2010 Text := TGUILabel.Create(fText, FFontID);
2011 with Text do
2012 begin
2013 FColor := MENU_ITEMSTEXT_COLOR;
2014 end;
2016 ControlType := TGUIListBox;
2018 Result := (Control as TGUIListBox);
2019 end;
2021 if FIndex = -1 then FIndex := i;
2023 ReAlign();
2024 end;
2026 function TGUIMenu.AddFileList(fText: string; Width, Height: Word): TGUIFileListBox;
2027 var
2028 i: Integer;
2029 begin
2030 i := NewItem();
2031 with FItems[i] do
2032 begin
2033 Control := TGUIFileListBox.Create(FFontID, Width, Height);
2034 with Control as TGUIFileListBox do
2035 begin
2036 FWindow := Self.FWindow;
2037 FActiveColor := MENU_ITEMSCTRL_COLOR;
2038 FUnActiveColor := MENU_ITEMSTEXT_COLOR;
2039 end;
2041 if fText = '' then Text := nil else
2042 begin
2043 Text := TGUILabel.Create(fText, FFontID);
2044 Text.FColor := MENU_ITEMSTEXT_COLOR;
2045 end;
2047 ControlType := TGUIFileListBox;
2049 Result := (Control as TGUIFileListBox);
2050 end;
2052 if FIndex = -1 then FIndex := i;
2054 ReAlign();
2055 end;
2057 function TGUIMenu.AddLabel(fText: string): TGUILabel;
2058 var
2059 i: Integer;
2060 begin
2061 i := NewItem();
2062 with FItems[i] do
2063 begin
2064 Control := TGUILabel.Create('', FFontID);
2065 with Control as TGUILabel do
2066 begin
2067 FWindow := Self.FWindow;
2068 FColor := MENU_ITEMSCTRL_COLOR;
2069 end;
2071 Text := TGUILabel.Create(fText, FFontID);
2072 with Text do
2073 begin
2074 FColor := MENU_ITEMSTEXT_COLOR;
2075 end;
2077 ControlType := TGUILabel;
2079 Result := (Control as TGUILabel);
2080 end;
2082 if FIndex = -1 then FIndex := i;
2084 ReAlign();
2085 end;
2087 function TGUIMenu.AddMemo(fText: string; Width, Height: Word): TGUIMemo;
2088 var
2089 i: Integer;
2090 begin
2091 i := NewItem();
2092 with FItems[i] do
2093 begin
2094 Control := TGUIMemo.Create(FFontID, Width, Height);
2095 with Control as TGUIMemo do
2096 begin
2097 FWindow := Self.FWindow;
2098 FColor := MENU_ITEMSTEXT_COLOR;
2099 end;
2101 if fText = '' then Text := nil else
2102 begin
2103 Text := TGUILabel.Create(fText, FFontID);
2104 Text.FColor := MENU_ITEMSTEXT_COLOR;
2105 end;
2107 ControlType := TGUIMemo;
2109 Result := (Control as TGUIMemo);
2110 end;
2112 if FIndex = -1 then FIndex := i;
2114 ReAlign();
2115 end;
2117 procedure TGUIMenu.UpdateIndex();
2118 var
2119 res: Boolean;
2120 begin
2121 res := True;
2123 while res do
2124 begin
2125 if (FIndex < 0) or (FIndex > High(FItems)) then
2126 begin
2127 FIndex := -1;
2128 res := False;
2129 end
2130 else
2131 if FItems[FIndex].Control.Enabled then
2132 res := False
2133 else
2134 Inc(FIndex);
2135 end;
2136 end;
2138 { TGUIScroll }
2140 constructor TGUIScroll.Create;
2141 begin
2142 inherited Create();
2144 FMax := 0;
2145 FOnChangeEvent := nil;
2147 g_Texture_Get(SCROLL_LEFT, FLeftID);
2148 g_Texture_Get(SCROLL_RIGHT, FRightID);
2149 g_Texture_Get(SCROLL_MIDDLE, FMiddleID);
2150 g_Texture_Get(SCROLL_MARKER, FMarkerID);
2151 end;
2153 procedure TGUIScroll.Draw;
2154 var
2155 a: Integer;
2156 begin
2157 inherited;
2159 e_Draw(FLeftID, FX, FY, 0, True, False);
2160 e_Draw(FRightID, FX+8+(FMax+1)*8, FY, 0, True, False);
2162 for a := 0 to FMax do
2163 e_Draw(FMiddleID, FX+8+a*8, FY, 0, True, False);
2165 e_Draw(FMarkerID, FX+8+FValue*8, FY, 0, True, False);
2166 end;
2168 procedure TGUIScroll.FSetValue(a: Integer);
2169 begin
2170 if a > FMax then FValue := FMax else FValue := a;
2171 end;
2173 function TGUIScroll.GetWidth: Integer;
2174 begin
2175 Result := 16+(FMax+1)*8;
2176 end;
2178 procedure TGUIScroll.OnMessage(var Msg: TMessage);
2179 begin
2180 if not FEnabled then Exit;
2182 inherited;
2184 case Msg.Msg of
2185 WM_KEYDOWN:
2186 begin
2187 case Msg.wParam of
2188 IK_LEFT, IK_KPLEFT, VK_LEFT, JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT:
2189 if FValue > 0 then
2190 begin
2191 Dec(FValue);
2192 g_Sound_PlayEx(SCROLL_SUBSOUND);
2193 if @FOnChangeEvent <> nil then FOnChangeEvent(Self);
2194 end;
2195 IK_RIGHT, IK_KPRIGHT, VK_RIGHT, JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT:
2196 if FValue < FMax then
2197 begin
2198 Inc(FValue);
2199 g_Sound_PlayEx(SCROLL_ADDSOUND);
2200 if @FOnChangeEvent <> nil then FOnChangeEvent(Self);
2201 end;
2202 end;
2203 end;
2204 end;
2205 end;
2207 procedure TGUIScroll.Update;
2208 begin
2209 inherited;
2211 end;
2213 { TGUISwitch }
2215 procedure TGUISwitch.AddItem(Item: string);
2216 begin
2217 SetLength(FItems, Length(FItems)+1);
2218 FItems[High(FItems)] := Item;
2220 if FIndex = -1 then FIndex := 0;
2221 end;
2223 constructor TGUISwitch.Create(FontID: DWORD);
2224 begin
2225 inherited Create();
2227 FIndex := -1;
2229 FFont := TFont.Create(FontID, TFontType.Character);
2230 end;
2232 procedure TGUISwitch.Draw;
2233 begin
2234 inherited;
2236 FFont.Draw(FX, FY, FItems[FIndex], FColor.R, FColor.G, FColor.B);
2237 end;
2239 function TGUISwitch.GetText: string;
2240 begin
2241 if FIndex <> -1 then Result := FItems[FIndex]
2242 else Result := '';
2243 end;
2245 function TGUISwitch.GetWidth: Integer;
2246 var
2247 a: Integer;
2248 w, h: Word;
2249 begin
2250 Result := 0;
2252 if FItems = nil then Exit;
2254 for a := 0 to High(FItems) do
2255 begin
2256 FFont.GetTextSize(FItems[a], w, h);
2257 if w > Result then Result := w;
2258 end;
2259 end;
2261 procedure TGUISwitch.OnMessage(var Msg: TMessage);
2262 begin
2263 if not FEnabled then Exit;
2265 inherited;
2267 if FItems = nil then Exit;
2269 case Msg.Msg of
2270 WM_KEYDOWN:
2271 case Msg.wParam of
2272 IK_RETURN, IK_RIGHT, IK_KPRETURN, IK_KPRIGHT, VK_FIRE, VK_OPEN, VK_RIGHT,
2273 JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT,
2274 JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK:
2275 begin
2276 if FIndex < High(FItems) then
2277 Inc(FIndex)
2278 else
2279 FIndex := 0;
2281 g_Sound_PlayEx(SCROLL_ADDSOUND);
2283 if @FOnChangeEvent <> nil then
2284 FOnChangeEvent(Self);
2285 end;
2287 IK_LEFT, IK_KPLEFT, VK_LEFT,
2288 JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT:
2289 begin
2290 if FIndex > 0 then
2291 Dec(FIndex)
2292 else
2293 FIndex := High(FItems);
2295 g_Sound_PlayEx(SCROLL_SUBSOUND);
2297 if @FOnChangeEvent <> nil then
2298 FOnChangeEvent(Self);
2299 end;
2300 end;
2301 end;
2302 end;
2304 procedure TGUISwitch.Update;
2305 begin
2306 inherited;
2308 end;
2310 { TGUIEdit }
2312 constructor TGUIEdit.Create(FontID: DWORD);
2313 begin
2314 inherited Create();
2316 FFont := TFont.Create(FontID, TFontType.Character);
2318 FMaxLength := 0;
2319 FWidth := 0;
2320 FInvalid := false;
2322 g_Texture_Get(EDIT_LEFT, FLeftID);
2323 g_Texture_Get(EDIT_RIGHT, FRightID);
2324 g_Texture_Get(EDIT_MIDDLE, FMiddleID);
2325 end;
2327 procedure TGUIEdit.Draw;
2328 var
2329 c, w, h: Word;
2330 r, g, b: Byte;
2331 begin
2332 inherited;
2334 e_Draw(FLeftID, FX, FY, 0, True, False);
2335 e_Draw(FRightID, FX+8+FWidth*16, FY, 0, True, False);
2337 for c := 0 to FWidth-1 do
2338 e_Draw(FMiddleID, FX+8+c*16, FY, 0, True, False);
2340 r := FColor.R;
2341 g := FColor.G;
2342 b := FColor.B;
2343 if FInvalid and (FWindow.FActiveControl <> self) then begin r := 128; g := 128; b := 128; end;
2344 FFont.Draw(FX+8, FY, FText, r, g, b);
2346 if (FWindow.FActiveControl = self) then
2347 begin
2348 FFont.GetTextSize(Copy(FText, 1, FCaretPos), w, h);
2349 h := e_CharFont_GetMaxHeight(FFont.ID);
2350 e_DrawLine(2, FX+8+w, FY+h-3, FX+8+w+EDIT_CURSORLEN, FY+h-3,
2351 EDIT_CURSORCOLOR.R, EDIT_CURSORCOLOR.G, EDIT_CURSORCOLOR.B);
2352 end;
2353 end;
2355 function TGUIEdit.GetWidth: Integer;
2356 begin
2357 Result := 16+FWidth*16;
2358 end;
2360 procedure TGUIEdit.OnMessage(var Msg: TMessage);
2361 begin
2362 if not FEnabled then Exit;
2364 inherited;
2366 with Msg do
2367 case Msg of
2368 WM_CHAR:
2369 if FOnlyDigits then
2370 begin
2371 if (wParam in [48..57]) and (Chr(wParam) <> '`') then
2372 if Length(Text) < FMaxLength then
2373 begin
2374 Insert(Chr(wParam), FText, FCaretPos + 1);
2375 Inc(FCaretPos);
2376 end;
2377 end
2378 else
2379 begin
2380 if (wParam in [32..255]) and (Chr(wParam) <> '`') then
2381 if Length(Text) < FMaxLength then
2382 begin
2383 Insert(Chr(wParam), FText, FCaretPos + 1);
2384 Inc(FCaretPos);
2385 end;
2386 end;
2387 WM_KEYDOWN:
2388 case wParam of
2389 IK_BACKSPACE:
2390 begin
2391 Delete(FText, FCaretPos, 1);
2392 if FCaretPos > 0 then Dec(FCaretPos);
2393 end;
2394 IK_DELETE: Delete(FText, FCaretPos + 1, 1);
2395 IK_END, IK_KPEND: FCaretPos := Length(FText);
2396 IK_HOME, IK_KPHOME: FCaretPos := 0;
2397 IK_LEFT, IK_KPLEFT, VK_LEFT, JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT: if FCaretPos > 0 then Dec(FCaretPos);
2398 IK_RIGHT, IK_KPRIGHT, VK_RIGHT, JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT: if FCaretPos < Length(FText) then Inc(FCaretPos);
2399 IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK:
2400 with FWindow do
2401 begin
2402 if FActiveControl <> Self then
2403 begin
2404 SetActive(Self);
2405 if @FOnEnterEvent <> nil then FOnEnterEvent(Self);
2406 end
2407 else
2408 begin
2409 if FDefControl <> '' then SetActive(GetControl(FDefControl))
2410 else SetActive(nil);
2411 if @FOnChangeEvent <> nil then FOnChangeEvent(Self);
2412 end;
2413 end;
2414 end;
2415 end;
2417 g_GUIGrabInput := (@FOnEnterEvent = nil) and (FWindow.FActiveControl = Self);
2418 g_Touch_ShowKeyboard(g_GUIGrabInput)
2419 end;
2421 procedure TGUIEdit.SetText(Text: string);
2422 begin
2423 if Length(Text) > FMaxLength then SetLength(Text, FMaxLength);
2424 FText := Text;
2425 FCaretPos := Length(FText);
2426 end;
2428 procedure TGUIEdit.Update;
2429 begin
2430 inherited;
2431 end;
2433 { TGUIKeyRead }
2435 constructor TGUIKeyRead.Create(FontID: DWORD);
2436 begin
2437 inherited Create();
2438 FKey := 0;
2439 FIsQuery := false;
2441 FFont := TFont.Create(FontID, TFontType.Character);
2442 end;
2444 procedure TGUIKeyRead.Draw;
2445 begin
2446 inherited;
2448 FFont.Draw(FX, FY, IfThen(FIsQuery, KEYREAD_QUERY, IfThen(FKey <> 0, e_KeyNames[FKey], KEYREAD_CLEAR)),
2449 FColor.R, FColor.G, FColor.B);
2450 end;
2452 function TGUIKeyRead.GetWidth: Integer;
2453 var
2454 a: Byte;
2455 w, h: Word;
2456 begin
2457 Result := 0;
2459 for a := 0 to 255 do
2460 begin
2461 FFont.GetTextSize(e_KeyNames[a], w, h);
2462 Result := Max(Result, w);
2463 end;
2465 FFont.GetTextSize(KEYREAD_QUERY, w, h);
2466 if w > Result then Result := w;
2468 FFont.GetTextSize(KEYREAD_CLEAR, w, h);
2469 if w > Result then Result := w;
2470 end;
2472 function TGUIKeyRead.WantActivationKey (key: LongInt): Boolean;
2473 begin
2474 result :=
2475 (key = IK_BACKSPACE) or
2476 false; // oops
2477 end;
2479 procedure TGUIKeyRead.OnMessage(var Msg: TMessage);
2480 procedure actDefCtl ();
2481 begin
2482 with FWindow do
2483 if FDefControl <> '' then
2484 SetActive(GetControl(FDefControl))
2485 else
2486 SetActive(nil);
2487 end;
2489 begin
2490 inherited;
2492 if not FEnabled then
2493 Exit;
2495 with Msg do
2496 case Msg of
2497 WM_KEYDOWN:
2498 case wParam of
2499 VK_ESCAPE:
2500 begin
2501 if FIsQuery then actDefCtl();
2502 FIsQuery := False;
2503 end;
2504 IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK:
2505 begin
2506 if not FIsQuery then
2507 begin
2508 with FWindow do
2509 if FActiveControl <> Self then
2510 SetActive(Self);
2512 FIsQuery := True;
2513 end
2514 else if (wParam < VK_FIRSTKEY) and (wParam > VK_LASTKEY) then
2515 begin
2516 // FKey := IK_ENTER; // <Enter>
2517 FKey := wParam;
2518 FIsQuery := False;
2519 actDefCtl();
2520 end;
2521 end;
2522 IK_BACKSPACE: // clear keybinding if we aren't waiting for a key
2523 begin
2524 if not FIsQuery then
2525 begin
2526 FKey := 0;
2527 actDefCtl();
2528 end;
2529 end;
2530 end;
2532 MESSAGE_DIKEY:
2533 begin
2534 if not FIsQuery and (wParam = IK_BACKSPACE) then
2535 begin
2536 FKey := 0;
2537 actDefCtl();
2538 end
2539 else if FIsQuery then
2540 begin
2541 case wParam of
2542 IK_ENTER, IK_KPRETURN, VK_FIRSTKEY..VK_LASTKEY (*, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK*): // Not <Enter
2543 else
2544 if e_KeyNames[wParam] <> '' then
2545 FKey := wParam;
2546 FIsQuery := False;
2547 actDefCtl();
2548 end
2549 end;
2550 end;
2551 end;
2553 g_GUIGrabInput := FIsQuery
2554 end;
2556 { TGUIKeyRead2 }
2558 constructor TGUIKeyRead2.Create(FontID: DWORD);
2559 var
2560 a: Byte;
2561 w, h: Word;
2562 begin
2563 inherited Create();
2565 FKey0 := 0;
2566 FKey1 := 0;
2567 FKeyIdx := 0;
2568 FIsQuery := False;
2570 FFontID := FontID;
2571 FFont := TFont.Create(FontID, TFontType.Character);
2573 FMaxKeyNameWdt := 0;
2574 for a := 0 to 255 do
2575 begin
2576 FFont.GetTextSize(e_KeyNames[a], w, h);
2577 FMaxKeyNameWdt := Max(FMaxKeyNameWdt, w);
2578 end;
2580 FMaxKeyNameWdt := FMaxKeyNameWdt-(FMaxKeyNameWdt div 3);
2582 FFont.GetTextSize(KEYREAD_QUERY, w, h);
2583 if w > FMaxKeyNameWdt then FMaxKeyNameWdt := w;
2585 FFont.GetTextSize(KEYREAD_CLEAR, w, h);
2586 if w > FMaxKeyNameWdt then FMaxKeyNameWdt := w;
2587 end;
2589 procedure TGUIKeyRead2.Draw;
2590 procedure drawText (idx: Integer);
2591 var
2592 x, y: Integer;
2593 r, g, b: Byte;
2594 kk: DWORD;
2595 begin
2596 if idx = 0 then kk := FKey0 else kk := FKey1;
2597 y := FY;
2598 if idx = 0 then x := FX+8 else x := FX+8+FMaxKeyNameWdt+16;
2599 r := 255;
2600 g := 0;
2601 b := 0;
2602 if FKeyIdx = idx then begin r := 255; g := 255; b := 255; end;
2603 if FIsQuery and (FKeyIdx = idx) then
2604 FFont.Draw(x, y, KEYREAD_QUERY, r, g, b)
2605 else
2606 FFont.Draw(x, y, IfThen(kk <> 0, e_KeyNames[kk], KEYREAD_CLEAR), r, g, b);
2607 end;
2609 begin
2610 inherited;
2612 //FFont.Draw(FX+8, FY, IfThen(FIsQuery and (FKeyIdx = 0), KEYREAD_QUERY, IfThen(FKey0 <> 0, e_KeyNames[FKey0], KEYREAD_CLEAR)), FColor.R, FColor.G, FColor.B);
2613 //FFont.Draw(FX+8+FMaxKeyNameWdt+16, FY, IfThen(FIsQuery and (FKeyIdx = 1), KEYREAD_QUERY, IfThen(FKey1 <> 0, e_KeyNames[FKey1], KEYREAD_CLEAR)), FColor.R, FColor.G, FColor.B);
2614 drawText(0);
2615 drawText(1);
2616 end;
2618 function TGUIKeyRead2.GetWidth: Integer;
2619 begin
2620 Result := FMaxKeyNameWdt*2+8+8+16;
2621 end;
2623 function TGUIKeyRead2.WantActivationKey (key: LongInt): Boolean;
2624 begin
2625 case key of
2626 IK_BACKSPACE, IK_LEFT, IK_RIGHT, IK_KPLEFT, IK_KPRIGHT, VK_LEFT, VK_RIGHT,
2627 JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT,
2628 JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT:
2629 result := True
2630 else
2631 result := False
2632 end
2633 end;
2635 procedure TGUIKeyRead2.OnMessage(var Msg: TMessage);
2636 procedure actDefCtl ();
2637 begin
2638 with FWindow do
2639 if FDefControl <> '' then
2640 SetActive(GetControl(FDefControl))
2641 else
2642 SetActive(nil);
2643 end;
2645 begin
2646 inherited;
2648 if not FEnabled then
2649 Exit;
2651 with Msg do
2652 case Msg of
2653 WM_KEYDOWN:
2654 case wParam of
2655 VK_ESCAPE:
2656 begin
2657 if FIsQuery then actDefCtl();
2658 FIsQuery := False;
2659 end;
2660 IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK:
2661 begin
2662 if not FIsQuery then
2663 begin
2664 with FWindow do
2665 if FActiveControl <> Self then
2666 SetActive(Self);
2668 FIsQuery := True;
2669 end
2670 else if (wParam < VK_FIRSTKEY) and (wParam > VK_LASTKEY) then
2671 begin
2672 // if (FKeyIdx = 0) then FKey0 := IK_ENTER else FKey1 := IK_ENTER; // <Enter>
2673 if (FKeyIdx = 0) then FKey0 := wParam else FKey1 := wParam;
2674 FIsQuery := False;
2675 actDefCtl();
2676 end;
2677 end;
2678 IK_BACKSPACE: // clear keybinding if we aren't waiting for a key
2679 begin
2680 if not FIsQuery then
2681 begin
2682 if (FKeyIdx = 0) then FKey0 := 0 else FKey1 := 0;
2683 actDefCtl();
2684 end;
2685 end;
2686 IK_LEFT, IK_KPLEFT, VK_LEFT, JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT:
2687 if not FIsQuery then
2688 begin
2689 FKeyIdx := 0;
2690 actDefCtl();
2691 end;
2692 IK_RIGHT, IK_KPRIGHT, VK_RIGHT, JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT:
2693 if not FIsQuery then
2694 begin
2695 FKeyIdx := 1;
2696 actDefCtl();
2697 end;
2698 end;
2700 MESSAGE_DIKEY:
2701 begin
2702 if not FIsQuery and (wParam = IK_BACKSPACE) then
2703 begin
2704 if (FKeyIdx = 0) then FKey0 := 0 else FKey1 := 0;
2705 actDefCtl();
2706 end
2707 else if FIsQuery then
2708 begin
2709 case wParam of
2710 IK_ENTER, IK_KPRETURN, VK_FIRSTKEY..VK_LASTKEY (*, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK*): // Not <Enter
2711 else
2712 if e_KeyNames[wParam] <> '' then
2713 begin
2714 if (FKeyIdx = 0) then FKey0 := wParam else FKey1 := wParam;
2715 end;
2716 FIsQuery := False;
2717 actDefCtl()
2718 end
2719 end;
2720 end;
2721 end;
2723 g_GUIGrabInput := FIsQuery
2724 end;
2727 { TGUIModelView }
2729 constructor TGUIModelView.Create;
2730 begin
2731 inherited Create();
2733 FModel := nil;
2734 end;
2736 destructor TGUIModelView.Destroy;
2737 begin
2738 FModel.Free();
2740 inherited;
2741 end;
2743 procedure TGUIModelView.Draw;
2744 begin
2745 inherited;
2747 DrawBox(FX, FY, 4, 4);
2749 if FModel <> nil then
2750 r_PlayerModel_Draw(FModel, FX+4, FY+4);
2751 end;
2753 procedure TGUIModelView.NextAnim();
2754 begin
2755 if FModel = nil then
2756 Exit;
2758 if FModel.Animation < A_PAIN then
2759 FModel.ChangeAnimation(FModel.Animation+1, True)
2760 else
2761 FModel.ChangeAnimation(A_STAND, True);
2762 end;
2764 procedure TGUIModelView.NextWeapon();
2765 begin
2766 if FModel = nil then
2767 Exit;
2769 if FModel.Weapon < WP_LAST then
2770 FModel.SetWeapon(FModel.Weapon+1)
2771 else
2772 FModel.SetWeapon(WEAPON_KASTET);
2773 end;
2775 procedure TGUIModelView.OnMessage(var Msg: TMessage);
2776 begin
2777 inherited;
2779 end;
2781 procedure TGUIModelView.SetColor(Red, Green, Blue: Byte);
2782 begin
2783 if FModel <> nil then FModel.SetColor(Red, Green, Blue);
2784 end;
2786 procedure TGUIModelView.SetModel(ModelName: string);
2787 begin
2788 FModel.Free();
2790 FModel := g_PlayerModel_Get(ModelName);
2791 end;
2793 procedure TGUIModelView.Update;
2794 begin
2795 inherited;
2797 a := not a;
2798 if a then Exit;
2800 if FModel <> nil then FModel.Update;
2801 end;
2803 { TGUIMapPreview }
2805 constructor TGUIMapPreview.Create();
2806 begin
2807 inherited Create();
2808 ClearMap;
2809 end;
2811 destructor TGUIMapPreview.Destroy();
2812 begin
2813 ClearMap;
2814 inherited;
2815 end;
2817 procedure TGUIMapPreview.Draw();
2818 var
2819 a: Integer;
2820 r, g, b: Byte;
2821 begin
2822 inherited;
2824 DrawBox(FX, FY, MAPPREVIEW_WIDTH, MAPPREVIEW_HEIGHT);
2826 if (FMapSize.X <= 0) or (FMapSize.Y <= 0) then
2827 Exit;
2829 e_DrawFillQuad(FX+4, FY+4,
2830 FX+4 + Trunc(FMapSize.X / FScale) - 1,
2831 FY+4 + Trunc(FMapSize.Y / FScale) - 1,
2832 32, 32, 32, 0);
2834 if FMapData <> nil then
2835 for a := 0 to High(FMapData) do
2836 with FMapData[a] do
2837 begin
2838 if X1 > MAPPREVIEW_WIDTH*16 then Continue;
2839 if Y1 > MAPPREVIEW_HEIGHT*16 then Continue;
2841 if X2 < 0 then Continue;
2842 if Y2 < 0 then Continue;
2844 if X2 > MAPPREVIEW_WIDTH*16 then X2 := MAPPREVIEW_WIDTH*16;
2845 if Y2 > MAPPREVIEW_HEIGHT*16 then Y2 := MAPPREVIEW_HEIGHT*16;
2847 if X1 < 0 then X1 := 0;
2848 if Y1 < 0 then Y1 := 0;
2850 case PanelType of
2851 PANEL_WALL:
2852 begin
2853 r := 255;
2854 g := 255;
2855 b := 255;
2856 end;
2857 PANEL_CLOSEDOOR:
2858 begin
2859 r := 255;
2860 g := 255;
2861 b := 0;
2862 end;
2863 PANEL_WATER:
2864 begin
2865 r := 0;
2866 g := 0;
2867 b := 192;
2868 end;
2869 PANEL_ACID1:
2870 begin
2871 r := 0;
2872 g := 176;
2873 b := 0;
2874 end;
2875 PANEL_ACID2:
2876 begin
2877 r := 176;
2878 g := 0;
2879 b := 0;
2880 end;
2881 else
2882 begin
2883 r := 128;
2884 g := 128;
2885 b := 128;
2886 end;
2887 end;
2889 if ((X2-X1) > 0) and ((Y2-Y1) > 0) then
2890 e_DrawFillQuad(FX+4 + X1, FY+4 + Y1,
2891 FX+4 + X2 - 1, FY+4 + Y2 - 1, r, g, b, 0);
2892 end;
2893 end;
2895 procedure TGUIMapPreview.OnMessage(var Msg: TMessage);
2896 begin
2897 inherited;
2899 end;
2901 procedure TGUIMapPreview.SetMap(Res: string);
2902 var
2903 WAD: TWADFile;
2904 panlist: TDynField;
2905 pan: TDynRecord;
2906 //header: TMapHeaderRec_1;
2907 FileName: string;
2908 Data: Pointer;
2909 Len: Integer;
2910 rX, rY: Single;
2911 map: TDynRecord = nil;
2912 begin
2913 FMapSize.X := 0;
2914 FMapSize.Y := 0;
2915 FScale := 0.0;
2916 FMapData := nil;
2918 FileName := g_ExtractWadName(Res);
2920 WAD := TWADFile.Create();
2921 if not WAD.ReadFile(FileName) then
2922 begin
2923 WAD.Free();
2924 Exit;
2925 end;
2927 //k8: ignores path again
2928 if not WAD.GetMapResource(g_ExtractFileName(Res), Data, Len) then
2929 begin
2930 WAD.Free();
2931 Exit;
2932 end;
2934 WAD.Free();
2936 try
2937 map := g_Map_ParseMap(Data, Len);
2938 except
2939 FreeMem(Data);
2940 map.Free();
2941 //raise;
2942 exit;
2943 end;
2945 FreeMem(Data);
2947 if (map = nil) then exit;
2949 try
2950 panlist := map.field['panel'];
2951 //header := GetMapHeader(map);
2953 FMapSize.X := map.Width div 16;
2954 FMapSize.Y := map.Height div 16;
2956 rX := Ceil(map.Width / (MAPPREVIEW_WIDTH*256.0));
2957 rY := Ceil(map.Height / (MAPPREVIEW_HEIGHT*256.0));
2958 FScale := max(rX, rY);
2960 FMapData := nil;
2962 if (panlist <> nil) then
2963 begin
2964 for pan in panlist do
2965 begin
2966 if (pan.PanelType and (PANEL_WALL or PANEL_CLOSEDOOR or
2967 PANEL_STEP or PANEL_WATER or
2968 PANEL_ACID1 or PANEL_ACID2)) <> 0 then
2969 begin
2970 SetLength(FMapData, Length(FMapData)+1);
2971 with FMapData[High(FMapData)] do
2972 begin
2973 X1 := pan.X div 16;
2974 Y1 := pan.Y div 16;
2976 X2 := (pan.X + pan.Width) div 16;
2977 Y2 := (pan.Y + pan.Height) div 16;
2979 X1 := Trunc(X1/FScale + 0.5);
2980 Y1 := Trunc(Y1/FScale + 0.5);
2981 X2 := Trunc(X2/FScale + 0.5);
2982 Y2 := Trunc(Y2/FScale + 0.5);
2984 if (X1 <> X2) or (Y1 <> Y2) then
2985 begin
2986 if X1 = X2 then
2987 X2 := X2 + 1;
2988 if Y1 = Y2 then
2989 Y2 := Y2 + 1;
2990 end;
2992 PanelType := pan.PanelType;
2993 end;
2994 end;
2995 end;
2996 end;
2997 finally
2998 //writeln('freeing map');
2999 map.Free();
3000 end;
3001 end;
3003 procedure TGUIMapPreview.ClearMap();
3004 begin
3005 SetLength(FMapData, 0);
3006 FMapData := nil;
3007 FMapSize.X := 0;
3008 FMapSize.Y := 0;
3009 FScale := 0.0;
3010 end;
3012 procedure TGUIMapPreview.Update();
3013 begin
3014 inherited;
3016 end;
3018 function TGUIMapPreview.GetScaleStr(): String;
3019 begin
3020 if FScale > 0.0 then
3021 begin
3022 Result := FloatToStrF(FScale*16.0, ffFixed, 3, 3);
3023 while (Result[Length(Result)] = '0') do
3024 Delete(Result, Length(Result), 1);
3025 if (Result[Length(Result)] = ',') or (Result[Length(Result)] = '.') then
3026 Delete(Result, Length(Result), 1);
3027 Result := '1 : ' + Result;
3028 end
3029 else
3030 Result := '';
3031 end;
3033 { TGUIListBox }
3035 procedure TGUIListBox.AddItem(Item: string);
3036 begin
3037 SetLength(FItems, Length(FItems)+1);
3038 FItems[High(FItems)] := Item;
3040 if FSort then g_gui.Sort(FItems);
3041 end;
3043 function TGUIListBox.ItemExists (item: String): Boolean;
3044 var i: Integer;
3045 begin
3046 i := 0;
3047 while (i <= High(FItems)) and (FItems[i] <> item) do Inc(i);
3048 result := i <= High(FItems)
3049 end;
3051 procedure TGUIListBox.Clear;
3052 begin
3053 FItems := nil;
3055 FStartLine := 0;
3056 FIndex := -1;
3057 end;
3059 constructor TGUIListBox.Create(FontID: DWORD; Width, Height: Word);
3060 begin
3061 inherited Create();
3063 FFont := TFont.Create(FontID, TFontType.Character);
3065 FWidth := Width;
3066 FHeight := Height;
3067 FIndex := -1;
3068 FOnChangeEvent := nil;
3069 FDrawBack := True;
3070 FDrawScroll := True;
3071 end;
3073 procedure TGUIListBox.Draw;
3074 var
3075 w2, h2: Word;
3076 a: Integer;
3077 s: string;
3078 begin
3079 inherited;
3081 if FDrawBack then DrawBox(FX, FY, FWidth+1, FHeight);
3082 if FDrawScroll then
3083 DrawScroll(FX+4+FWidth*16, FY+4, FHeight, (FStartLine > 0) and (FItems <> nil),
3084 (FStartLine+FHeight-1 < High(FItems)) and (FItems <> nil));
3086 if FItems <> nil then
3087 for a := FStartLine to Min(High(FItems), FStartLine+FHeight-1) do
3088 begin
3089 s := Items[a];
3091 FFont.GetTextSize(s, w2, h2);
3092 while (Length(s) > 0) and (w2 > FWidth*16) do
3093 begin
3094 SetLength(s, Length(s)-1);
3095 FFont.GetTextSize(s, w2, h2);
3096 end;
3098 if a = FIndex then
3099 FFont.Draw(FX+4, FY+4+(a-FStartLine)*16, s, FActiveColor.R, FActiveColor.G, FActiveColor.B)
3100 else
3101 FFont.Draw(FX+4, FY+4+(a-FStartLine)*16, s, FUnActiveColor.R, FUnActiveColor.G, FUnActiveColor.B);
3102 end;
3103 end;
3105 function TGUIListBox.GetHeight: Integer;
3106 begin
3107 Result := 8+FHeight*16;
3108 end;
3110 function TGUIListBox.GetWidth: Integer;
3111 begin
3112 Result := 8+(FWidth+1)*16;
3113 end;
3115 procedure TGUIListBox.OnMessage(var Msg: TMessage);
3116 var
3117 a: Integer;
3118 begin
3119 if not FEnabled then Exit;
3121 inherited;
3123 if FItems = nil then Exit;
3125 with Msg do
3126 case Msg of
3127 WM_KEYDOWN:
3128 case wParam of
3129 IK_HOME, IK_KPHOME:
3130 begin
3131 FIndex := 0;
3132 FStartLine := 0;
3133 end;
3134 IK_END, IK_KPEND:
3135 begin
3136 FIndex := High(FItems);
3137 FStartLine := Max(High(FItems)-FHeight+1, 0);
3138 end;
3139 IK_UP, IK_LEFT, IK_KPUP, IK_KPLEFT, VK_LEFT, JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT:
3140 if FIndex > 0 then
3141 begin
3142 Dec(FIndex);
3143 if FIndex < FStartLine then Dec(FStartLine);
3144 if @FOnChangeEvent <> nil then FOnChangeEvent(Self);
3145 end;
3146 IK_DOWN, IK_RIGHT, IK_KPDOWN, IK_KPRIGHT, VK_RIGHT, JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT:
3147 if FIndex < High(FItems) then
3148 begin
3149 Inc(FIndex);
3150 if FIndex > FStartLine+FHeight-1 then Inc(FStartLine);
3151 if @FOnChangeEvent <> nil then FOnChangeEvent(Self);
3152 end;
3153 IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK:
3154 with FWindow do
3155 begin
3156 if FActiveControl <> Self then SetActive(Self)
3157 else
3158 if FDefControl <> '' then SetActive(GetControl(FDefControl))
3159 else SetActive(nil);
3160 end;
3161 end;
3162 WM_CHAR:
3163 for a := 0 to High(FItems) do
3164 if (Length(FItems[a]) > 0) and (LowerCase(FItems[a][1]) = LowerCase(Chr(wParam))) then
3165 begin
3166 FIndex := a;
3167 FStartLine := Min(Max(FIndex-1, 0), Length(FItems)-FHeight);
3168 if @FOnChangeEvent <> nil then FOnChangeEvent(Self);
3169 Break;
3170 end;
3171 end;
3172 end;
3174 function TGUIListBox.SelectedItem(): String;
3175 begin
3176 Result := '';
3178 if (FIndex < 0) or (FItems = nil) or
3179 (FIndex > High(FItems)) then
3180 Exit;
3182 Result := FItems[FIndex];
3183 end;
3185 procedure TGUIListBox.FSetItems(Items: SSArray);
3186 begin
3187 if FItems <> nil then
3188 FItems := nil;
3190 FItems := Items;
3192 FStartLine := 0;
3193 FIndex := -1;
3195 if FSort then g_gui.Sort(FItems);
3196 end;
3198 procedure TGUIListBox.SelectItem(Item: String);
3199 var
3200 a: Integer;
3201 begin
3202 if FItems = nil then
3203 Exit;
3205 FIndex := 0;
3206 Item := LowerCase(Item);
3208 for a := 0 to High(FItems) do
3209 if LowerCase(FItems[a]) = Item then
3210 begin
3211 FIndex := a;
3212 Break;
3213 end;
3215 if FIndex < FHeight then
3216 FStartLine := 0
3217 else
3218 FStartLine := Min(FIndex, Length(FItems)-FHeight);
3219 end;
3221 procedure TGUIListBox.FSetIndex(aIndex: Integer);
3222 begin
3223 if FItems = nil then
3224 Exit;
3226 if (aIndex < 0) or (aIndex > High(FItems)) then
3227 Exit;
3229 FIndex := aIndex;
3231 if FIndex <= FHeight then
3232 FStartLine := 0
3233 else
3234 FStartLine := Min(FIndex, Length(FItems)-FHeight);
3235 end;
3237 { TGUIFileListBox }
3239 procedure TGUIFileListBox.OnMessage(var Msg: TMessage);
3240 var
3241 a, b: Integer; s: AnsiString;
3242 begin
3243 if not FEnabled then
3244 Exit;
3246 if FItems = nil then
3247 Exit;
3249 with Msg do
3250 case Msg of
3251 WM_KEYDOWN:
3252 case wParam of
3253 IK_HOME, IK_KPHOME:
3254 begin
3255 FIndex := 0;
3256 FStartLine := 0;
3257 if @FOnChangeEvent <> nil then
3258 FOnChangeEvent(Self);
3259 end;
3261 IK_END, IK_KPEND:
3262 begin
3263 FIndex := High(FItems);
3264 FStartLine := Max(High(FItems)-FHeight+1, 0);
3265 if @FOnChangeEvent <> nil then
3266 FOnChangeEvent(Self);
3267 end;
3269 IK_PAGEUP, IK_KPPAGEUP:
3270 begin
3271 if FIndex > FHeight then
3272 FIndex := FIndex-FHeight
3273 else
3274 FIndex := 0;
3276 if FStartLine > FHeight then
3277 FStartLine := FStartLine-FHeight
3278 else
3279 FStartLine := 0;
3280 end;
3282 IK_PAGEDN, IK_KPPAGEDN:
3283 begin
3284 if FIndex < High(FItems)-FHeight then
3285 FIndex := FIndex+FHeight
3286 else
3287 FIndex := High(FItems);
3289 if FStartLine < High(FItems)-FHeight then
3290 FStartLine := FStartLine+FHeight
3291 else
3292 FStartLine := High(FItems)-FHeight+1;
3293 end;
3295 IK_UP, IK_LEFT, IK_KPUP, IK_KPLEFT, VK_UP, VK_LEFT, JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT:
3296 if FIndex > 0 then
3297 begin
3298 Dec(FIndex);
3299 if FIndex < FStartLine then
3300 Dec(FStartLine);
3301 if @FOnChangeEvent <> nil then
3302 FOnChangeEvent(Self);
3303 end;
3305 IK_DOWN, IK_RIGHT, IK_KPDOWN, IK_KPRIGHT, VK_DOWN, VK_RIGHT, JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT:
3306 if FIndex < High(FItems) then
3307 begin
3308 Inc(FIndex);
3309 if FIndex > FStartLine+FHeight-1 then
3310 Inc(FStartLine);
3311 if @FOnChangeEvent <> nil then
3312 FOnChangeEvent(Self);
3313 end;
3315 IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK:
3316 with FWindow do
3317 begin
3318 if FActiveControl <> Self then
3319 SetActive(Self)
3320 else
3321 begin
3322 if FItems[FIndex][1] = #29 then // Ïàïêà
3323 begin
3324 if FItems[FIndex] = #29 + '..' then
3325 begin
3326 e_LogWritefln('TGUIFileListBox: Upper dir "%s" -> "%s"', [FSubPath, e_UpperDir(FSubPath)]);
3327 FSubPath := e_UpperDir(FSubPath)
3328 end
3329 else
3330 begin
3331 s := Copy(AnsiString(FItems[FIndex]), 2);
3332 e_LogWritefln('TGUIFileListBox: Enter dir "%s" -> "%s"', [FSubPath, e_CatPath(FSubPath, s)]);
3333 FSubPath := e_CatPath(FSubPath, s);
3334 end;
3335 ScanDirs;
3336 FIndex := 0;
3337 Exit;
3338 end;
3340 if FDefControl <> '' then
3341 SetActive(GetControl(FDefControl))
3342 else
3343 SetActive(nil);
3344 end;
3345 end;
3346 end;
3348 WM_CHAR:
3349 for b := FIndex + 1 to High(FItems) + FIndex do
3350 begin
3351 a := b mod Length(FItems);
3352 if ( (Length(FItems[a]) > 0) and
3353 (LowerCase(FItems[a][1]) = LowerCase(Chr(wParam))) ) or
3354 ( (Length(FItems[a]) > 1) and
3355 (FItems[a][1] = #29) and // Ïàïêà
3356 (LowerCase(FItems[a][2]) = LowerCase(Chr(wParam))) ) then
3357 begin
3358 FIndex := a;
3359 FStartLine := Min(Max(FIndex-1, 0), Length(FItems)-FHeight);
3360 if @FOnChangeEvent <> nil then
3361 FOnChangeEvent(Self);
3362 Break;
3363 end;
3364 end;
3365 end;
3366 end;
3368 procedure TGUIFileListBox.ScanDirs;
3369 var i, j: Integer; path: AnsiString; SR: TSearchRec; sm, sc: String;
3370 begin
3371 Clear;
3373 i := High(FBaseList);
3374 while i >= 0 do
3375 begin
3376 path := e_CatPath(FBaseList[i], FSubPath);
3377 if FDirs then
3378 begin
3379 if FindFirst(path + '/' + '*', faDirectory, SR) = 0 then
3380 begin
3381 repeat
3382 if LongBool(SR.Attr and faDirectory) then
3383 if (SR.Name <> '.') and ((FSubPath <> '') or (SR.Name <> '..')) then
3384 if Self.ItemExists(#1 + SR.Name) = false then
3385 Self.AddItem(#1 + SR.Name)
3386 until FindNext(SR) <> 0
3387 end;
3388 FindClose(SR)
3389 end;
3390 Dec(i)
3391 end;
3393 i := High(FBaseList);
3394 while i >= 0 do
3395 begin
3396 path := e_CatPath(FBaseList[i], FSubPath);
3397 sm := FFileMask;
3398 while sm <> '' do
3399 begin
3400 j := Pos('|', sm);
3401 if j = 0 then
3402 j := length(sm) + 1;
3403 sc := Copy(sm, 1, j - 1);
3404 Delete(sm, 1, j);
3405 if FindFirst(path + '/' + sc, faAnyFile, SR) = 0 then
3406 begin
3407 repeat
3408 if Self.ItemExists(SR.Name) = false then
3409 AddItem(SR.Name)
3410 until FindNext(SR) <> 0
3411 end;
3412 FindClose(SR)
3413 end;
3414 Dec(i)
3415 end;
3417 for i := 0 to High(FItems) do
3418 if FItems[i][1] = #1 then
3419 FItems[i][1] := #29;
3420 end;
3422 procedure TGUIFileListBox.SetBase (dirs: SSArray; path: String = '');
3423 begin
3424 FBaseList := dirs;
3425 FSubPath := path;
3426 ScanDirs
3427 end;
3429 function TGUIFileListBox.SelectedItem (): String;
3430 var s: AnsiString;
3431 begin
3432 result := '';
3433 if (FIndex >= 0) and (FIndex <= High(FItems)) and (FItems[FIndex][1] <> '/') and (FItems[FIndex][1] <> '\') then
3434 begin
3435 s := e_CatPath(FSubPath, FItems[FIndex]);
3436 if e_FindResource(FBaseList, s) = true then
3437 result := ExpandFileName(s)
3438 end;
3439 e_LogWritefln('TGUIFileListBox.SelectedItem -> "%s"', [result]);
3440 end;
3442 procedure TGUIFileListBox.UpdateFileList();
3443 var
3444 fn: String;
3445 begin
3446 if (FIndex = -1) or (FItems = nil) or
3447 (FIndex > High(FItems)) or
3448 (FItems[FIndex][1] = '/') or
3449 (FItems[FIndex][1] = '\') then
3450 fn := ''
3451 else
3452 fn := FItems[FIndex];
3454 // OpenDir(FPath);
3455 ScanDirs;
3457 if fn <> '' then
3458 SelectItem(fn);
3459 end;
3461 { TGUIMemo }
3463 procedure TGUIMemo.Clear;
3464 begin
3465 FLines := nil;
3466 FStartLine := 0;
3467 end;
3469 constructor TGUIMemo.Create(FontID: DWORD; Width, Height: Word);
3470 begin
3471 inherited Create();
3473 FFont := TFont.Create(FontID, TFontType.Character);
3475 FWidth := Width;
3476 FHeight := Height;
3477 FDrawBack := True;
3478 FDrawScroll := True;
3479 end;
3481 procedure TGUIMemo.Draw;
3482 var
3483 a: Integer;
3484 begin
3485 inherited;
3487 if FDrawBack then DrawBox(FX, FY, FWidth+1, FHeight);
3488 if FDrawScroll then
3489 DrawScroll(FX+4+FWidth*16, FY+4, FHeight, (FStartLine > 0) and (FLines <> nil),
3490 (FStartLine+FHeight-1 < High(FLines)) and (FLines <> nil));
3492 if FLines <> nil then
3493 for a := FStartLine to Min(High(FLines), FStartLine+FHeight-1) do
3494 FFont.Draw(FX+4, FY+4+(a-FStartLine)*16, FLines[a], FColor.R, FColor.G, FColor.B);
3495 end;
3497 function TGUIMemo.GetHeight: Integer;
3498 begin
3499 Result := 8+FHeight*16;
3500 end;
3502 function TGUIMemo.GetWidth: Integer;
3503 begin
3504 Result := 8+(FWidth+1)*16;
3505 end;
3507 procedure TGUIMemo.OnMessage(var Msg: TMessage);
3508 begin
3509 if not FEnabled then Exit;
3511 inherited;
3513 if FLines = nil then Exit;
3515 with Msg do
3516 case Msg of
3517 WM_KEYDOWN:
3518 case wParam of
3519 IK_UP, IK_LEFT, IK_KPUP, IK_KPLEFT, VK_UP, VK_LEFT, JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT:
3520 if FStartLine > 0 then
3521 Dec(FStartLine);
3522 IK_DOWN, IK_RIGHT, IK_KPDOWN, IK_KPRIGHT, VK_DOWN, VK_RIGHT, JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT:
3523 if FStartLine < Length(FLines)-FHeight then
3524 Inc(FStartLine);
3525 IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK:
3526 with FWindow do
3527 begin
3528 if FActiveControl <> Self then
3529 begin
3530 SetActive(Self);
3531 {FStartLine := 0;}
3532 end
3533 else
3534 if FDefControl <> '' then SetActive(GetControl(FDefControl))
3535 else SetActive(nil);
3536 end;
3537 end;
3538 end;
3539 end;
3541 procedure TGUIMemo.SetText(Text: string);
3542 begin
3543 FStartLine := 0;
3544 FLines := GetLines(Text, FFont.ID, FWidth*16);
3545 end;
3547 { TGUIimage }
3549 procedure TGUIimage.ClearImage();
3550 begin
3551 if FImageRes = '' then Exit;
3553 g_Texture_Delete(FImageRes);
3554 FImageRes := '';
3555 end;
3557 constructor TGUIimage.Create();
3558 begin
3559 inherited Create();
3561 FImageRes := '';
3562 end;
3564 destructor TGUIimage.Destroy();
3565 begin
3566 inherited;
3567 end;
3569 procedure TGUIimage.Draw();
3570 var
3571 ID: DWORD;
3572 begin
3573 inherited;
3575 if FImageRes = '' then
3576 begin
3577 if g_Texture_Get(FDefaultRes, ID) then e_Draw(ID, FX, FY, 0, True, False);
3578 end
3579 else
3580 if g_Texture_Get(FImageRes, ID) then e_Draw(ID, FX, FY, 0, True, False);
3581 end;
3583 procedure TGUIimage.OnMessage(var Msg: TMessage);
3584 begin
3585 inherited;
3586 end;
3588 procedure TGUIimage.SetImage(Res: string);
3589 begin
3590 ClearImage();
3592 if g_Texture_CreateWADEx(Res, Res) then FImageRes := Res;
3593 end;
3595 procedure TGUIimage.Update();
3596 begin
3597 inherited;
3598 end;
3600 end.