DEADSOFTWARE

Game: Use proper syntax of sets for game options instead of raw bitwise operations
[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 e_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 {$INCLUDE ../nogl/noGLuses.inc}
554 g_textures, g_sound, SysUtils, e_res,
555 g_game, Math, StrUtils, g_player, g_options, g_console,
556 g_map, g_weapons, xdynrec, wadreader;
559 var
560 Box: Array [0..8] of DWORD;
561 Saved_Windows: SSArray;
564 procedure g_GUI_Init();
565 begin
566 g_Texture_Get(BOX1, Box[0]);
567 g_Texture_Get(BOX2, Box[1]);
568 g_Texture_Get(BOX3, Box[2]);
569 g_Texture_Get(BOX4, Box[3]);
570 g_Texture_Get(BOX5, Box[4]);
571 g_Texture_Get(BOX6, Box[5]);
572 g_Texture_Get(BOX7, Box[6]);
573 g_Texture_Get(BOX8, Box[7]);
574 g_Texture_Get(BOX9, Box[8]);
575 end;
577 function g_GUI_Destroy(): Boolean;
578 var
579 i: Integer;
580 begin
581 Result := (Length(g_GUIWindows) > 0);
583 for i := 0 to High(g_GUIWindows) do
584 g_GUIWindows[i].Free();
586 g_GUIWindows := nil;
587 g_ActiveWindow := nil;
588 end;
590 function g_GUI_AddWindow(Window: TGUIWindow): TGUIWindow;
591 begin
592 SetLength(g_GUIWindows, Length(g_GUIWindows)+1);
593 g_GUIWindows[High(g_GUIWindows)] := Window;
595 Result := Window;
596 end;
598 function g_GUI_GetWindow(Name: string): TGUIWindow;
599 var
600 i: Integer;
601 begin
602 Result := nil;
604 if g_GUIWindows <> nil then
605 for i := 0 to High(g_GUIWindows) do
606 if g_GUIWindows[i].FName = Name then
607 begin
608 Result := g_GUIWindows[i];
609 Break;
610 end;
612 Assert(Result <> nil, 'GUI_Window "'+Name+'" not found');
613 end;
615 procedure g_GUI_ShowWindow(Name: string);
616 var
617 i: Integer;
618 begin
619 if g_GUIWindows = nil then
620 Exit;
622 for i := 0 to High(g_GUIWindows) do
623 if g_GUIWindows[i].FName = Name then
624 begin
625 g_GUIWindows[i].FPrevWindow := g_ActiveWindow;
626 g_ActiveWindow := g_GUIWindows[i];
628 if g_ActiveWindow.MainWindow then
629 g_ActiveWindow.FPrevWindow := nil;
631 if g_ActiveWindow.FDefControl <> '' then
632 g_ActiveWindow.SetActive(g_ActiveWindow.GetControl(g_ActiveWindow.FDefControl))
633 else
634 g_ActiveWindow.SetActive(nil);
636 if @g_ActiveWindow.FOnShowEvent <> nil then
637 g_ActiveWindow.FOnShowEvent();
639 Break;
640 end;
641 end;
643 procedure g_GUI_HideWindow(PlaySound: Boolean = True);
644 begin
645 if g_ActiveWindow <> nil then
646 begin
647 if @g_ActiveWindow.OnClose <> nil then
648 g_ActiveWindow.OnClose();
649 g_ActiveWindow := g_ActiveWindow.FPrevWindow;
650 if PlaySound then
651 g_Sound_PlayEx(WINDOW_CLOSESOUND);
652 end;
653 end;
655 procedure g_GUI_SaveMenuPos();
656 var
657 len: Integer;
658 win: TGUIWindow;
659 begin
660 SetLength(Saved_Windows, 0);
661 win := g_ActiveWindow;
663 while win <> nil do
664 begin
665 len := Length(Saved_Windows);
666 SetLength(Saved_Windows, len + 1);
668 Saved_Windows[len] := win.Name;
670 if win.MainWindow then
671 win := nil
672 else
673 win := win.FPrevWindow;
674 end;
675 end;
677 procedure g_GUI_LoadMenuPos();
678 var
679 i, j, k, len: Integer;
680 ok: Boolean;
681 begin
682 g_ActiveWindow := nil;
683 len := Length(Saved_Windows);
685 if len = 0 then
686 Exit;
688 // Îêíî ñ ãëàâíûì ìåíþ:
689 g_GUI_ShowWindow(Saved_Windows[len-1]);
691 // Íå ïåðåêëþ÷èëîñü (èëè íåêóäà äàëüøå):
692 if (len = 1) or (g_ActiveWindow = nil) then
693 Exit;
695 // Èùåì êíîïêè â îñòàëüíûõ îêíàõ:
696 for k := len-1 downto 1 do
697 begin
698 ok := False;
700 for i := 0 to Length(g_ActiveWindow.Childs)-1 do
701 begin
702 if g_ActiveWindow.Childs[i] is TGUIMainMenu then
703 begin // GUI_MainMenu
704 with TGUIMainMenu(g_ActiveWindow.Childs[i]) do
705 for j := 0 to Length(FButtons)-1 do
706 if FButtons[j].ShowWindow = Saved_Windows[k-1] then
707 begin
708 FButtons[j].Click(True);
709 ok := True;
710 Break;
711 end;
712 end
713 else // GUI_Menu
714 if g_ActiveWindow.Childs[i] is TGUIMenu then
715 with TGUIMenu(g_ActiveWindow.Childs[i]) do
716 for j := 0 to Length(FItems)-1 do
717 if FItems[j].ControlType = TGUITextButton then
718 if TGUITextButton(FItems[j].Control).ShowWindow = Saved_Windows[k-1] then
719 begin
720 TGUITextButton(FItems[j].Control).Click(True);
721 ok := True;
722 Break;
723 end;
725 if ok then
726 Break;
727 end;
729 // Íå ïåðåêëþ÷èëîñü:
730 if (not ok) or
731 (g_ActiveWindow.Name = Saved_Windows[k]) then
732 Break;
733 end;
734 end;
736 procedure DrawBox(X, Y: Integer; Width, Height: Word);
737 begin
738 e_Draw(Box[0], X, Y, 0, False, False);
739 e_DrawFill(Box[1], X+4, Y, Width*4, 1, 0, False, False);
740 e_Draw(Box[2], X+4+Width*16, Y, 0, False, False);
741 e_DrawFill(Box[3], X, Y+4, 1, Height*4, 0, False, False);
742 e_DrawFill(Box[4], X+4, Y+4, Width, Height, 0, False, False);
743 e_DrawFill(Box[5], X+4+Width*16, Y+4, 1, Height*4, 0, False, False);
744 e_Draw(Box[6], X, Y+4+Height*16, 0, False, False);
745 e_DrawFill(Box[7], X+4, Y+4+Height*16, Width*4, 1, 0, False, False);
746 e_Draw(Box[8], X+4+Width*16, Y+4+Height*16, 0, False, False);
747 end;
749 procedure DrawScroll(X, Y: Integer; Height: Word; Up, Down: Boolean);
750 var
751 ID: DWORD;
752 begin
753 if Height < 3 then Exit;
755 if Up then
756 g_Texture_Get(BSCROLL_UPA, ID)
757 else
758 g_Texture_Get(BSCROLL_UPU, ID);
759 e_Draw(ID, X, Y, 0, False, False);
761 if Down then
762 g_Texture_Get(BSCROLL_DOWNA, ID)
763 else
764 g_Texture_Get(BSCROLL_DOWNU, ID);
765 e_Draw(ID, X, Y+(Height-1)*16, 0, False, False);
767 g_Texture_Get(BSCROLL_MIDDLE, ID);
768 e_DrawFill(ID, X, Y+16, 1, Height-2, 0, False, False);
769 end;
771 { TGUIWindow }
773 constructor TGUIWindow.Create(Name: string);
774 begin
775 Childs := nil;
776 FActiveControl := nil;
777 FName := Name;
778 FOnKeyDown := nil;
779 FOnKeyDownEx := nil;
780 FOnCloseEvent := nil;
781 FOnShowEvent := nil;
782 end;
784 destructor TGUIWindow.Destroy;
785 var
786 i: Integer;
787 begin
788 if Childs = nil then
789 Exit;
791 for i := 0 to High(Childs) do
792 Childs[i].Free();
793 end;
795 function TGUIWindow.AddChild(Child: TGUIControl): TGUIControl;
796 begin
797 Child.FWindow := Self;
799 SetLength(Childs, Length(Childs) + 1);
800 Childs[High(Childs)] := Child;
802 Result := Child;
803 end;
805 procedure TGUIWindow.Update;
806 var
807 i: Integer;
808 begin
809 for i := 0 to High(Childs) do
810 if Childs[i] <> nil then Childs[i].Update;
811 end;
813 procedure TGUIWindow.Draw;
814 var
815 i: Integer;
816 ID: DWORD;
817 tw, th: Word;
818 begin
819 if FBackTexture <> '' then // Here goes code duplication from g_game.pas:DrawMenuBackground()
820 if g_Texture_Get(FBackTexture, ID) then
821 begin
822 e_Clear(GL_COLOR_BUFFER_BIT, 0, 0, 0);
823 e_GetTextureSize(ID, @tw, @th);
824 if tw = th then
825 tw := round(tw * 1.333 * (gScreenHeight / th))
826 else
827 tw := trunc(tw * (gScreenHeight / th));
828 e_DrawSize(ID, (gScreenWidth - tw) div 2, 0, 0, False, False, tw, gScreenHeight);
829 end
830 else
831 e_Clear(GL_COLOR_BUFFER_BIT, 0.5, 0.5, 0.5);
833 // small hack here
834 if FName = 'AuthorsMenu' then
835 e_DarkenQuadWH(0, 0, gScreenWidth, gScreenHeight, 150);
837 for i := 0 to High(Childs) do
838 if Childs[i] <> nil then Childs[i].Draw;
839 end;
841 procedure TGUIWindow.OnMessage(var Msg: TMessage);
842 begin
843 if FActiveControl <> nil then FActiveControl.OnMessage(Msg);
844 if @FOnKeyDown <> nil then FOnKeyDown(Msg.wParam);
845 if @FOnKeyDownEx <> nil then FOnKeyDownEx(self, Msg.wParam);
847 if Msg.Msg = WM_KEYDOWN then
848 begin
849 case Msg.wParam of
850 VK_ESCAPE:
851 begin
852 g_GUI_HideWindow;
853 Exit
854 end
855 end
856 end
857 end;
859 procedure TGUIWindow.SetActive(Control: TGUIControl);
860 begin
861 FActiveControl := Control;
862 end;
864 function TGUIWindow.GetControl(Name: String): TGUIControl;
865 var
866 i: Integer;
867 begin
868 Result := nil;
870 if Childs <> nil then
871 for i := 0 to High(Childs) do
872 if Childs[i] <> nil then
873 if LowerCase(Childs[i].FName) = LowerCase(Name) then
874 begin
875 Result := Childs[i];
876 Break;
877 end;
879 Assert(Result <> nil, 'Window Control "'+Name+'" not Found!');
880 end;
882 { TGUIControl }
884 constructor TGUIControl.Create();
885 begin
886 FX := 0;
887 FY := 0;
889 FEnabled := True;
890 FRightAlign := false;
891 FMaxWidth := -1;
892 end;
894 procedure TGUIControl.OnMessage(var Msg: TMessage);
895 begin
896 if not FEnabled then
897 Exit;
898 end;
900 procedure TGUIControl.Update();
901 begin
902 end;
904 procedure TGUIControl.Draw();
905 begin
906 end;
908 function TGUIControl.WantActivationKey (key: LongInt): Boolean;
909 begin
910 result := false;
911 end;
913 function TGUIControl.GetWidth(): Integer;
914 begin
915 result := 0;
916 end;
918 function TGUIControl.GetHeight(): Integer;
919 begin
920 result := 0;
921 end;
923 { TGUITextButton }
925 procedure TGUITextButton.Click(Silent: Boolean = False);
926 begin
927 if (FSound <> '') and (not Silent) then g_Sound_PlayEx(FSound);
929 if @Proc <> nil then Proc();
930 if @ProcEx <> nil then ProcEx(self);
932 if FShowWindow <> '' then g_GUI_ShowWindow(FShowWindow);
933 end;
935 constructor TGUITextButton.Create(aProc: Pointer; FontID: DWORD; Text: string);
936 begin
937 inherited Create();
939 Self.Proc := aProc;
940 ProcEx := nil;
942 FFont := TFont.Create(FontID, TFontType.Character);
944 FText := Text;
945 end;
947 destructor TGUITextButton.Destroy;
948 begin
950 inherited;
951 end;
953 procedure TGUITextButton.Draw;
954 begin
955 FFont.Draw(FX, FY, FText, FColor.R, FColor.G, FColor.B)
956 end;
958 function TGUITextButton.GetHeight: Integer;
959 var
960 w, h: Word;
961 begin
962 FFont.GetTextSize(FText, w, h);
963 Result := h;
964 end;
966 function TGUITextButton.GetWidth: Integer;
967 var
968 w, h: Word;
969 begin
970 FFont.GetTextSize(FText, w, h);
971 Result := w;
972 end;
974 procedure TGUITextButton.OnMessage(var Msg: TMessage);
975 begin
976 if not FEnabled then Exit;
978 inherited;
980 case Msg.Msg of
981 WM_KEYDOWN:
982 case Msg.wParam of
983 IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK: Click();
984 end;
985 end;
986 end;
988 procedure TGUITextButton.Update;
989 begin
990 inherited;
991 end;
993 { TFont }
995 constructor TFont.Create(FontID: DWORD; FontType: TFontType);
996 begin
997 ID := FontID;
999 FScale := 1;
1000 FFontType := FontType;
1001 end;
1003 destructor TFont.Destroy;
1004 begin
1006 inherited;
1007 end;
1009 procedure TFont.Draw(X, Y: Integer; Text: string; R, G, B: Byte);
1010 begin
1011 if FFontType = TFontType.Character then e_CharFont_PrintEx(ID, X, Y, Text, _RGB(R, G, B), FScale)
1012 else e_TextureFontPrintEx(X, Y, Text, ID, R, G, B, FScale);
1013 end;
1015 procedure TFont.GetTextSize(Text: string; var w, h: Word);
1016 var
1017 cw, ch: Byte;
1018 begin
1019 if FFontType = TFontType.Character then e_CharFont_GetSize(ID, Text, w, h)
1020 else
1021 begin
1022 e_TextureFontGetSize(ID, cw, ch);
1023 w := cw*Length(Text);
1024 h := ch;
1025 end;
1027 w := Round(w*FScale);
1028 h := Round(h*FScale);
1029 end;
1031 { TGUIMainMenu }
1033 function TGUIMainMenu.AddButton(fProc: Pointer; Caption: string; ShowWindow: string = ''): TGUITextButton;
1034 var
1035 a, _x: Integer;
1036 h, hh: Word;
1037 lh: Word = 0;
1038 begin
1039 FIndex := 0;
1041 SetLength(FButtons, Length(FButtons)+1);
1042 FButtons[High(FButtons)] := TGUITextButton.Create(fProc, FFontID, Caption);
1043 FButtons[High(FButtons)].ShowWindow := ShowWindow;
1044 with FButtons[High(FButtons)] do
1045 begin
1046 if (fProc <> nil) or (ShowWindow <> '') then FColor := MAINMENU_ITEMS_COLOR
1047 else FColor := MAINMENU_UNACTIVEITEMS_COLOR;
1048 FSound := MAINMENU_CLICKSOUND;
1049 end;
1051 _x := gScreenWidth div 2;
1053 for a := 0 to High(FButtons) do
1054 if FButtons[a] <> nil then
1055 _x := Min(_x, (gScreenWidth div 2)-(FButtons[a].GetWidth div 2));
1057 if FLogo <> 0 then e_GetTextureSize(FLogo, nil, @lh);
1058 hh := FButtons[High(FButtons)].GetHeight;
1060 if FLogo <> 0 then h := lh + hh * (1 + Length(FButtons)) + MAINMENU_SPACE * (Length(FButtons) - 1)
1061 else h := hh * (2 + Length(FButtons)) + MAINMENU_SPACE * (Length(FButtons) - 1);
1062 h := (gScreenHeight div 2) - (h div 2);
1064 if FHeader <> nil then with FHeader do
1065 begin
1066 FX := _x;
1067 FY := h;
1068 end;
1070 if FLogo <> 0 then Inc(h, lh)
1071 else Inc(h, hh*2);
1073 for a := 0 to High(FButtons) do
1074 begin
1075 if FButtons[a] <> nil then
1076 with FButtons[a] do
1077 begin
1078 FX := _x;
1079 FY := h;
1080 end;
1082 Inc(h, hh+MAINMENU_SPACE);
1083 end;
1085 Result := FButtons[High(FButtons)];
1086 end;
1088 procedure TGUIMainMenu.AddSpace;
1089 begin
1090 SetLength(FButtons, Length(FButtons)+1);
1091 FButtons[High(FButtons)] := nil;
1092 end;
1094 constructor TGUIMainMenu.Create(FontID: DWORD; Logo, Header: string);
1095 begin
1096 inherited Create();
1098 FIndex := -1;
1099 FFontID := FontID;
1100 FCounter := MAINMENU_MARKERDELAY;
1102 g_Texture_Get(MAINMENU_MARKER1, FMarkerID1);
1103 g_Texture_Get(MAINMENU_MARKER2, FMarkerID2);
1105 if not g_Texture_Get(Logo, FLogo) then
1106 begin
1107 FHeader := TGUILabel.Create(Header, FFontID);
1108 with FHeader do
1109 begin
1110 FColor := MAINMENU_HEADER_COLOR;
1111 FX := (gScreenWidth div 2)-(GetWidth div 2);
1112 FY := (gScreenHeight div 2)-(GetHeight div 2);
1113 end;
1114 end;
1115 end;
1117 destructor TGUIMainMenu.Destroy;
1118 var
1119 a: Integer;
1120 begin
1121 if FButtons <> nil then
1122 for a := 0 to High(FButtons) do
1123 FButtons[a].Free();
1125 FHeader.Free();
1127 inherited;
1128 end;
1130 procedure TGUIMainMenu.Draw;
1131 var
1132 a: Integer;
1133 w, h: Word;
1135 begin
1136 inherited;
1138 if FHeader <> nil then FHeader.Draw
1139 else begin
1140 e_GetTextureSize(FLogo, @w, @h);
1141 e_Draw(FLogo, ((gScreenWidth div 2) - (w div 2)), FButtons[0].FY - FButtons[0].GetHeight - h, 0, True, False);
1142 end;
1144 if FButtons <> nil then
1145 begin
1146 for a := 0 to High(FButtons) do
1147 if FButtons[a] <> nil then FButtons[a].Draw;
1149 if FIndex <> -1 then
1150 e_Draw(FMarkerID1, FButtons[FIndex].FX-48, FButtons[FIndex].FY, 0, True, False);
1151 end;
1152 end;
1154 procedure TGUIMainMenu.EnableButton(aName: string; e: Boolean);
1155 var
1156 a: Integer;
1157 begin
1158 if FButtons = nil then Exit;
1160 for a := 0 to High(FButtons) do
1161 if (FButtons[a] <> nil) and (FButtons[a].Name = aName) then
1162 begin
1163 if e then FButtons[a].FColor := MAINMENU_ITEMS_COLOR
1164 else FButtons[a].FColor := MAINMENU_UNACTIVEITEMS_COLOR;
1165 FButtons[a].Enabled := e;
1166 Break;
1167 end;
1168 end;
1170 function TGUIMainMenu.GetButton(aName: string): TGUITextButton;
1171 var
1172 a: Integer;
1173 begin
1174 Result := nil;
1176 if FButtons = nil then Exit;
1178 for a := 0 to High(FButtons) do
1179 if (FButtons[a] <> nil) and (FButtons[a].Name = aName) then
1180 begin
1181 Result := FButtons[a];
1182 Break;
1183 end;
1184 end;
1186 procedure TGUIMainMenu.OnMessage(var Msg: TMessage);
1187 var
1188 ok: Boolean;
1189 a: Integer;
1190 begin
1191 if not FEnabled then Exit;
1193 inherited;
1195 if FButtons = nil then Exit;
1197 ok := False;
1198 for a := 0 to High(FButtons) do
1199 if FButtons[a] <> nil then
1200 begin
1201 ok := True;
1202 Break;
1203 end;
1205 if not ok then Exit;
1207 case Msg.Msg of
1208 WM_KEYDOWN:
1209 case Msg.wParam of
1210 IK_UP, IK_KPUP, VK_UP, JOY0_UP, JOY1_UP, JOY2_UP, JOY3_UP:
1211 begin
1212 repeat
1213 Dec(FIndex);
1214 if FIndex < 0 then FIndex := High(FButtons);
1215 until FButtons[FIndex] <> nil;
1217 g_Sound_PlayEx(MENU_CHANGESOUND);
1218 end;
1219 IK_DOWN, IK_KPDOWN, VK_DOWN, JOY0_DOWN, JOY1_DOWN, JOY2_DOWN, JOY3_DOWN:
1220 begin
1221 repeat
1222 Inc(FIndex);
1223 if FIndex > High(FButtons) then FIndex := 0;
1224 until FButtons[FIndex] <> nil;
1226 g_Sound_PlayEx(MENU_CHANGESOUND);
1227 end;
1228 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;
1229 end;
1230 end;
1231 end;
1233 procedure TGUIMainMenu.Update;
1234 var
1235 t: DWORD;
1236 begin
1237 inherited;
1239 if FCounter = 0 then
1240 begin
1241 t := FMarkerID1;
1242 FMarkerID1 := FMarkerID2;
1243 FMarkerID2 := t;
1245 FCounter := MAINMENU_MARKERDELAY;
1246 end else Dec(FCounter);
1247 end;
1249 { TGUILabel }
1251 constructor TGUILabel.Create(Text: string; FontID: DWORD);
1252 begin
1253 inherited Create();
1255 FFont := TFont.Create(FontID, TFontType.Character);
1257 FText := Text;
1258 FFixedLen := 0;
1259 FOnClickEvent := nil;
1260 end;
1262 procedure TGUILabel.Draw;
1263 var
1264 w, h: Word;
1265 begin
1266 if RightAlign then
1267 begin
1268 FFont.GetTextSize(FText, w, h);
1269 FFont.Draw(FX+FMaxWidth-w, FY, FText, FColor.R, FColor.G, FColor.B);
1270 end
1271 else
1272 begin
1273 FFont.Draw(FX, FY, FText, FColor.R, FColor.G, FColor.B);
1274 end;
1275 end;
1277 function TGUILabel.GetHeight: Integer;
1278 var
1279 w, h: Word;
1280 begin
1281 FFont.GetTextSize(FText, w, h);
1282 Result := h;
1283 end;
1285 function TGUILabel.GetWidth: Integer;
1286 var
1287 w, h: Word;
1288 begin
1289 if FFixedLen = 0 then
1290 FFont.GetTextSize(FText, w, h)
1291 else
1292 w := e_CharFont_GetMaxWidth(FFont.ID)*FFixedLen;
1293 Result := w;
1294 end;
1296 procedure TGUILabel.OnMessage(var Msg: TMessage);
1297 begin
1298 if not FEnabled then Exit;
1300 inherited;
1302 case Msg.Msg of
1303 WM_KEYDOWN:
1304 case Msg.wParam of
1305 IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK: if @FOnClickEvent <> nil then FOnClickEvent();
1306 end;
1307 end;
1308 end;
1310 { TGUIMenu }
1312 function TGUIMenu.AddButton(Proc: Pointer; fText: string; _ShowWindow: string = ''): TGUITextButton;
1313 var
1314 i: Integer;
1315 begin
1316 i := NewItem();
1317 with FItems[i] do
1318 begin
1319 Control := TGUITextButton.Create(Proc, FFontID, fText);
1320 with Control as TGUITextButton do
1321 begin
1322 ShowWindow := _ShowWindow;
1323 FColor := MENU_ITEMSCTRL_COLOR;
1324 end;
1326 Text := nil;
1327 ControlType := TGUITextButton;
1329 Result := (Control as TGUITextButton);
1330 end;
1332 if FIndex = -1 then FIndex := i;
1334 ReAlign();
1335 end;
1337 procedure TGUIMenu.AddLine(fText: string);
1338 var
1339 i: Integer;
1340 begin
1341 i := NewItem();
1342 with FItems[i] do
1343 begin
1344 Text := TGUILabel.Create(fText, FFontID);
1345 with Text do
1346 begin
1347 FColor := MENU_ITEMSTEXT_COLOR;
1348 end;
1350 Control := nil;
1351 end;
1353 ReAlign();
1354 end;
1356 procedure TGUIMenu.AddText(fText: string; MaxWidth: Word);
1357 var
1358 a, i: Integer;
1359 l: SSArray;
1360 begin
1361 l := GetLines(fText, FFontID, MaxWidth);
1363 if l = nil then Exit;
1365 for a := 0 to High(l) do
1366 begin
1367 i := NewItem();
1368 with FItems[i] do
1369 begin
1370 Text := TGUILabel.Create(l[a], FFontID);
1371 if FYesNo then
1372 begin
1373 with Text do begin FColor := _RGB(255, 0, 0); end;
1374 end
1375 else
1376 begin
1377 with Text do begin FColor := MENU_ITEMSTEXT_COLOR; end;
1378 end;
1380 Control := nil;
1381 end;
1382 end;
1384 ReAlign();
1385 end;
1387 procedure TGUIMenu.AddSpace;
1388 var
1389 i: Integer;
1390 begin
1391 i := NewItem();
1392 with FItems[i] do
1393 begin
1394 Text := nil;
1395 Control := nil;
1396 end;
1398 ReAlign();
1399 end;
1401 constructor TGUIMenu.Create(HeaderFont, ItemsFont: DWORD; Header: string);
1402 begin
1403 inherited Create();
1405 FItems := nil;
1406 FIndex := -1;
1407 FFontID := ItemsFont;
1408 FCounter := MENU_MARKERDELAY;
1409 FAlign := True;
1410 FYesNo := false;
1412 FHeader := TGUILabel.Create(Header, HeaderFont);
1413 with FHeader do
1414 begin
1415 FX := (gScreenWidth div 2)-(GetWidth div 2);
1416 FY := 0;
1417 FColor := MAINMENU_HEADER_COLOR;
1418 end;
1419 end;
1421 destructor TGUIMenu.Destroy;
1422 var
1423 a: Integer;
1424 begin
1425 if FItems <> nil then
1426 for a := 0 to High(FItems) do
1427 with FItems[a] do
1428 begin
1429 Text.Free();
1430 Control.Free();
1431 end;
1433 FItems := nil;
1435 FHeader.Free();
1437 inherited;
1438 end;
1440 procedure TGUIMenu.Draw;
1441 var
1442 a, locx, locy: Integer;
1443 begin
1444 inherited;
1446 if FHeader <> nil then FHeader.Draw;
1448 if FItems <> nil then
1449 for a := 0 to High(FItems) do
1450 begin
1451 if FItems[a].Text <> nil then FItems[a].Text.Draw;
1452 if FItems[a].Control <> nil then FItems[a].Control.Draw;
1453 end;
1455 if (FIndex <> -1) and (FCounter > MENU_MARKERDELAY div 2) then
1456 begin
1457 locx := 0;
1458 locy := 0;
1460 if FItems[FIndex].Text <> nil then
1461 begin
1462 locx := FItems[FIndex].Text.FX;
1463 locy := FItems[FIndex].Text.FY;
1464 //HACK!
1465 if FItems[FIndex].Text.RightAlign then
1466 begin
1467 locx := locx+FItems[FIndex].Text.FMaxWidth-FItems[FIndex].Text.GetWidth;
1468 end;
1469 end
1470 else if FItems[FIndex].Control <> nil then
1471 begin
1472 locx := FItems[FIndex].Control.FX;
1473 locy := FItems[FIndex].Control.FY;
1474 end;
1476 locx := locx-e_CharFont_GetMaxWidth(FFontID);
1478 e_CharFont_PrintEx(FFontID, locx, locy, #16, _RGB(255, 0, 0));
1479 end;
1480 end;
1482 function TGUIMenu.GetControl(aName: String): TGUIControl;
1483 var
1484 a: Integer;
1485 begin
1486 Result := nil;
1488 if FItems <> nil then
1489 for a := 0 to High(FItems) do
1490 if FItems[a].Control <> nil then
1491 if LowerCase(FItems[a].Control.Name) = LowerCase(aName) then
1492 begin
1493 Result := FItems[a].Control;
1494 Break;
1495 end;
1497 Assert(Result <> nil, 'GUI control "'+aName+'" not found!');
1498 end;
1500 function TGUIMenu.GetControlsText(aName: String): TGUILabel;
1501 var
1502 a: Integer;
1503 begin
1504 Result := nil;
1506 if FItems <> nil then
1507 for a := 0 to High(FItems) do
1508 if FItems[a].Control <> nil then
1509 if LowerCase(FItems[a].Control.Name) = LowerCase(aName) then
1510 begin
1511 Result := FItems[a].Text;
1512 Break;
1513 end;
1515 Assert(Result <> nil, 'GUI control''s text "'+aName+'" not found!');
1516 end;
1518 function TGUIMenu.NewItem: Integer;
1519 begin
1520 SetLength(FItems, Length(FItems)+1);
1521 Result := High(FItems);
1522 end;
1524 procedure TGUIMenu.OnMessage(var Msg: TMessage);
1525 var
1526 ok: Boolean;
1527 a, c: Integer;
1528 begin
1529 if not FEnabled then Exit;
1531 inherited;
1533 if FItems = nil then Exit;
1535 ok := False;
1536 for a := 0 to High(FItems) do
1537 if FItems[a].Control <> nil then
1538 begin
1539 ok := True;
1540 Break;
1541 end;
1543 if not ok then Exit;
1545 if (Msg.Msg = WM_KEYDOWN) and (FIndex <> -1) and (FItems[FIndex].Control <> nil) and
1546 (FItems[FIndex].Control.WantActivationKey(Msg.wParam)) then
1547 begin
1548 FItems[FIndex].Control.OnMessage(Msg);
1549 g_Sound_PlayEx(MENU_CLICKSOUND);
1550 exit;
1551 end;
1553 case Msg.Msg of
1554 WM_KEYDOWN:
1555 begin
1556 case Msg.wParam of
1557 IK_UP, IK_KPUP, VK_UP,JOY0_UP, JOY1_UP, JOY2_UP, JOY3_UP:
1558 begin
1559 c := 0;
1560 repeat
1561 c := c+1;
1562 if c > Length(FItems) then
1563 begin
1564 FIndex := -1;
1565 Break;
1566 end;
1568 Dec(FIndex);
1569 if FIndex < 0 then FIndex := High(FItems);
1570 until (FItems[FIndex].Control <> nil) and
1571 (FItems[FIndex].Control.Enabled);
1573 FCounter := 0;
1575 g_Sound_PlayEx(MENU_CHANGESOUND);
1576 end;
1578 IK_DOWN, IK_KPDOWN, VK_DOWN, JOY0_DOWN, JOY1_DOWN, JOY2_DOWN, JOY3_DOWN:
1579 begin
1580 c := 0;
1581 repeat
1582 c := c+1;
1583 if c > Length(FItems) then
1584 begin
1585 FIndex := -1;
1586 Break;
1587 end;
1589 Inc(FIndex);
1590 if FIndex > High(FItems) then FIndex := 0;
1591 until (FItems[FIndex].Control <> nil) and
1592 (FItems[FIndex].Control.Enabled);
1594 FCounter := 0;
1596 g_Sound_PlayEx(MENU_CHANGESOUND);
1597 end;
1599 IK_LEFT, IK_RIGHT, IK_KPLEFT, IK_KPRIGHT, VK_LEFT, VK_RIGHT,
1600 JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT,
1601 JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT:
1602 begin
1603 if FIndex <> -1 then
1604 if FItems[FIndex].Control <> nil then
1605 FItems[FIndex].Control.OnMessage(Msg);
1606 end;
1607 IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK:
1608 begin
1609 if FIndex <> -1 then
1610 begin
1611 if FItems[FIndex].Control <> nil then FItems[FIndex].Control.OnMessage(Msg);
1612 end;
1613 g_Sound_PlayEx(MENU_CLICKSOUND);
1614 end;
1615 // dirty hacks
1616 IK_Y:
1617 if FYesNo and (length(FItems) > 1) then
1618 begin
1619 Msg.wParam := IK_RETURN; // to register keypress
1620 FIndex := High(FItems)-1;
1621 if FItems[FIndex].Control <> nil then FItems[FIndex].Control.OnMessage(Msg);
1622 end;
1623 IK_N:
1624 if FYesNo and (length(FItems) > 1) then
1625 begin
1626 Msg.wParam := IK_RETURN; // to register keypress
1627 FIndex := High(FItems);
1628 if FItems[FIndex].Control <> nil then FItems[FIndex].Control.OnMessage(Msg);
1629 end;
1630 end;
1631 end;
1632 end;
1633 end;
1635 procedure TGUIMenu.ReAlign();
1636 var
1637 a, tx, cx, w, h: Integer;
1638 cww: array of Integer; // cached widths
1639 maxcww: Integer;
1640 begin
1641 if FItems = nil then Exit;
1643 SetLength(cww, length(FItems));
1644 maxcww := 0;
1645 for a := 0 to High(FItems) do
1646 begin
1647 if FItems[a].Text <> nil then
1648 begin
1649 cww[a] := FItems[a].Text.GetWidth;
1650 if maxcww < cww[a] then maxcww := cww[a];
1651 end;
1652 end;
1654 if not FAlign then
1655 begin
1656 tx := FLeft;
1657 end
1658 else
1659 begin
1660 tx := gScreenWidth;
1661 for a := 0 to High(FItems) do
1662 begin
1663 w := 0;
1664 if FItems[a].Text <> nil then w := FItems[a].Text.GetWidth;
1665 if FItems[a].Control <> nil then
1666 begin
1667 w := w+MENU_HSPACE;
1668 if FItems[a].ControlType = TGUILabel then w := w+(FItems[a].Control as TGUILabel).GetWidth
1669 else if FItems[a].ControlType = TGUITextButton then w := w+(FItems[a].Control as TGUITextButton).GetWidth
1670 else if FItems[a].ControlType = TGUIScroll then w := w+(FItems[a].Control as TGUIScroll).GetWidth
1671 else if FItems[a].ControlType = TGUISwitch then w := w+(FItems[a].Control as TGUISwitch).GetWidth
1672 else if FItems[a].ControlType = TGUIEdit then w := w+(FItems[a].Control as TGUIEdit).GetWidth
1673 else if FItems[a].ControlType = TGUIKeyRead then w := w+(FItems[a].Control as TGUIKeyRead).GetWidth
1674 else if FItems[a].ControlType = TGUIKeyRead2 then w := w+(FItems[a].Control as TGUIKeyRead2).GetWidth
1675 else if FItems[a].ControlType = TGUIListBox then w := w+(FItems[a].Control as TGUIListBox).GetWidth
1676 else if FItems[a].ControlType = TGUIFileListBox then w := w+(FItems[a].Control as TGUIFileListBox).GetWidth
1677 else if FItems[a].ControlType = TGUIMemo then w := w+(FItems[a].Control as TGUIMemo).GetWidth;
1678 end;
1679 tx := Min(tx, (gScreenWidth div 2)-(w div 2));
1680 end;
1681 end;
1683 cx := 0;
1684 for a := 0 to High(FItems) do
1685 begin
1686 with FItems[a] do
1687 begin
1688 if (Text <> nil) and (Control = nil) then Continue;
1689 w := 0;
1690 if Text <> nil then w := tx+Text.GetWidth;
1691 if w > cx then cx := w;
1692 end;
1693 end;
1695 cx := cx+MENU_HSPACE;
1697 h := FHeader.GetHeight*2+MENU_VSPACE*(Length(FItems)-1);
1699 for a := 0 to High(FItems) do
1700 begin
1701 with FItems[a] do
1702 begin
1703 if (ControlType = TGUIListBox) or (ControlType = TGUIFileListBox) then
1704 h := h+(FItems[a].Control as TGUIListBox).GetHeight()
1705 else
1706 h := h+e_CharFont_GetMaxHeight(FFontID);
1707 end;
1708 end;
1710 h := (gScreenHeight div 2)-(h div 2);
1712 with FHeader do
1713 begin
1714 FX := (gScreenWidth div 2)-(GetWidth div 2);
1715 FY := h;
1717 Inc(h, GetHeight*2);
1718 end;
1720 for a := 0 to High(FItems) do
1721 begin
1722 with FItems[a] do
1723 begin
1724 if Text <> nil then
1725 begin
1726 with Text do
1727 begin
1728 FX := tx;
1729 FY := h;
1730 end;
1731 //HACK!
1732 if Text.RightAlign and (length(cww) > a) then
1733 begin
1734 //Text.FX := Text.FX+maxcww;
1735 Text.FMaxWidth := maxcww;
1736 end;
1737 end;
1739 if Control <> nil then
1740 begin
1741 with Control do
1742 begin
1743 if Text <> nil then
1744 begin
1745 FX := cx;
1746 FY := h;
1747 end
1748 else
1749 begin
1750 FX := tx;
1751 FY := h;
1752 end;
1753 end;
1754 end;
1756 if (ControlType = TGUIListBox) or (ControlType = TGUIFileListBox) then Inc(h, (Control as TGUIListBox).GetHeight+MENU_VSPACE)
1757 else if ControlType = TGUIMemo then Inc(h, (Control as TGUIMemo).GetHeight+MENU_VSPACE)
1758 else Inc(h, e_CharFont_GetMaxHeight(FFontID)+MENU_VSPACE);
1759 end;
1760 end;
1762 // another ugly hack
1763 if FYesNo and (length(FItems) > 1) then
1764 begin
1765 w := -1;
1766 for a := High(FItems)-1 to High(FItems) do
1767 begin
1768 if (FItems[a].Control <> nil) and (FItems[a].ControlType = TGUITextButton) then
1769 begin
1770 cx := (FItems[a].Control as TGUITextButton).GetWidth;
1771 if cx > w then w := cx;
1772 end;
1773 end;
1774 if w > 0 then
1775 begin
1776 for a := High(FItems)-1 to High(FItems) do
1777 begin
1778 if (FItems[a].Control <> nil) and (FItems[a].ControlType = TGUITextButton) then
1779 begin
1780 FItems[a].Control.FX := (gScreenWidth-w) div 2;
1781 end;
1782 end;
1783 end;
1784 end;
1785 end;
1787 function TGUIMenu.AddScroll(fText: string): TGUIScroll;
1788 var
1789 i: Integer;
1790 begin
1791 i := NewItem();
1792 with FItems[i] do
1793 begin
1794 Control := TGUIScroll.Create();
1796 Text := TGUILabel.Create(fText, FFontID);
1797 with Text do
1798 begin
1799 FColor := MENU_ITEMSTEXT_COLOR;
1800 end;
1802 ControlType := TGUIScroll;
1804 Result := (Control as TGUIScroll);
1805 end;
1807 if FIndex = -1 then FIndex := i;
1809 ReAlign();
1810 end;
1812 function TGUIMenu.AddSwitch(fText: string): TGUISwitch;
1813 var
1814 i: Integer;
1815 begin
1816 i := NewItem();
1817 with FItems[i] do
1818 begin
1819 Control := TGUISwitch.Create(FFontID);
1820 (Control as TGUISwitch).FColor := MENU_ITEMSCTRL_COLOR;
1822 Text := TGUILabel.Create(fText, FFontID);
1823 with Text do
1824 begin
1825 FColor := MENU_ITEMSTEXT_COLOR;
1826 end;
1828 ControlType := TGUISwitch;
1830 Result := (Control as TGUISwitch);
1831 end;
1833 if FIndex = -1 then FIndex := i;
1835 ReAlign();
1836 end;
1838 function TGUIMenu.AddEdit(fText: string): TGUIEdit;
1839 var
1840 i: Integer;
1841 begin
1842 i := NewItem();
1843 with FItems[i] do
1844 begin
1845 Control := TGUIEdit.Create(FFontID);
1846 with Control as TGUIEdit do
1847 begin
1848 FWindow := Self.FWindow;
1849 FColor := MENU_ITEMSCTRL_COLOR;
1850 end;
1852 if fText = '' then Text := nil else
1853 begin
1854 Text := TGUILabel.Create(fText, FFontID);
1855 Text.FColor := MENU_ITEMSTEXT_COLOR;
1856 end;
1858 ControlType := TGUIEdit;
1860 Result := (Control as TGUIEdit);
1861 end;
1863 if FIndex = -1 then FIndex := i;
1865 ReAlign();
1866 end;
1868 procedure TGUIMenu.Update;
1869 var
1870 a: Integer;
1871 begin
1872 inherited;
1874 if FCounter = 0 then FCounter := MENU_MARKERDELAY else Dec(FCounter);
1876 if FItems <> nil then
1877 for a := 0 to High(FItems) do
1878 if FItems[a].Control <> nil then
1879 (FItems[a].Control as FItems[a].ControlType).Update;
1880 end;
1882 function TGUIMenu.AddKeyRead(fText: string): TGUIKeyRead;
1883 var
1884 i: Integer;
1885 begin
1886 i := NewItem();
1887 with FItems[i] do
1888 begin
1889 Control := TGUIKeyRead.Create(FFontID);
1890 with Control as TGUIKeyRead do
1891 begin
1892 FWindow := Self.FWindow;
1893 FColor := MENU_ITEMSCTRL_COLOR;
1894 end;
1896 Text := TGUILabel.Create(fText, FFontID);
1897 with Text do
1898 begin
1899 FColor := MENU_ITEMSTEXT_COLOR;
1900 end;
1902 ControlType := TGUIKeyRead;
1904 Result := (Control as TGUIKeyRead);
1905 end;
1907 if FIndex = -1 then FIndex := i;
1909 ReAlign();
1910 end;
1912 function TGUIMenu.AddKeyRead2(fText: string): TGUIKeyRead2;
1913 var
1914 i: Integer;
1915 begin
1916 i := NewItem();
1917 with FItems[i] do
1918 begin
1919 Control := TGUIKeyRead2.Create(FFontID);
1920 with Control as TGUIKeyRead2 do
1921 begin
1922 FWindow := Self.FWindow;
1923 FColor := MENU_ITEMSCTRL_COLOR;
1924 end;
1926 Text := TGUILabel.Create(fText, FFontID);
1927 with Text do
1928 begin
1929 FColor := MENU_ITEMSCTRL_COLOR; //MENU_ITEMSTEXT_COLOR;
1930 RightAlign := true;
1931 end;
1933 ControlType := TGUIKeyRead2;
1935 Result := (Control as TGUIKeyRead2);
1936 end;
1938 if FIndex = -1 then FIndex := i;
1940 ReAlign();
1941 end;
1943 function TGUIMenu.AddList(fText: string; Width, Height: Word): TGUIListBox;
1944 var
1945 i: Integer;
1946 begin
1947 i := NewItem();
1948 with FItems[i] do
1949 begin
1950 Control := TGUIListBox.Create(FFontID, Width, Height);
1951 with Control as TGUIListBox do
1952 begin
1953 FWindow := Self.FWindow;
1954 FActiveColor := MENU_ITEMSCTRL_COLOR;
1955 FUnActiveColor := MENU_ITEMSTEXT_COLOR;
1956 end;
1958 Text := TGUILabel.Create(fText, FFontID);
1959 with Text do
1960 begin
1961 FColor := MENU_ITEMSTEXT_COLOR;
1962 end;
1964 ControlType := TGUIListBox;
1966 Result := (Control as TGUIListBox);
1967 end;
1969 if FIndex = -1 then FIndex := i;
1971 ReAlign();
1972 end;
1974 function TGUIMenu.AddFileList(fText: string; Width, Height: Word): TGUIFileListBox;
1975 var
1976 i: Integer;
1977 begin
1978 i := NewItem();
1979 with FItems[i] do
1980 begin
1981 Control := TGUIFileListBox.Create(FFontID, Width, Height);
1982 with Control as TGUIFileListBox do
1983 begin
1984 FWindow := Self.FWindow;
1985 FActiveColor := MENU_ITEMSCTRL_COLOR;
1986 FUnActiveColor := MENU_ITEMSTEXT_COLOR;
1987 end;
1989 if fText = '' then Text := nil else
1990 begin
1991 Text := TGUILabel.Create(fText, FFontID);
1992 Text.FColor := MENU_ITEMSTEXT_COLOR;
1993 end;
1995 ControlType := TGUIFileListBox;
1997 Result := (Control as TGUIFileListBox);
1998 end;
2000 if FIndex = -1 then FIndex := i;
2002 ReAlign();
2003 end;
2005 function TGUIMenu.AddLabel(fText: string): TGUILabel;
2006 var
2007 i: Integer;
2008 begin
2009 i := NewItem();
2010 with FItems[i] do
2011 begin
2012 Control := TGUILabel.Create('', FFontID);
2013 with Control as TGUILabel do
2014 begin
2015 FWindow := Self.FWindow;
2016 FColor := MENU_ITEMSCTRL_COLOR;
2017 end;
2019 Text := TGUILabel.Create(fText, FFontID);
2020 with Text do
2021 begin
2022 FColor := MENU_ITEMSTEXT_COLOR;
2023 end;
2025 ControlType := TGUILabel;
2027 Result := (Control as TGUILabel);
2028 end;
2030 if FIndex = -1 then FIndex := i;
2032 ReAlign();
2033 end;
2035 function TGUIMenu.AddMemo(fText: string; Width, Height: Word): TGUIMemo;
2036 var
2037 i: Integer;
2038 begin
2039 i := NewItem();
2040 with FItems[i] do
2041 begin
2042 Control := TGUIMemo.Create(FFontID, Width, Height);
2043 with Control as TGUIMemo do
2044 begin
2045 FWindow := Self.FWindow;
2046 FColor := MENU_ITEMSTEXT_COLOR;
2047 end;
2049 if fText = '' then Text := nil else
2050 begin
2051 Text := TGUILabel.Create(fText, FFontID);
2052 Text.FColor := MENU_ITEMSTEXT_COLOR;
2053 end;
2055 ControlType := TGUIMemo;
2057 Result := (Control as TGUIMemo);
2058 end;
2060 if FIndex = -1 then FIndex := i;
2062 ReAlign();
2063 end;
2065 procedure TGUIMenu.UpdateIndex();
2066 var
2067 res: Boolean;
2068 begin
2069 res := True;
2071 while res do
2072 begin
2073 if (FIndex < 0) or (FIndex > High(FItems)) then
2074 begin
2075 FIndex := -1;
2076 res := False;
2077 end
2078 else
2079 if FItems[FIndex].Control.Enabled then
2080 res := False
2081 else
2082 Inc(FIndex);
2083 end;
2084 end;
2086 { TGUIScroll }
2088 constructor TGUIScroll.Create;
2089 begin
2090 inherited Create();
2092 FMax := 0;
2093 FOnChangeEvent := nil;
2095 g_Texture_Get(SCROLL_LEFT, FLeftID);
2096 g_Texture_Get(SCROLL_RIGHT, FRightID);
2097 g_Texture_Get(SCROLL_MIDDLE, FMiddleID);
2098 g_Texture_Get(SCROLL_MARKER, FMarkerID);
2099 end;
2101 procedure TGUIScroll.Draw;
2102 var
2103 a: Integer;
2104 begin
2105 inherited;
2107 e_Draw(FLeftID, FX, FY, 0, True, False);
2108 e_Draw(FRightID, FX+8+(FMax+1)*8, FY, 0, True, False);
2110 for a := 0 to FMax do
2111 e_Draw(FMiddleID, FX+8+a*8, FY, 0, True, False);
2113 e_Draw(FMarkerID, FX+8+FValue*8, FY, 0, True, False);
2114 end;
2116 procedure TGUIScroll.FSetValue(a: Integer);
2117 begin
2118 if a > FMax then FValue := FMax else FValue := a;
2119 end;
2121 function TGUIScroll.GetWidth: Integer;
2122 begin
2123 Result := 16+(FMax+1)*8;
2124 end;
2126 procedure TGUIScroll.OnMessage(var Msg: TMessage);
2127 begin
2128 if not FEnabled then Exit;
2130 inherited;
2132 case Msg.Msg of
2133 WM_KEYDOWN:
2134 begin
2135 case Msg.wParam of
2136 IK_LEFT, IK_KPLEFT, VK_LEFT, JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT:
2137 if FValue > 0 then
2138 begin
2139 Dec(FValue);
2140 g_Sound_PlayEx(SCROLL_SUBSOUND);
2141 if @FOnChangeEvent <> nil then FOnChangeEvent(Self);
2142 end;
2143 IK_RIGHT, IK_KPRIGHT, VK_RIGHT, JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT:
2144 if FValue < FMax then
2145 begin
2146 Inc(FValue);
2147 g_Sound_PlayEx(SCROLL_ADDSOUND);
2148 if @FOnChangeEvent <> nil then FOnChangeEvent(Self);
2149 end;
2150 end;
2151 end;
2152 end;
2153 end;
2155 procedure TGUIScroll.Update;
2156 begin
2157 inherited;
2159 end;
2161 { TGUISwitch }
2163 procedure TGUISwitch.AddItem(Item: string);
2164 begin
2165 SetLength(FItems, Length(FItems)+1);
2166 FItems[High(FItems)] := Item;
2168 if FIndex = -1 then FIndex := 0;
2169 end;
2171 constructor TGUISwitch.Create(FontID: DWORD);
2172 begin
2173 inherited Create();
2175 FIndex := -1;
2177 FFont := TFont.Create(FontID, TFontType.Character);
2178 end;
2180 procedure TGUISwitch.Draw;
2181 begin
2182 inherited;
2184 FFont.Draw(FX, FY, FItems[FIndex], FColor.R, FColor.G, FColor.B);
2185 end;
2187 function TGUISwitch.GetText: string;
2188 begin
2189 if FIndex <> -1 then Result := FItems[FIndex]
2190 else Result := '';
2191 end;
2193 function TGUISwitch.GetWidth: Integer;
2194 var
2195 a: Integer;
2196 w, h: Word;
2197 begin
2198 Result := 0;
2200 if FItems = nil then Exit;
2202 for a := 0 to High(FItems) do
2203 begin
2204 FFont.GetTextSize(FItems[a], w, h);
2205 if w > Result then Result := w;
2206 end;
2207 end;
2209 procedure TGUISwitch.OnMessage(var Msg: TMessage);
2210 begin
2211 if not FEnabled then Exit;
2213 inherited;
2215 if FItems = nil then Exit;
2217 case Msg.Msg of
2218 WM_KEYDOWN:
2219 case Msg.wParam of
2220 IK_RETURN, IK_RIGHT, IK_KPRETURN, IK_KPRIGHT, VK_FIRE, VK_OPEN, VK_RIGHT,
2221 JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT,
2222 JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK:
2223 begin
2224 if FIndex < High(FItems) then
2225 Inc(FIndex)
2226 else
2227 FIndex := 0;
2229 g_Sound_PlayEx(SCROLL_ADDSOUND);
2231 if @FOnChangeEvent <> nil then
2232 FOnChangeEvent(Self);
2233 end;
2235 IK_LEFT, IK_KPLEFT, VK_LEFT,
2236 JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT:
2237 begin
2238 if FIndex > 0 then
2239 Dec(FIndex)
2240 else
2241 FIndex := High(FItems);
2243 g_Sound_PlayEx(SCROLL_SUBSOUND);
2245 if @FOnChangeEvent <> nil then
2246 FOnChangeEvent(Self);
2247 end;
2248 end;
2249 end;
2250 end;
2252 procedure TGUISwitch.Update;
2253 begin
2254 inherited;
2256 end;
2258 { TGUIEdit }
2260 constructor TGUIEdit.Create(FontID: DWORD);
2261 begin
2262 inherited Create();
2264 FFont := TFont.Create(FontID, TFontType.Character);
2266 FMaxLength := 0;
2267 FWidth := 0;
2268 FInvalid := false;
2270 g_Texture_Get(EDIT_LEFT, FLeftID);
2271 g_Texture_Get(EDIT_RIGHT, FRightID);
2272 g_Texture_Get(EDIT_MIDDLE, FMiddleID);
2273 end;
2275 procedure TGUIEdit.Draw;
2276 var
2277 c, w, h: Word;
2278 r, g, b: Byte;
2279 begin
2280 inherited;
2282 e_Draw(FLeftID, FX, FY, 0, True, False);
2283 e_Draw(FRightID, FX+8+FWidth*16, FY, 0, True, False);
2285 for c := 0 to FWidth-1 do
2286 e_Draw(FMiddleID, FX+8+c*16, FY, 0, True, False);
2288 r := FColor.R;
2289 g := FColor.G;
2290 b := FColor.B;
2291 if FInvalid and (FWindow.FActiveControl <> self) then begin r := 128; g := 128; b := 128; end;
2292 FFont.Draw(FX+8, FY, FText, r, g, b);
2294 if (FWindow.FActiveControl = self) then
2295 begin
2296 FFont.GetTextSize(Copy(FText, 1, FCaretPos), w, h);
2297 h := e_CharFont_GetMaxHeight(FFont.ID);
2298 e_DrawLine(2, FX+8+w, FY+h-3, FX+8+w+EDIT_CURSORLEN, FY+h-3,
2299 EDIT_CURSORCOLOR.R, EDIT_CURSORCOLOR.G, EDIT_CURSORCOLOR.B);
2300 end;
2301 end;
2303 function TGUIEdit.GetWidth: Integer;
2304 begin
2305 Result := 16+FWidth*16;
2306 end;
2308 procedure TGUIEdit.OnMessage(var Msg: TMessage);
2309 begin
2310 if not FEnabled then Exit;
2312 inherited;
2314 with Msg do
2315 case Msg of
2316 WM_CHAR:
2317 if FOnlyDigits then
2318 begin
2319 if (wParam in [48..57]) and (Chr(wParam) <> '`') then
2320 if Length(Text) < FMaxLength then
2321 begin
2322 Insert(Chr(wParam), FText, FCaretPos + 1);
2323 Inc(FCaretPos);
2324 end;
2325 end
2326 else
2327 begin
2328 if (wParam in [32..255]) and (Chr(wParam) <> '`') then
2329 if Length(Text) < FMaxLength then
2330 begin
2331 Insert(Chr(wParam), FText, FCaretPos + 1);
2332 Inc(FCaretPos);
2333 end;
2334 end;
2335 WM_KEYDOWN:
2336 case wParam of
2337 IK_BACKSPACE:
2338 begin
2339 Delete(FText, FCaretPos, 1);
2340 if FCaretPos > 0 then Dec(FCaretPos);
2341 end;
2342 IK_DELETE: Delete(FText, FCaretPos + 1, 1);
2343 IK_END, IK_KPEND: FCaretPos := Length(FText);
2344 IK_HOME, IK_KPHOME: FCaretPos := 0;
2345 IK_LEFT, IK_KPLEFT, VK_LEFT, JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT: if FCaretPos > 0 then Dec(FCaretPos);
2346 IK_RIGHT, IK_KPRIGHT, VK_RIGHT, JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT: if FCaretPos < Length(FText) then Inc(FCaretPos);
2347 IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK:
2348 with FWindow do
2349 begin
2350 if FActiveControl <> Self then
2351 begin
2352 SetActive(Self);
2353 if @FOnEnterEvent <> nil then FOnEnterEvent(Self);
2354 end
2355 else
2356 begin
2357 if FDefControl <> '' then SetActive(GetControl(FDefControl))
2358 else SetActive(nil);
2359 if @FOnChangeEvent <> nil then FOnChangeEvent(Self);
2360 end;
2361 end;
2362 end;
2363 end;
2365 g_GUIGrabInput := (@FOnEnterEvent = nil) and (FWindow.FActiveControl = Self);
2366 g_Touch_ShowKeyboard(g_GUIGrabInput)
2367 end;
2369 procedure TGUIEdit.SetText(Text: string);
2370 begin
2371 if Length(Text) > FMaxLength then SetLength(Text, FMaxLength);
2372 FText := Text;
2373 FCaretPos := Length(FText);
2374 end;
2376 procedure TGUIEdit.Update;
2377 begin
2378 inherited;
2379 end;
2381 { TGUIKeyRead }
2383 constructor TGUIKeyRead.Create(FontID: DWORD);
2384 begin
2385 inherited Create();
2386 FKey := 0;
2387 FIsQuery := false;
2389 FFont := TFont.Create(FontID, TFontType.Character);
2390 end;
2392 procedure TGUIKeyRead.Draw;
2393 begin
2394 inherited;
2396 FFont.Draw(FX, FY, IfThen(FIsQuery, KEYREAD_QUERY, IfThen(FKey <> 0, e_KeyNames[FKey], KEYREAD_CLEAR)),
2397 FColor.R, FColor.G, FColor.B);
2398 end;
2400 function TGUIKeyRead.GetWidth: Integer;
2401 var
2402 a: Byte;
2403 w, h: Word;
2404 begin
2405 Result := 0;
2407 for a := 0 to 255 do
2408 begin
2409 FFont.GetTextSize(e_KeyNames[a], w, h);
2410 Result := Max(Result, w);
2411 end;
2413 FFont.GetTextSize(KEYREAD_QUERY, w, h);
2414 if w > Result then Result := w;
2416 FFont.GetTextSize(KEYREAD_CLEAR, w, h);
2417 if w > Result then Result := w;
2418 end;
2420 function TGUIKeyRead.WantActivationKey (key: LongInt): Boolean;
2421 begin
2422 result :=
2423 (key = IK_BACKSPACE) or
2424 false; // oops
2425 end;
2427 procedure TGUIKeyRead.OnMessage(var Msg: TMessage);
2428 procedure actDefCtl ();
2429 begin
2430 with FWindow do
2431 if FDefControl <> '' then
2432 SetActive(GetControl(FDefControl))
2433 else
2434 SetActive(nil);
2435 end;
2437 begin
2438 inherited;
2440 if not FEnabled then
2441 Exit;
2443 with Msg do
2444 case Msg of
2445 WM_KEYDOWN:
2446 if not FIsQuery then
2447 begin
2448 case wParam of
2449 IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK:
2450 begin
2451 with FWindow do
2452 if FActiveControl <> Self then
2453 SetActive(Self);
2454 FIsQuery := True;
2455 end;
2456 IK_BACKSPACE: // clear keybinding if we aren't waiting for a key
2457 begin
2458 FKey := 0;
2459 actDefCtl();
2460 end;
2461 else
2462 FIsQuery := False;
2463 actDefCtl();
2464 end;
2465 end
2466 else
2467 begin
2468 case wParam of
2469 VK_FIRSTKEY..VK_LASTKEY: // do not allow to bind virtual keys
2470 begin
2471 FIsQuery := False;
2472 actDefCtl();
2473 end;
2474 else
2475 if (e_KeyNames[wParam] <> '') and not g_Console_MatchBind(wParam, 'togglemenu') then
2476 FKey := wParam;
2477 FIsQuery := False;
2478 actDefCtl();
2479 end
2480 end;
2481 end;
2483 g_GUIGrabInput := FIsQuery
2484 end;
2486 { TGUIKeyRead2 }
2488 constructor TGUIKeyRead2.Create(FontID: DWORD);
2489 var
2490 a: Byte;
2491 w, h: Word;
2492 begin
2493 inherited Create();
2495 FKey0 := 0;
2496 FKey1 := 0;
2497 FKeyIdx := 0;
2498 FIsQuery := False;
2500 FFontID := FontID;
2501 FFont := TFont.Create(FontID, TFontType.Character);
2503 FMaxKeyNameWdt := 0;
2504 for a := 0 to 255 do
2505 begin
2506 FFont.GetTextSize(e_KeyNames[a], w, h);
2507 FMaxKeyNameWdt := Max(FMaxKeyNameWdt, w);
2508 end;
2510 FMaxKeyNameWdt := FMaxKeyNameWdt-(FMaxKeyNameWdt div 3);
2512 FFont.GetTextSize(KEYREAD_QUERY, w, h);
2513 if w > FMaxKeyNameWdt then FMaxKeyNameWdt := w;
2515 FFont.GetTextSize(KEYREAD_CLEAR, w, h);
2516 if w > FMaxKeyNameWdt then FMaxKeyNameWdt := w;
2517 end;
2519 procedure TGUIKeyRead2.Draw;
2520 procedure drawText (idx: Integer);
2521 var
2522 x, y: Integer;
2523 r, g, b: Byte;
2524 kk: DWORD;
2525 begin
2526 if idx = 0 then kk := FKey0 else kk := FKey1;
2527 y := FY;
2528 if idx = 0 then x := FX+8 else x := FX+8+FMaxKeyNameWdt+16;
2529 r := 255;
2530 g := 0;
2531 b := 0;
2532 if FKeyIdx = idx then begin r := 255; g := 255; b := 255; end;
2533 if FIsQuery and (FKeyIdx = idx) then
2534 FFont.Draw(x, y, KEYREAD_QUERY, r, g, b)
2535 else
2536 FFont.Draw(x, y, IfThen(kk <> 0, e_KeyNames[kk], KEYREAD_CLEAR), r, g, b);
2537 end;
2539 begin
2540 inherited;
2542 //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);
2543 //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);
2544 drawText(0);
2545 drawText(1);
2546 end;
2548 function TGUIKeyRead2.GetWidth: Integer;
2549 begin
2550 Result := FMaxKeyNameWdt*2+8+8+16;
2551 end;
2553 function TGUIKeyRead2.WantActivationKey (key: LongInt): Boolean;
2554 begin
2555 case key of
2556 IK_BACKSPACE, IK_LEFT, IK_RIGHT, IK_KPLEFT, IK_KPRIGHT, VK_LEFT, VK_RIGHT,
2557 JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT,
2558 JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT:
2559 result := True
2560 else
2561 result := False
2562 end
2563 end;
2565 procedure TGUIKeyRead2.OnMessage(var Msg: TMessage);
2566 procedure actDefCtl ();
2567 begin
2568 with FWindow do
2569 if FDefControl <> '' then
2570 SetActive(GetControl(FDefControl))
2571 else
2572 SetActive(nil);
2573 end;
2575 begin
2576 inherited;
2578 if not FEnabled then
2579 Exit;
2581 with Msg do
2582 case Msg of
2583 WM_KEYDOWN:
2584 if not FIsQuery then
2585 begin
2586 case wParam of
2587 IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK:
2588 begin
2589 with FWindow do
2590 if FActiveControl <> Self then
2591 SetActive(Self);
2592 FIsQuery := True;
2593 end;
2594 IK_BACKSPACE: // clear keybinding if we aren't waiting for a key
2595 begin
2596 if (FKeyIdx = 0) then FKey0 := 0 else FKey1 := 0;
2597 actDefCtl();
2598 end;
2599 IK_LEFT, IK_KPLEFT, VK_LEFT, JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT:
2600 begin
2601 FKeyIdx := 0;
2602 actDefCtl();
2603 end;
2604 IK_RIGHT, IK_KPRIGHT, VK_RIGHT, JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT:
2605 begin
2606 FKeyIdx := 1;
2607 actDefCtl();
2608 end;
2609 else
2610 FIsQuery := False;
2611 actDefCtl();
2612 end;
2613 end
2614 else
2615 begin
2616 case wParam of
2617 VK_FIRSTKEY..VK_LASTKEY: // do not allow to bind virtual keys
2618 begin
2619 FIsQuery := False;
2620 actDefCtl();
2621 end;
2622 else
2623 if (e_KeyNames[wParam] <> '') and not g_Console_MatchBind(wParam, 'togglemenu') then
2624 begin
2625 if (FKeyIdx = 0) then FKey0 := wParam else FKey1 := wParam;
2626 end;
2627 FIsQuery := False;
2628 actDefCtl()
2629 end
2630 end;
2631 end;
2633 g_GUIGrabInput := FIsQuery
2634 end;
2637 { TGUIModelView }
2639 constructor TGUIModelView.Create;
2640 begin
2641 inherited Create();
2643 FModel := nil;
2644 end;
2646 destructor TGUIModelView.Destroy;
2647 begin
2648 FModel.Free();
2650 inherited;
2651 end;
2653 procedure TGUIModelView.Draw;
2654 begin
2655 inherited;
2657 DrawBox(FX, FY, 4, 4);
2659 if FModel <> nil then FModel.Draw(FX+4, FY+4);
2660 end;
2662 procedure TGUIModelView.NextAnim();
2663 begin
2664 if FModel = nil then
2665 Exit;
2667 if FModel.Animation < A_PAIN then
2668 FModel.ChangeAnimation(FModel.Animation+1, True)
2669 else
2670 FModel.ChangeAnimation(A_STAND, True);
2671 end;
2673 procedure TGUIModelView.NextWeapon();
2674 begin
2675 if FModel = nil then
2676 Exit;
2678 if FModel.Weapon < WP_LAST
2679 then FModel.SetWeapon(FModel.Weapon+1)
2680 else FModel.SetWeapon(WEAPON_IRONFIST);
2681 end;
2683 procedure TGUIModelView.OnMessage(var Msg: TMessage);
2684 begin
2685 inherited;
2687 end;
2689 procedure TGUIModelView.SetColor(Red, Green, Blue: Byte);
2690 begin
2691 if FModel <> nil then FModel.SetColor(Red, Green, Blue);
2692 end;
2694 procedure TGUIModelView.SetModel(ModelName: string);
2695 begin
2696 FModel.Free();
2698 FModel := g_PlayerModel_Get(ModelName);
2699 end;
2701 procedure TGUIModelView.Update;
2702 begin
2703 inherited;
2705 a := not a;
2706 if a then Exit;
2708 if FModel <> nil then FModel.Update;
2709 end;
2711 { TGUIMapPreview }
2713 constructor TGUIMapPreview.Create();
2714 begin
2715 inherited Create();
2716 ClearMap;
2717 end;
2719 destructor TGUIMapPreview.Destroy();
2720 begin
2721 ClearMap;
2722 inherited;
2723 end;
2725 procedure TGUIMapPreview.Draw();
2726 var
2727 a: Integer;
2728 r, g, b: Byte;
2729 begin
2730 inherited;
2732 DrawBox(FX, FY, MAPPREVIEW_WIDTH, MAPPREVIEW_HEIGHT);
2734 if (FMapSize.X <= 0) or (FMapSize.Y <= 0) then
2735 Exit;
2737 e_DrawFillQuad(FX+4, FY+4,
2738 FX+4 + Trunc(FMapSize.X / FScale) - 1,
2739 FY+4 + Trunc(FMapSize.Y / FScale) - 1,
2740 32, 32, 32, 0);
2742 if FMapData <> nil then
2743 for a := 0 to High(FMapData) do
2744 with FMapData[a] do
2745 begin
2746 if X1 > MAPPREVIEW_WIDTH*16 then Continue;
2747 if Y1 > MAPPREVIEW_HEIGHT*16 then Continue;
2749 if X2 < 0 then Continue;
2750 if Y2 < 0 then Continue;
2752 if X2 > MAPPREVIEW_WIDTH*16 then X2 := MAPPREVIEW_WIDTH*16;
2753 if Y2 > MAPPREVIEW_HEIGHT*16 then Y2 := MAPPREVIEW_HEIGHT*16;
2755 if X1 < 0 then X1 := 0;
2756 if Y1 < 0 then Y1 := 0;
2758 case PanelType of
2759 PANEL_WALL:
2760 begin
2761 r := 255;
2762 g := 255;
2763 b := 255;
2764 end;
2765 PANEL_CLOSEDOOR:
2766 begin
2767 r := 255;
2768 g := 255;
2769 b := 0;
2770 end;
2771 PANEL_WATER:
2772 begin
2773 r := 0;
2774 g := 0;
2775 b := 192;
2776 end;
2777 PANEL_ACID1:
2778 begin
2779 r := 0;
2780 g := 176;
2781 b := 0;
2782 end;
2783 PANEL_ACID2:
2784 begin
2785 r := 176;
2786 g := 0;
2787 b := 0;
2788 end;
2789 else
2790 begin
2791 r := 128;
2792 g := 128;
2793 b := 128;
2794 end;
2795 end;
2797 if ((X2-X1) > 0) and ((Y2-Y1) > 0) then
2798 e_DrawFillQuad(FX+4 + X1, FY+4 + Y1,
2799 FX+4 + X2 - 1, FY+4 + Y2 - 1, r, g, b, 0);
2800 end;
2801 end;
2803 procedure TGUIMapPreview.OnMessage(var Msg: TMessage);
2804 begin
2805 inherited;
2807 end;
2809 procedure TGUIMapPreview.SetMap(Res: string);
2810 var
2811 WAD: TWADFile;
2812 panlist: TDynField;
2813 pan: TDynRecord;
2814 //header: TMapHeaderRec_1;
2815 FileName: string;
2816 Data: Pointer;
2817 Len: Integer;
2818 rX, rY: Single;
2819 map: TDynRecord = nil;
2820 begin
2821 FMapSize.X := 0;
2822 FMapSize.Y := 0;
2823 FScale := 0.0;
2824 FMapData := nil;
2826 FileName := g_ExtractWadName(Res);
2828 WAD := TWADFile.Create();
2829 if not WAD.ReadFile(FileName) then
2830 begin
2831 WAD.Free();
2832 Exit;
2833 end;
2835 //k8: ignores path again
2836 if not WAD.GetMapResource(g_ExtractFileName(Res), Data, Len) then
2837 begin
2838 WAD.Free();
2839 Exit;
2840 end;
2842 WAD.Free();
2844 try
2845 map := g_Map_ParseMap(Data, Len);
2846 except
2847 FreeMem(Data);
2848 map.Free();
2849 //raise;
2850 exit;
2851 end;
2853 FreeMem(Data);
2855 if (map = nil) then exit;
2857 try
2858 panlist := map.field['panel'];
2859 //header := GetMapHeader(map);
2861 FMapSize.X := map.Width div 16;
2862 FMapSize.Y := map.Height div 16;
2864 rX := Ceil(map.Width / (MAPPREVIEW_WIDTH*256.0));
2865 rY := Ceil(map.Height / (MAPPREVIEW_HEIGHT*256.0));
2866 FScale := max(rX, rY);
2868 FMapData := nil;
2870 if (panlist <> nil) then
2871 begin
2872 for pan in panlist do
2873 begin
2874 if (pan.PanelType and (PANEL_WALL or PANEL_CLOSEDOOR or
2875 PANEL_STEP or PANEL_WATER or
2876 PANEL_ACID1 or PANEL_ACID2)) <> 0 then
2877 begin
2878 SetLength(FMapData, Length(FMapData)+1);
2879 with FMapData[High(FMapData)] do
2880 begin
2881 X1 := pan.X div 16;
2882 Y1 := pan.Y div 16;
2884 X2 := (pan.X + pan.Width) div 16;
2885 Y2 := (pan.Y + pan.Height) div 16;
2887 X1 := Trunc(X1/FScale + 0.5);
2888 Y1 := Trunc(Y1/FScale + 0.5);
2889 X2 := Trunc(X2/FScale + 0.5);
2890 Y2 := Trunc(Y2/FScale + 0.5);
2892 if (X1 <> X2) or (Y1 <> Y2) then
2893 begin
2894 if X1 = X2 then
2895 X2 := X2 + 1;
2896 if Y1 = Y2 then
2897 Y2 := Y2 + 1;
2898 end;
2900 PanelType := pan.PanelType;
2901 end;
2902 end;
2903 end;
2904 end;
2905 finally
2906 //writeln('freeing map');
2907 map.Free();
2908 end;
2909 end;
2911 procedure TGUIMapPreview.ClearMap();
2912 begin
2913 SetLength(FMapData, 0);
2914 FMapData := nil;
2915 FMapSize.X := 0;
2916 FMapSize.Y := 0;
2917 FScale := 0.0;
2918 end;
2920 procedure TGUIMapPreview.Update();
2921 begin
2922 inherited;
2924 end;
2926 function TGUIMapPreview.GetScaleStr(): String;
2927 begin
2928 if FScale > 0.0 then
2929 begin
2930 Result := FloatToStrF(FScale*16.0, ffFixed, 3, 3);
2931 while (Result[Length(Result)] = '0') do
2932 Delete(Result, Length(Result), 1);
2933 if (Result[Length(Result)] = ',') or (Result[Length(Result)] = '.') then
2934 Delete(Result, Length(Result), 1);
2935 Result := '1 : ' + Result;
2936 end
2937 else
2938 Result := '';
2939 end;
2941 { TGUIListBox }
2943 procedure TGUIListBox.AddItem(Item: string);
2944 begin
2945 SetLength(FItems, Length(FItems)+1);
2946 FItems[High(FItems)] := Item;
2948 if FSort then g_Basic.Sort(FItems);
2949 end;
2951 function TGUIListBox.ItemExists (item: String): Boolean;
2952 var i: Integer;
2953 begin
2954 i := 0;
2955 while (i <= High(FItems)) and (FItems[i] <> item) do Inc(i);
2956 result := i <= High(FItems)
2957 end;
2959 procedure TGUIListBox.Clear;
2960 begin
2961 FItems := nil;
2963 FStartLine := 0;
2964 FIndex := -1;
2965 end;
2967 constructor TGUIListBox.Create(FontID: DWORD; Width, Height: Word);
2968 begin
2969 inherited Create();
2971 FFont := TFont.Create(FontID, TFontType.Character);
2973 FWidth := Width;
2974 FHeight := Height;
2975 FIndex := -1;
2976 FOnChangeEvent := nil;
2977 FDrawBack := True;
2978 FDrawScroll := True;
2979 end;
2981 procedure TGUIListBox.Draw;
2982 var
2983 w2, h2: Word;
2984 a: Integer;
2985 s: string;
2986 begin
2987 inherited;
2989 if FDrawBack then DrawBox(FX, FY, FWidth+1, FHeight);
2990 if FDrawScroll then
2991 DrawScroll(FX+4+FWidth*16, FY+4, FHeight, (FStartLine > 0) and (FItems <> nil),
2992 (FStartLine+FHeight-1 < High(FItems)) and (FItems <> nil));
2994 if FItems <> nil then
2995 for a := FStartLine to Min(High(FItems), FStartLine+FHeight-1) do
2996 begin
2997 s := Items[a];
2999 FFont.GetTextSize(s, w2, h2);
3000 while (Length(s) > 0) and (w2 > FWidth*16) do
3001 begin
3002 SetLength(s, Length(s)-1);
3003 FFont.GetTextSize(s, w2, h2);
3004 end;
3006 if a = FIndex then
3007 FFont.Draw(FX+4, FY+4+(a-FStartLine)*16, s, FActiveColor.R, FActiveColor.G, FActiveColor.B)
3008 else
3009 FFont.Draw(FX+4, FY+4+(a-FStartLine)*16, s, FUnActiveColor.R, FUnActiveColor.G, FUnActiveColor.B);
3010 end;
3011 end;
3013 function TGUIListBox.GetHeight: Integer;
3014 begin
3015 Result := 8+FHeight*16;
3016 end;
3018 function TGUIListBox.GetWidth: Integer;
3019 begin
3020 Result := 8+(FWidth+1)*16;
3021 end;
3023 procedure TGUIListBox.OnMessage(var Msg: TMessage);
3024 var
3025 a: Integer;
3026 begin
3027 if not FEnabled then Exit;
3029 inherited;
3031 if FItems = nil then Exit;
3033 with Msg do
3034 case Msg of
3035 WM_KEYDOWN:
3036 case wParam of
3037 IK_HOME, IK_KPHOME:
3038 begin
3039 FIndex := 0;
3040 FStartLine := 0;
3041 end;
3042 IK_END, IK_KPEND:
3043 begin
3044 FIndex := High(FItems);
3045 FStartLine := Max(High(FItems)-FHeight+1, 0);
3046 end;
3047 IK_UP, IK_LEFT, IK_KPUP, IK_KPLEFT, VK_LEFT, JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT:
3048 if FIndex > 0 then
3049 begin
3050 Dec(FIndex);
3051 if FIndex < FStartLine then Dec(FStartLine);
3052 if @FOnChangeEvent <> nil then FOnChangeEvent(Self);
3053 end;
3054 IK_DOWN, IK_RIGHT, IK_KPDOWN, IK_KPRIGHT, VK_RIGHT, JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT:
3055 if FIndex < High(FItems) then
3056 begin
3057 Inc(FIndex);
3058 if FIndex > FStartLine+FHeight-1 then Inc(FStartLine);
3059 if @FOnChangeEvent <> nil then FOnChangeEvent(Self);
3060 end;
3061 IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK:
3062 with FWindow do
3063 begin
3064 if FActiveControl <> Self then SetActive(Self)
3065 else
3066 if FDefControl <> '' then SetActive(GetControl(FDefControl))
3067 else SetActive(nil);
3068 end;
3069 end;
3070 WM_CHAR:
3071 for a := 0 to High(FItems) do
3072 if (Length(FItems[a]) > 0) and (LowerCase(FItems[a][1]) = LowerCase(Chr(wParam))) then
3073 begin
3074 FIndex := a;
3075 FStartLine := Min(Max(FIndex-1, 0), Length(FItems)-FHeight);
3076 if @FOnChangeEvent <> nil then FOnChangeEvent(Self);
3077 Break;
3078 end;
3079 end;
3080 end;
3082 function TGUIListBox.SelectedItem(): String;
3083 begin
3084 Result := '';
3086 if (FIndex < 0) or (FItems = nil) or
3087 (FIndex > High(FItems)) then
3088 Exit;
3090 Result := FItems[FIndex];
3091 end;
3093 procedure TGUIListBox.FSetItems(Items: SSArray);
3094 begin
3095 if FItems <> nil then
3096 FItems := nil;
3098 FItems := Items;
3100 FStartLine := 0;
3101 FIndex := -1;
3103 if FSort then g_Basic.Sort(FItems);
3104 end;
3106 procedure TGUIListBox.SelectItem(Item: String);
3107 var
3108 a: Integer;
3109 begin
3110 if FItems = nil then
3111 Exit;
3113 FIndex := 0;
3114 Item := LowerCase(Item);
3116 for a := 0 to High(FItems) do
3117 if LowerCase(FItems[a]) = Item then
3118 begin
3119 FIndex := a;
3120 Break;
3121 end;
3123 if FIndex < FHeight then
3124 FStartLine := 0
3125 else
3126 FStartLine := Min(FIndex, Length(FItems)-FHeight);
3127 end;
3129 procedure TGUIListBox.FSetIndex(aIndex: Integer);
3130 begin
3131 if FItems = nil then
3132 Exit;
3134 if (aIndex < 0) or (aIndex > High(FItems)) then
3135 Exit;
3137 FIndex := aIndex;
3139 if FIndex <= FHeight then
3140 FStartLine := 0
3141 else
3142 FStartLine := Min(FIndex, Length(FItems)-FHeight);
3143 end;
3145 { TGUIFileListBox }
3147 procedure TGUIFileListBox.OnMessage(var Msg: TMessage);
3148 var
3149 a, b: Integer; s: AnsiString;
3150 begin
3151 if not FEnabled then
3152 Exit;
3154 if FItems = nil then
3155 Exit;
3157 with Msg do
3158 case Msg of
3159 WM_KEYDOWN:
3160 case wParam of
3161 IK_HOME, IK_KPHOME:
3162 begin
3163 FIndex := 0;
3164 FStartLine := 0;
3165 if @FOnChangeEvent <> nil then
3166 FOnChangeEvent(Self);
3167 end;
3169 IK_END, IK_KPEND:
3170 begin
3171 FIndex := High(FItems);
3172 FStartLine := Max(High(FItems)-FHeight+1, 0);
3173 if @FOnChangeEvent <> nil then
3174 FOnChangeEvent(Self);
3175 end;
3177 IK_PAGEUP, IK_KPPAGEUP:
3178 begin
3179 if FIndex > FHeight then
3180 FIndex := FIndex-FHeight
3181 else
3182 FIndex := 0;
3184 if FStartLine > FHeight then
3185 FStartLine := FStartLine-FHeight
3186 else
3187 FStartLine := 0;
3188 end;
3190 IK_PAGEDN, IK_KPPAGEDN:
3191 begin
3192 if FIndex < High(FItems)-FHeight then
3193 FIndex := FIndex+FHeight
3194 else
3195 FIndex := High(FItems);
3197 if FStartLine < High(FItems)-FHeight then
3198 FStartLine := FStartLine+FHeight
3199 else
3200 FStartLine := High(FItems)-FHeight+1;
3201 end;
3203 IK_UP, IK_LEFT, IK_KPUP, IK_KPLEFT, VK_UP, VK_LEFT, JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT:
3204 if FIndex > 0 then
3205 begin
3206 Dec(FIndex);
3207 if FIndex < FStartLine then
3208 Dec(FStartLine);
3209 if @FOnChangeEvent <> nil then
3210 FOnChangeEvent(Self);
3211 end;
3213 IK_DOWN, IK_RIGHT, IK_KPDOWN, IK_KPRIGHT, VK_DOWN, VK_RIGHT, JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT:
3214 if FIndex < High(FItems) then
3215 begin
3216 Inc(FIndex);
3217 if FIndex > FStartLine+FHeight-1 then
3218 Inc(FStartLine);
3219 if @FOnChangeEvent <> nil then
3220 FOnChangeEvent(Self);
3221 end;
3223 IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK:
3224 with FWindow do
3225 begin
3226 if FActiveControl <> Self then
3227 SetActive(Self)
3228 else
3229 begin
3230 if FItems[FIndex][1] = #29 then // Ïàïêà
3231 begin
3232 if FItems[FIndex] = #29 + '..' then
3233 begin
3234 //e_LogWritefln('TGUIFileListBox: Upper dir "%s" -> "%s"', [FSubPath, e_UpperDir(FSubPath)]);
3235 FSubPath := e_UpperDir(FSubPath)
3236 end
3237 else
3238 begin
3239 s := Copy(AnsiString(FItems[FIndex]), 2);
3240 //e_LogWritefln('TGUIFileListBox: Enter dir "%s" -> "%s"', [FSubPath, e_CatPath(FSubPath, s)]);
3241 FSubPath := e_CatPath(FSubPath, s);
3242 end;
3243 ScanDirs;
3244 FIndex := 0;
3245 Exit;
3246 end;
3248 if FDefControl <> '' then
3249 SetActive(GetControl(FDefControl))
3250 else
3251 SetActive(nil);
3252 end;
3253 end;
3254 end;
3256 WM_CHAR:
3257 for b := FIndex + 1 to High(FItems) + FIndex do
3258 begin
3259 a := b mod Length(FItems);
3260 if ( (Length(FItems[a]) > 0) and
3261 (LowerCase(FItems[a][1]) = LowerCase(Chr(wParam))) ) or
3262 ( (Length(FItems[a]) > 1) and
3263 (FItems[a][1] = #29) and // Ïàïêà
3264 (LowerCase(FItems[a][2]) = LowerCase(Chr(wParam))) ) then
3265 begin
3266 FIndex := a;
3267 FStartLine := Min(Max(FIndex-1, 0), Length(FItems)-FHeight);
3268 if @FOnChangeEvent <> nil then
3269 FOnChangeEvent(Self);
3270 Break;
3271 end;
3272 end;
3273 end;
3274 end;
3276 procedure TGUIFileListBox.ScanDirs;
3277 var i, j: Integer; path: AnsiString; SR: TSearchRec; sm, sc: String;
3278 begin
3279 Clear;
3281 i := High(FBaseList);
3282 while i >= 0 do
3283 begin
3284 path := e_CatPath(FBaseList[i], FSubPath);
3285 if FDirs then
3286 begin
3287 if FindFirst(path + '/' + '*', faDirectory, SR) = 0 then
3288 begin
3289 repeat
3290 if LongBool(SR.Attr and faDirectory) then
3291 if (SR.Name <> '.') and ((FSubPath <> '') or (SR.Name <> '..')) then
3292 if Self.ItemExists(#1 + SR.Name) = false then
3293 Self.AddItem(#1 + SR.Name)
3294 until FindNext(SR) <> 0
3295 end;
3296 FindClose(SR)
3297 end;
3298 Dec(i)
3299 end;
3301 i := High(FBaseList);
3302 while i >= 0 do
3303 begin
3304 path := e_CatPath(FBaseList[i], FSubPath);
3305 sm := FFileMask;
3306 while sm <> '' do
3307 begin
3308 j := Pos('|', sm);
3309 if j = 0 then
3310 j := length(sm) + 1;
3311 sc := Copy(sm, 1, j - 1);
3312 Delete(sm, 1, j);
3313 if FindFirst(path + '/' + sc, faAnyFile, SR) = 0 then
3314 begin
3315 repeat
3316 if Self.ItemExists(SR.Name) = false then
3317 AddItem(SR.Name)
3318 until FindNext(SR) <> 0
3319 end;
3320 FindClose(SR)
3321 end;
3322 Dec(i)
3323 end;
3325 for i := 0 to High(FItems) do
3326 if FItems[i][1] = #1 then
3327 FItems[i][1] := #29;
3328 end;
3330 procedure TGUIFileListBox.SetBase (dirs: SSArray; path: String = '');
3331 begin
3332 FBaseList := dirs;
3333 FSubPath := path;
3334 ScanDirs
3335 end;
3337 function TGUIFileListBox.SelectedItem (): String;
3338 var s: AnsiString;
3339 begin
3340 result := '';
3341 if (FIndex >= 0) and (FIndex <= High(FItems)) and (FItems[FIndex][1] <> '/') and (FItems[FIndex][1] <> '\') then
3342 begin
3343 s := e_CatPath(FSubPath, FItems[FIndex]);
3344 if e_FindResource(FBaseList, s) = true then
3345 result := ExpandFileName(s)
3346 end;
3347 e_LogWritefln('TGUIFileListBox.SelectedItem -> "%s"', [result]);
3348 end;
3350 procedure TGUIFileListBox.UpdateFileList();
3351 var
3352 fn: String;
3353 begin
3354 if (FIndex = -1) or (FItems = nil) or
3355 (FIndex > High(FItems)) or
3356 (FItems[FIndex][1] = '/') or
3357 (FItems[FIndex][1] = '\') then
3358 fn := ''
3359 else
3360 fn := FItems[FIndex];
3362 // OpenDir(FPath);
3363 ScanDirs;
3365 if fn <> '' then
3366 SelectItem(fn);
3367 end;
3369 { TGUIMemo }
3371 procedure TGUIMemo.Clear;
3372 begin
3373 FLines := nil;
3374 FStartLine := 0;
3375 end;
3377 constructor TGUIMemo.Create(FontID: DWORD; Width, Height: Word);
3378 begin
3379 inherited Create();
3381 FFont := TFont.Create(FontID, TFontType.Character);
3383 FWidth := Width;
3384 FHeight := Height;
3385 FDrawBack := True;
3386 FDrawScroll := True;
3387 end;
3389 procedure TGUIMemo.Draw;
3390 var
3391 a: Integer;
3392 begin
3393 inherited;
3395 if FDrawBack then DrawBox(FX, FY, FWidth+1, FHeight);
3396 if FDrawScroll then
3397 DrawScroll(FX+4+FWidth*16, FY+4, FHeight, (FStartLine > 0) and (FLines <> nil),
3398 (FStartLine+FHeight-1 < High(FLines)) and (FLines <> nil));
3400 if FLines <> nil then
3401 for a := FStartLine to Min(High(FLines), FStartLine+FHeight-1) do
3402 FFont.Draw(FX+4, FY+4+(a-FStartLine)*16, FLines[a], FColor.R, FColor.G, FColor.B);
3403 end;
3405 function TGUIMemo.GetHeight: Integer;
3406 begin
3407 Result := 8+FHeight*16;
3408 end;
3410 function TGUIMemo.GetWidth: Integer;
3411 begin
3412 Result := 8+(FWidth+1)*16;
3413 end;
3415 procedure TGUIMemo.OnMessage(var Msg: TMessage);
3416 begin
3417 if not FEnabled then Exit;
3419 inherited;
3421 if FLines = nil then Exit;
3423 with Msg do
3424 case Msg of
3425 WM_KEYDOWN:
3426 case wParam of
3427 IK_UP, IK_LEFT, IK_KPUP, IK_KPLEFT, VK_UP, VK_LEFT, JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT:
3428 if FStartLine > 0 then
3429 Dec(FStartLine);
3430 IK_DOWN, IK_RIGHT, IK_KPDOWN, IK_KPRIGHT, VK_DOWN, VK_RIGHT, JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT:
3431 if FStartLine < Length(FLines)-FHeight then
3432 Inc(FStartLine);
3433 IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK:
3434 with FWindow do
3435 begin
3436 if FActiveControl <> Self then
3437 begin
3438 SetActive(Self);
3439 {FStartLine := 0;}
3440 end
3441 else
3442 if FDefControl <> '' then SetActive(GetControl(FDefControl))
3443 else SetActive(nil);
3444 end;
3445 end;
3446 end;
3447 end;
3449 procedure TGUIMemo.SetText(Text: string);
3450 begin
3451 FStartLine := 0;
3452 FLines := GetLines(Text, FFont.ID, FWidth*16);
3453 end;
3455 { TGUIimage }
3457 procedure TGUIimage.ClearImage();
3458 begin
3459 if FImageRes = '' then Exit;
3461 g_Texture_Delete(FImageRes);
3462 FImageRes := '';
3463 end;
3465 constructor TGUIimage.Create();
3466 begin
3467 inherited Create();
3469 FImageRes := '';
3470 end;
3472 destructor TGUIimage.Destroy();
3473 begin
3474 inherited;
3475 end;
3477 procedure TGUIimage.Draw();
3478 var
3479 ID: DWORD;
3480 begin
3481 inherited;
3483 if FImageRes = '' then
3484 begin
3485 if g_Texture_Get(FDefaultRes, ID) then e_Draw(ID, FX, FY, 0, True, False);
3486 end
3487 else
3488 if g_Texture_Get(FImageRes, ID) then e_Draw(ID, FX, FY, 0, True, False);
3489 end;
3491 procedure TGUIimage.OnMessage(var Msg: TMessage);
3492 begin
3493 inherited;
3494 end;
3496 procedure TGUIimage.SetImage(Res: string);
3497 begin
3498 ClearImage();
3500 if g_Texture_CreateWADEx(Res, Res) then FImageRes := Res;
3501 end;
3503 procedure TGUIimage.Update();
3504 begin
3505 inherited;
3506 end;
3508 end.