DEADSOFTWARE

fix building with USE_SYSSTUB + USE_SDLMIXER
[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 procedure SelectItem(Item: String);
405 procedure Clear();
406 function GetWidth(): Integer; override;
407 function GetHeight(): Integer; override;
408 function SelectedItem(): String;
410 property OnChange: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent;
411 property Sort: Boolean read FSort write FSort;
412 property ItemIndex: Integer read FIndex write FSetIndex;
413 property Items: SSArray read FItems write FSetItems;
414 property DrawBack: Boolean read FDrawBack write FDrawBack;
415 property DrawScrollBar: Boolean read FDrawScroll write FDrawScroll;
416 property ActiveColor: TRGB read FActiveColor write FActiveColor;
417 property UnActiveColor: TRGB read FUnActiveColor write FUnActiveColor;
418 property Font: TFont read FFont write FFont;
419 end;
421 TGUIFileListBox = class(TGUIListBox)
422 private
423 FBasePath: String;
424 FPath: String;
425 FFileMask: String;
426 FDirs: Boolean;
428 procedure OpenDir(path: String);
430 public
431 procedure OnMessage(var Msg: TMessage); override;
432 procedure SetBase(path: String);
433 function SelectedItem(): String;
434 procedure UpdateFileList();
436 property Dirs: Boolean read FDirs write FDirs;
437 property FileMask: String read FFileMask write FFileMask;
438 property Path: String read FPath;
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,
555 g_game, Math, StrUtils, g_player, g_options,
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 if @FOnChangeEvent <> nil then
2230 FOnChangeEvent(Self);
2231 end;
2233 IK_LEFT, IK_KPLEFT, VK_LEFT,
2234 JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT:
2235 begin
2236 if FIndex > 0 then
2237 Dec(FIndex)
2238 else
2239 FIndex := High(FItems);
2241 if @FOnChangeEvent <> nil then
2242 FOnChangeEvent(Self);
2243 end;
2244 end;
2245 end;
2246 end;
2248 procedure TGUISwitch.Update;
2249 begin
2250 inherited;
2252 end;
2254 { TGUIEdit }
2256 constructor TGUIEdit.Create(FontID: DWORD);
2257 begin
2258 inherited Create();
2260 FFont := TFont.Create(FontID, TFontType.Character);
2262 FMaxLength := 0;
2263 FWidth := 0;
2264 FInvalid := false;
2266 g_Texture_Get(EDIT_LEFT, FLeftID);
2267 g_Texture_Get(EDIT_RIGHT, FRightID);
2268 g_Texture_Get(EDIT_MIDDLE, FMiddleID);
2269 end;
2271 procedure TGUIEdit.Draw;
2272 var
2273 c, w, h: Word;
2274 r, g, b: Byte;
2275 begin
2276 inherited;
2278 e_Draw(FLeftID, FX, FY, 0, True, False);
2279 e_Draw(FRightID, FX+8+FWidth*16, FY, 0, True, False);
2281 for c := 0 to FWidth-1 do
2282 e_Draw(FMiddleID, FX+8+c*16, FY, 0, True, False);
2284 r := FColor.R;
2285 g := FColor.G;
2286 b := FColor.B;
2287 if FInvalid and (FWindow.FActiveControl <> self) then begin r := 128; g := 128; b := 128; end;
2288 FFont.Draw(FX+8, FY, FText, r, g, b);
2290 if (FWindow.FActiveControl = self) then
2291 begin
2292 FFont.GetTextSize(Copy(FText, 1, FCaretPos), w, h);
2293 h := e_CharFont_GetMaxHeight(FFont.ID);
2294 e_DrawLine(2, FX+8+w, FY+h-3, FX+8+w+EDIT_CURSORLEN, FY+h-3,
2295 EDIT_CURSORCOLOR.R, EDIT_CURSORCOLOR.G, EDIT_CURSORCOLOR.B);
2296 end;
2297 end;
2299 function TGUIEdit.GetWidth: Integer;
2300 begin
2301 Result := 16+FWidth*16;
2302 end;
2304 procedure TGUIEdit.OnMessage(var Msg: TMessage);
2305 begin
2306 if not FEnabled then Exit;
2308 inherited;
2310 with Msg do
2311 case Msg of
2312 WM_CHAR:
2313 if FOnlyDigits then
2314 begin
2315 if (wParam in [48..57]) and (Chr(wParam) <> '`') then
2316 if Length(Text) < FMaxLength then
2317 begin
2318 Insert(Chr(wParam), FText, FCaretPos + 1);
2319 Inc(FCaretPos);
2320 end;
2321 end
2322 else
2323 begin
2324 if (wParam in [32..255]) and (Chr(wParam) <> '`') then
2325 if Length(Text) < FMaxLength then
2326 begin
2327 Insert(Chr(wParam), FText, FCaretPos + 1);
2328 Inc(FCaretPos);
2329 end;
2330 end;
2331 WM_KEYDOWN:
2332 case wParam of
2333 IK_BACKSPACE:
2334 begin
2335 Delete(FText, FCaretPos, 1);
2336 if FCaretPos > 0 then Dec(FCaretPos);
2337 end;
2338 IK_DELETE: Delete(FText, FCaretPos + 1, 1);
2339 IK_END, IK_KPEND: FCaretPos := Length(FText);
2340 IK_HOME, IK_KPHOME: FCaretPos := 0;
2341 IK_LEFT, IK_KPLEFT, VK_LEFT, JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT: if FCaretPos > 0 then Dec(FCaretPos);
2342 IK_RIGHT, IK_KPRIGHT, VK_RIGHT, JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT: if FCaretPos < Length(FText) then Inc(FCaretPos);
2343 IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK:
2344 with FWindow do
2345 begin
2346 if FActiveControl <> Self then
2347 begin
2348 SetActive(Self);
2349 if @FOnEnterEvent <> nil then FOnEnterEvent(Self);
2350 end
2351 else
2352 begin
2353 if FDefControl <> '' then SetActive(GetControl(FDefControl))
2354 else SetActive(nil);
2355 if @FOnChangeEvent <> nil then FOnChangeEvent(Self);
2356 end;
2357 end;
2358 end;
2359 end;
2361 g_GUIGrabInput := (@FOnEnterEvent = nil) and (FWindow.FActiveControl = Self);
2362 g_Touch_ShowKeyboard(g_GUIGrabInput)
2363 end;
2365 procedure TGUIEdit.SetText(Text: string);
2366 begin
2367 if Length(Text) > FMaxLength then SetLength(Text, FMaxLength);
2368 FText := Text;
2369 FCaretPos := Length(FText);
2370 end;
2372 procedure TGUIEdit.Update;
2373 begin
2374 inherited;
2375 end;
2377 { TGUIKeyRead }
2379 constructor TGUIKeyRead.Create(FontID: DWORD);
2380 begin
2381 inherited Create();
2382 FKey := 0;
2383 FIsQuery := false;
2385 FFont := TFont.Create(FontID, TFontType.Character);
2386 end;
2388 procedure TGUIKeyRead.Draw;
2389 begin
2390 inherited;
2392 FFont.Draw(FX, FY, IfThen(FIsQuery, KEYREAD_QUERY, IfThen(FKey <> 0, e_KeyNames[FKey], KEYREAD_CLEAR)),
2393 FColor.R, FColor.G, FColor.B);
2394 end;
2396 function TGUIKeyRead.GetWidth: Integer;
2397 var
2398 a: Byte;
2399 w, h: Word;
2400 begin
2401 Result := 0;
2403 for a := 0 to 255 do
2404 begin
2405 FFont.GetTextSize(e_KeyNames[a], w, h);
2406 Result := Max(Result, w);
2407 end;
2409 FFont.GetTextSize(KEYREAD_QUERY, w, h);
2410 if w > Result then Result := w;
2412 FFont.GetTextSize(KEYREAD_CLEAR, w, h);
2413 if w > Result then Result := w;
2414 end;
2416 function TGUIKeyRead.WantActivationKey (key: LongInt): Boolean;
2417 begin
2418 result :=
2419 (key = IK_BACKSPACE) or
2420 false; // oops
2421 end;
2423 procedure TGUIKeyRead.OnMessage(var Msg: TMessage);
2424 procedure actDefCtl ();
2425 begin
2426 with FWindow do
2427 if FDefControl <> '' then
2428 SetActive(GetControl(FDefControl))
2429 else
2430 SetActive(nil);
2431 end;
2433 begin
2434 inherited;
2436 if not FEnabled then
2437 Exit;
2439 with Msg do
2440 case Msg of
2441 WM_KEYDOWN:
2442 case wParam of
2443 VK_ESCAPE:
2444 begin
2445 if FIsQuery then actDefCtl();
2446 FIsQuery := False;
2447 end;
2448 IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK:
2449 begin
2450 if not FIsQuery then
2451 begin
2452 with FWindow do
2453 if FActiveControl <> Self then
2454 SetActive(Self);
2456 FIsQuery := True;
2457 end
2458 else if (wParam < VK_FIRSTKEY) and (wParam > VK_LASTKEY) then
2459 begin
2460 // FKey := IK_ENTER; // <Enter>
2461 FKey := wParam;
2462 FIsQuery := False;
2463 actDefCtl();
2464 end;
2465 end;
2466 IK_BACKSPACE: // clear keybinding if we aren't waiting for a key
2467 begin
2468 if not FIsQuery then
2469 begin
2470 FKey := 0;
2471 actDefCtl();
2472 end;
2473 end;
2474 end;
2476 MESSAGE_DIKEY:
2477 begin
2478 if not FIsQuery and (wParam = IK_BACKSPACE) then
2479 begin
2480 FKey := 0;
2481 actDefCtl();
2482 end
2483 else if FIsQuery then
2484 begin
2485 case wParam of
2486 IK_ENTER, IK_KPRETURN, VK_FIRSTKEY..VK_LASTKEY (*, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK*): // Not <Enter
2487 else
2488 if e_KeyNames[wParam] <> '' then
2489 FKey := wParam;
2490 FIsQuery := False;
2491 actDefCtl();
2492 end
2493 end;
2494 end;
2495 end;
2497 g_GUIGrabInput := FIsQuery
2498 end;
2500 { TGUIKeyRead2 }
2502 constructor TGUIKeyRead2.Create(FontID: DWORD);
2503 var
2504 a: Byte;
2505 w, h: Word;
2506 begin
2507 inherited Create();
2509 FKey0 := 0;
2510 FKey1 := 0;
2511 FKeyIdx := 0;
2512 FIsQuery := False;
2514 FFontID := FontID;
2515 FFont := TFont.Create(FontID, TFontType.Character);
2517 FMaxKeyNameWdt := 0;
2518 for a := 0 to 255 do
2519 begin
2520 FFont.GetTextSize(e_KeyNames[a], w, h);
2521 FMaxKeyNameWdt := Max(FMaxKeyNameWdt, w);
2522 end;
2524 FMaxKeyNameWdt := FMaxKeyNameWdt-(FMaxKeyNameWdt div 3);
2526 FFont.GetTextSize(KEYREAD_QUERY, w, h);
2527 if w > FMaxKeyNameWdt then FMaxKeyNameWdt := w;
2529 FFont.GetTextSize(KEYREAD_CLEAR, w, h);
2530 if w > FMaxKeyNameWdt then FMaxKeyNameWdt := w;
2531 end;
2533 procedure TGUIKeyRead2.Draw;
2534 procedure drawText (idx: Integer);
2535 var
2536 x, y: Integer;
2537 r, g, b: Byte;
2538 kk: DWORD;
2539 begin
2540 if idx = 0 then kk := FKey0 else kk := FKey1;
2541 y := FY;
2542 if idx = 0 then x := FX+8 else x := FX+8+FMaxKeyNameWdt+16;
2543 r := 255;
2544 g := 0;
2545 b := 0;
2546 if FKeyIdx = idx then begin r := 255; g := 255; b := 255; end;
2547 if FIsQuery and (FKeyIdx = idx) then
2548 FFont.Draw(x, y, KEYREAD_QUERY, r, g, b)
2549 else
2550 FFont.Draw(x, y, IfThen(kk <> 0, e_KeyNames[kk], KEYREAD_CLEAR), r, g, b);
2551 end;
2553 begin
2554 inherited;
2556 //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);
2557 //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);
2558 drawText(0);
2559 drawText(1);
2560 end;
2562 function TGUIKeyRead2.GetWidth: Integer;
2563 begin
2564 Result := FMaxKeyNameWdt*2+8+8+16;
2565 end;
2567 function TGUIKeyRead2.WantActivationKey (key: LongInt): Boolean;
2568 begin
2569 case key of
2570 IK_BACKSPACE, IK_LEFT, IK_RIGHT, IK_KPLEFT, IK_KPRIGHT, VK_LEFT, VK_RIGHT,
2571 JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT,
2572 JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT:
2573 result := True
2574 else
2575 result := False
2576 end
2577 end;
2579 procedure TGUIKeyRead2.OnMessage(var Msg: TMessage);
2580 procedure actDefCtl ();
2581 begin
2582 with FWindow do
2583 if FDefControl <> '' then
2584 SetActive(GetControl(FDefControl))
2585 else
2586 SetActive(nil);
2587 end;
2589 begin
2590 inherited;
2592 if not FEnabled then
2593 Exit;
2595 with Msg do
2596 case Msg of
2597 WM_KEYDOWN:
2598 case wParam of
2599 VK_ESCAPE:
2600 begin
2601 if FIsQuery then actDefCtl();
2602 FIsQuery := False;
2603 end;
2604 IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK:
2605 begin
2606 if not FIsQuery then
2607 begin
2608 with FWindow do
2609 if FActiveControl <> Self then
2610 SetActive(Self);
2612 FIsQuery := True;
2613 end
2614 else if (wParam < VK_FIRSTKEY) and (wParam > VK_LASTKEY) then
2615 begin
2616 // if (FKeyIdx = 0) then FKey0 := IK_ENTER else FKey1 := IK_ENTER; // <Enter>
2617 if (FKeyIdx = 0) then FKey0 := wParam else FKey1 := wParam;
2618 FIsQuery := False;
2619 actDefCtl();
2620 end;
2621 end;
2622 IK_BACKSPACE: // clear keybinding if we aren't waiting for a key
2623 begin
2624 if not FIsQuery then
2625 begin
2626 if (FKeyIdx = 0) then FKey0 := 0 else FKey1 := 0;
2627 actDefCtl();
2628 end;
2629 end;
2630 IK_LEFT, IK_KPLEFT, VK_LEFT, JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT:
2631 if not FIsQuery then
2632 begin
2633 FKeyIdx := 0;
2634 actDefCtl();
2635 end;
2636 IK_RIGHT, IK_KPRIGHT, VK_RIGHT, JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT:
2637 if not FIsQuery then
2638 begin
2639 FKeyIdx := 1;
2640 actDefCtl();
2641 end;
2642 end;
2644 MESSAGE_DIKEY:
2645 begin
2646 if not FIsQuery and (wParam = IK_BACKSPACE) then
2647 begin
2648 if (FKeyIdx = 0) then FKey0 := 0 else FKey1 := 0;
2649 actDefCtl();
2650 end
2651 else if FIsQuery then
2652 begin
2653 case wParam of
2654 IK_ENTER, IK_KPRETURN, VK_FIRSTKEY..VK_LASTKEY (*, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK*): // Not <Enter
2655 else
2656 if e_KeyNames[wParam] <> '' then
2657 begin
2658 if (FKeyIdx = 0) then FKey0 := wParam else FKey1 := wParam;
2659 end;
2660 FIsQuery := False;
2661 actDefCtl()
2662 end
2663 end;
2664 end;
2665 end;
2667 g_GUIGrabInput := FIsQuery
2668 end;
2671 { TGUIModelView }
2673 constructor TGUIModelView.Create;
2674 begin
2675 inherited Create();
2677 FModel := nil;
2678 end;
2680 destructor TGUIModelView.Destroy;
2681 begin
2682 FModel.Free();
2684 inherited;
2685 end;
2687 procedure TGUIModelView.Draw;
2688 begin
2689 inherited;
2691 DrawBox(FX, FY, 4, 4);
2693 if FModel <> nil then FModel.Draw(FX+4, FY+4);
2694 end;
2696 procedure TGUIModelView.NextAnim();
2697 begin
2698 if FModel = nil then
2699 Exit;
2701 if FModel.Animation < A_PAIN then
2702 FModel.ChangeAnimation(FModel.Animation+1, True)
2703 else
2704 FModel.ChangeAnimation(A_STAND, True);
2705 end;
2707 procedure TGUIModelView.NextWeapon();
2708 begin
2709 if FModel = nil then
2710 Exit;
2712 if FModel.Weapon < WP_LAST then
2713 FModel.SetWeapon(FModel.Weapon+1)
2714 else
2715 FModel.SetWeapon(WEAPON_KASTET);
2716 end;
2718 procedure TGUIModelView.OnMessage(var Msg: TMessage);
2719 begin
2720 inherited;
2722 end;
2724 procedure TGUIModelView.SetColor(Red, Green, Blue: Byte);
2725 begin
2726 if FModel <> nil then FModel.SetColor(Red, Green, Blue);
2727 end;
2729 procedure TGUIModelView.SetModel(ModelName: string);
2730 begin
2731 FModel.Free();
2733 FModel := g_PlayerModel_Get(ModelName);
2734 end;
2736 procedure TGUIModelView.Update;
2737 begin
2738 inherited;
2740 a := not a;
2741 if a then Exit;
2743 if FModel <> nil then FModel.Update;
2744 end;
2746 { TGUIMapPreview }
2748 constructor TGUIMapPreview.Create();
2749 begin
2750 inherited Create();
2751 ClearMap;
2752 end;
2754 destructor TGUIMapPreview.Destroy();
2755 begin
2756 ClearMap;
2757 inherited;
2758 end;
2760 procedure TGUIMapPreview.Draw();
2761 var
2762 a: Integer;
2763 r, g, b: Byte;
2764 begin
2765 inherited;
2767 DrawBox(FX, FY, MAPPREVIEW_WIDTH, MAPPREVIEW_HEIGHT);
2769 if (FMapSize.X <= 0) or (FMapSize.Y <= 0) then
2770 Exit;
2772 e_DrawFillQuad(FX+4, FY+4,
2773 FX+4 + Trunc(FMapSize.X / FScale) - 1,
2774 FY+4 + Trunc(FMapSize.Y / FScale) - 1,
2775 32, 32, 32, 0);
2777 if FMapData <> nil then
2778 for a := 0 to High(FMapData) do
2779 with FMapData[a] do
2780 begin
2781 if X1 > MAPPREVIEW_WIDTH*16 then Continue;
2782 if Y1 > MAPPREVIEW_HEIGHT*16 then Continue;
2784 if X2 < 0 then Continue;
2785 if Y2 < 0 then Continue;
2787 if X2 > MAPPREVIEW_WIDTH*16 then X2 := MAPPREVIEW_WIDTH*16;
2788 if Y2 > MAPPREVIEW_HEIGHT*16 then Y2 := MAPPREVIEW_HEIGHT*16;
2790 if X1 < 0 then X1 := 0;
2791 if Y1 < 0 then Y1 := 0;
2793 case PanelType of
2794 PANEL_WALL:
2795 begin
2796 r := 255;
2797 g := 255;
2798 b := 255;
2799 end;
2800 PANEL_CLOSEDOOR:
2801 begin
2802 r := 255;
2803 g := 255;
2804 b := 0;
2805 end;
2806 PANEL_WATER:
2807 begin
2808 r := 0;
2809 g := 0;
2810 b := 192;
2811 end;
2812 PANEL_ACID1:
2813 begin
2814 r := 0;
2815 g := 176;
2816 b := 0;
2817 end;
2818 PANEL_ACID2:
2819 begin
2820 r := 176;
2821 g := 0;
2822 b := 0;
2823 end;
2824 else
2825 begin
2826 r := 128;
2827 g := 128;
2828 b := 128;
2829 end;
2830 end;
2832 if ((X2-X1) > 0) and ((Y2-Y1) > 0) then
2833 e_DrawFillQuad(FX+4 + X1, FY+4 + Y1,
2834 FX+4 + X2 - 1, FY+4 + Y2 - 1, r, g, b, 0);
2835 end;
2836 end;
2838 procedure TGUIMapPreview.OnMessage(var Msg: TMessage);
2839 begin
2840 inherited;
2842 end;
2844 procedure TGUIMapPreview.SetMap(Res: string);
2845 var
2846 WAD: TWADFile;
2847 panlist: TDynField;
2848 pan: TDynRecord;
2849 //header: TMapHeaderRec_1;
2850 FileName: string;
2851 Data: Pointer;
2852 Len: Integer;
2853 rX, rY: Single;
2854 map: TDynRecord = nil;
2855 begin
2856 FMapSize.X := 0;
2857 FMapSize.Y := 0;
2858 FScale := 0.0;
2859 FMapData := nil;
2861 FileName := g_ExtractWadName(Res);
2863 WAD := TWADFile.Create();
2864 if not WAD.ReadFile(FileName) then
2865 begin
2866 WAD.Free();
2867 Exit;
2868 end;
2870 //k8: ignores path again
2871 if not WAD.GetMapResource(g_ExtractFileName(Res), Data, Len) then
2872 begin
2873 WAD.Free();
2874 Exit;
2875 end;
2877 WAD.Free();
2879 try
2880 map := g_Map_ParseMap(Data, Len);
2881 except
2882 FreeMem(Data);
2883 map.Free();
2884 //raise;
2885 exit;
2886 end;
2888 FreeMem(Data);
2890 if (map = nil) then exit;
2892 try
2893 panlist := map.field['panel'];
2894 //header := GetMapHeader(map);
2896 FMapSize.X := map.Width div 16;
2897 FMapSize.Y := map.Height div 16;
2899 rX := Ceil(map.Width / (MAPPREVIEW_WIDTH*256.0));
2900 rY := Ceil(map.Height / (MAPPREVIEW_HEIGHT*256.0));
2901 FScale := max(rX, rY);
2903 FMapData := nil;
2905 if (panlist <> nil) then
2906 begin
2907 for pan in panlist do
2908 begin
2909 if (pan.PanelType and (PANEL_WALL or PANEL_CLOSEDOOR or
2910 PANEL_STEP or PANEL_WATER or
2911 PANEL_ACID1 or PANEL_ACID2)) <> 0 then
2912 begin
2913 SetLength(FMapData, Length(FMapData)+1);
2914 with FMapData[High(FMapData)] do
2915 begin
2916 X1 := pan.X div 16;
2917 Y1 := pan.Y div 16;
2919 X2 := (pan.X + pan.Width) div 16;
2920 Y2 := (pan.Y + pan.Height) div 16;
2922 X1 := Trunc(X1/FScale + 0.5);
2923 Y1 := Trunc(Y1/FScale + 0.5);
2924 X2 := Trunc(X2/FScale + 0.5);
2925 Y2 := Trunc(Y2/FScale + 0.5);
2927 if (X1 <> X2) or (Y1 <> Y2) then
2928 begin
2929 if X1 = X2 then
2930 X2 := X2 + 1;
2931 if Y1 = Y2 then
2932 Y2 := Y2 + 1;
2933 end;
2935 PanelType := pan.PanelType;
2936 end;
2937 end;
2938 end;
2939 end;
2940 finally
2941 //writeln('freeing map');
2942 map.Free();
2943 end;
2944 end;
2946 procedure TGUIMapPreview.ClearMap();
2947 begin
2948 SetLength(FMapData, 0);
2949 FMapData := nil;
2950 FMapSize.X := 0;
2951 FMapSize.Y := 0;
2952 FScale := 0.0;
2953 end;
2955 procedure TGUIMapPreview.Update();
2956 begin
2957 inherited;
2959 end;
2961 function TGUIMapPreview.GetScaleStr(): String;
2962 begin
2963 if FScale > 0.0 then
2964 begin
2965 Result := FloatToStrF(FScale*16.0, ffFixed, 3, 3);
2966 while (Result[Length(Result)] = '0') do
2967 Delete(Result, Length(Result), 1);
2968 if (Result[Length(Result)] = ',') or (Result[Length(Result)] = '.') then
2969 Delete(Result, Length(Result), 1);
2970 Result := '1 : ' + Result;
2971 end
2972 else
2973 Result := '';
2974 end;
2976 { TGUIListBox }
2978 procedure TGUIListBox.AddItem(Item: string);
2979 begin
2980 SetLength(FItems, Length(FItems)+1);
2981 FItems[High(FItems)] := Item;
2983 if FSort then g_Basic.Sort(FItems);
2984 end;
2986 procedure TGUIListBox.Clear();
2987 begin
2988 FItems := nil;
2990 FStartLine := 0;
2991 FIndex := -1;
2992 end;
2994 constructor TGUIListBox.Create(FontID: DWORD; Width, Height: Word);
2995 begin
2996 inherited Create();
2998 FFont := TFont.Create(FontID, TFontType.Character);
3000 FWidth := Width;
3001 FHeight := Height;
3002 FIndex := -1;
3003 FOnChangeEvent := nil;
3004 FDrawBack := True;
3005 FDrawScroll := True;
3006 end;
3008 procedure TGUIListBox.Draw;
3009 var
3010 w2, h2: Word;
3011 a: Integer;
3012 s: string;
3013 begin
3014 inherited;
3016 if FDrawBack then DrawBox(FX, FY, FWidth+1, FHeight);
3017 if FDrawScroll then
3018 DrawScroll(FX+4+FWidth*16, FY+4, FHeight, (FStartLine > 0) and (FItems <> nil),
3019 (FStartLine+FHeight-1 < High(FItems)) and (FItems <> nil));
3021 if FItems <> nil then
3022 for a := FStartLine to Min(High(FItems), FStartLine+FHeight-1) do
3023 begin
3024 s := Items[a];
3026 FFont.GetTextSize(s, w2, h2);
3027 while (Length(s) > 0) and (w2 > FWidth*16) do
3028 begin
3029 SetLength(s, Length(s)-1);
3030 FFont.GetTextSize(s, w2, h2);
3031 end;
3033 if a = FIndex then
3034 FFont.Draw(FX+4, FY+4+(a-FStartLine)*16, s, FActiveColor.R, FActiveColor.G, FActiveColor.B)
3035 else
3036 FFont.Draw(FX+4, FY+4+(a-FStartLine)*16, s, FUnActiveColor.R, FUnActiveColor.G, FUnActiveColor.B);
3037 end;
3038 end;
3040 function TGUIListBox.GetHeight: Integer;
3041 begin
3042 Result := 8+FHeight*16;
3043 end;
3045 function TGUIListBox.GetWidth: Integer;
3046 begin
3047 Result := 8+(FWidth+1)*16;
3048 end;
3050 procedure TGUIListBox.OnMessage(var Msg: TMessage);
3051 var
3052 a: Integer;
3053 begin
3054 if not FEnabled then Exit;
3056 inherited;
3058 if FItems = nil then Exit;
3060 with Msg do
3061 case Msg of
3062 WM_KEYDOWN:
3063 case wParam of
3064 IK_HOME, IK_KPHOME:
3065 begin
3066 FIndex := 0;
3067 FStartLine := 0;
3068 end;
3069 IK_END, IK_KPEND:
3070 begin
3071 FIndex := High(FItems);
3072 FStartLine := Max(High(FItems)-FHeight+1, 0);
3073 end;
3074 IK_UP, IK_LEFT, IK_KPUP, IK_KPLEFT, VK_LEFT, JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT:
3075 if FIndex > 0 then
3076 begin
3077 Dec(FIndex);
3078 if FIndex < FStartLine then Dec(FStartLine);
3079 if @FOnChangeEvent <> nil then FOnChangeEvent(Self);
3080 end;
3081 IK_DOWN, IK_RIGHT, IK_KPDOWN, IK_KPRIGHT, VK_RIGHT, JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT:
3082 if FIndex < High(FItems) then
3083 begin
3084 Inc(FIndex);
3085 if FIndex > FStartLine+FHeight-1 then Inc(FStartLine);
3086 if @FOnChangeEvent <> nil then FOnChangeEvent(Self);
3087 end;
3088 IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK:
3089 with FWindow do
3090 begin
3091 if FActiveControl <> Self then SetActive(Self)
3092 else
3093 if FDefControl <> '' then SetActive(GetControl(FDefControl))
3094 else SetActive(nil);
3095 end;
3096 end;
3097 WM_CHAR:
3098 for a := 0 to High(FItems) do
3099 if (Length(FItems[a]) > 0) and (LowerCase(FItems[a][1]) = LowerCase(Chr(wParam))) then
3100 begin
3101 FIndex := a;
3102 FStartLine := Min(Max(FIndex-1, 0), Length(FItems)-FHeight);
3103 if @FOnChangeEvent <> nil then FOnChangeEvent(Self);
3104 Break;
3105 end;
3106 end;
3107 end;
3109 function TGUIListBox.SelectedItem(): String;
3110 begin
3111 Result := '';
3113 if (FIndex < 0) or (FItems = nil) or
3114 (FIndex > High(FItems)) then
3115 Exit;
3117 Result := FItems[FIndex];
3118 end;
3120 procedure TGUIListBox.FSetItems(Items: SSArray);
3121 begin
3122 if FItems <> nil then
3123 FItems := nil;
3125 FItems := Items;
3127 FStartLine := 0;
3128 FIndex := -1;
3130 if FSort then g_Basic.Sort(FItems);
3131 end;
3133 procedure TGUIListBox.SelectItem(Item: String);
3134 var
3135 a: Integer;
3136 begin
3137 if FItems = nil then
3138 Exit;
3140 FIndex := 0;
3141 Item := LowerCase(Item);
3143 for a := 0 to High(FItems) do
3144 if LowerCase(FItems[a]) = Item then
3145 begin
3146 FIndex := a;
3147 Break;
3148 end;
3150 if FIndex < FHeight then
3151 FStartLine := 0
3152 else
3153 FStartLine := Min(FIndex, Length(FItems)-FHeight);
3154 end;
3156 procedure TGUIListBox.FSetIndex(aIndex: Integer);
3157 begin
3158 if FItems = nil then
3159 Exit;
3161 if (aIndex < 0) or (aIndex > High(FItems)) then
3162 Exit;
3164 FIndex := aIndex;
3166 if FIndex <= FHeight then
3167 FStartLine := 0
3168 else
3169 FStartLine := Min(FIndex, Length(FItems)-FHeight);
3170 end;
3172 { TGUIFileListBox }
3174 procedure TGUIFileListBox.OnMessage(var Msg: TMessage);
3175 var
3176 a, b: Integer;
3177 begin
3178 if not FEnabled then
3179 Exit;
3181 if FItems = nil then
3182 Exit;
3184 with Msg do
3185 case Msg of
3186 WM_KEYDOWN:
3187 case wParam of
3188 IK_HOME, IK_KPHOME:
3189 begin
3190 FIndex := 0;
3191 FStartLine := 0;
3192 if @FOnChangeEvent <> nil then
3193 FOnChangeEvent(Self);
3194 end;
3196 IK_END, IK_KPEND:
3197 begin
3198 FIndex := High(FItems);
3199 FStartLine := Max(High(FItems)-FHeight+1, 0);
3200 if @FOnChangeEvent <> nil then
3201 FOnChangeEvent(Self);
3202 end;
3204 IK_PAGEUP, IK_KPPAGEUP:
3205 begin
3206 if FIndex > FHeight then
3207 FIndex := FIndex-FHeight
3208 else
3209 FIndex := 0;
3211 if FStartLine > FHeight then
3212 FStartLine := FStartLine-FHeight
3213 else
3214 FStartLine := 0;
3215 end;
3217 IK_PAGEDN, IK_KPPAGEDN:
3218 begin
3219 if FIndex < High(FItems)-FHeight then
3220 FIndex := FIndex+FHeight
3221 else
3222 FIndex := High(FItems);
3224 if FStartLine < High(FItems)-FHeight then
3225 FStartLine := FStartLine+FHeight
3226 else
3227 FStartLine := High(FItems)-FHeight+1;
3228 end;
3230 IK_UP, IK_LEFT, IK_KPUP, IK_KPLEFT, VK_UP, VK_LEFT, JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT:
3231 if FIndex > 0 then
3232 begin
3233 Dec(FIndex);
3234 if FIndex < FStartLine then
3235 Dec(FStartLine);
3236 if @FOnChangeEvent <> nil then
3237 FOnChangeEvent(Self);
3238 end;
3240 IK_DOWN, IK_RIGHT, IK_KPDOWN, IK_KPRIGHT, VK_DOWN, VK_RIGHT, JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT:
3241 if FIndex < High(FItems) then
3242 begin
3243 Inc(FIndex);
3244 if FIndex > FStartLine+FHeight-1 then
3245 Inc(FStartLine);
3246 if @FOnChangeEvent <> nil then
3247 FOnChangeEvent(Self);
3248 end;
3250 IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK:
3251 with FWindow do
3252 begin
3253 if FActiveControl <> Self then
3254 SetActive(Self)
3255 else
3256 begin
3257 if FItems[FIndex][1] = #29 then // Ïàïêà
3258 begin
3259 OpenDir(FPath+Copy(FItems[FIndex], 2, 255));
3260 FIndex := 0;
3261 Exit;
3262 end;
3264 if FDefControl <> '' then
3265 SetActive(GetControl(FDefControl))
3266 else
3267 SetActive(nil);
3268 end;
3269 end;
3270 end;
3272 WM_CHAR:
3273 for b := FIndex + 1 to High(FItems) + FIndex do
3274 begin
3275 a := b mod Length(FItems);
3276 if ( (Length(FItems[a]) > 0) and
3277 (LowerCase(FItems[a][1]) = LowerCase(Chr(wParam))) ) or
3278 ( (Length(FItems[a]) > 1) and
3279 (FItems[a][1] = #29) and // Ïàïêà
3280 (LowerCase(FItems[a][2]) = LowerCase(Chr(wParam))) ) then
3281 begin
3282 FIndex := a;
3283 FStartLine := Min(Max(FIndex-1, 0), Length(FItems)-FHeight);
3284 if @FOnChangeEvent <> nil then
3285 FOnChangeEvent(Self);
3286 Break;
3287 end;
3288 end;
3289 end;
3290 end;
3292 procedure TGUIFileListBox.OpenDir(path: String);
3293 var
3294 SR: TSearchRec;
3295 i: Integer;
3296 sm, sc: string;
3297 begin
3298 Clear();
3300 path := IncludeTrailingPathDelimiter(path);
3301 path := ExpandFileName(path);
3303 // Êàòàëîãè:
3304 if FDirs then
3305 begin
3306 if FindFirst(path+'*', faDirectory, SR) = 0 then
3307 repeat
3308 if not LongBool(SR.Attr and faDirectory) then
3309 Continue;
3310 if (SR.Name = '.') or
3311 ((SR.Name = '..') and (path = ExpandFileName(FBasePath))) then
3312 Continue;
3314 AddItem(#1 + SR.Name);
3315 until FindNext(SR) <> 0;
3317 FindClose(SR);
3318 end;
3320 // Ôàéëû:
3321 sm := FFileMask;
3322 while sm <> '' do
3323 begin
3324 i := Pos('|', sm);
3325 if i = 0 then i := length(sm)+1;
3326 sc := Copy(sm, 1, i-1);
3327 Delete(sm, 1, i);
3328 if FindFirst(path+sc, faAnyFile, SR) = 0 then repeat AddItem(SR.Name); until FindNext(SR) <> 0;
3329 FindClose(SR);
3330 end;
3332 for i := 0 to High(FItems) do
3333 if FItems[i][1] = #1 then
3334 FItems[i][1] := #29;
3336 FPath := path;
3337 end;
3339 procedure TGUIFileListBox.SetBase(path: String);
3340 begin
3341 FBasePath := path;
3342 OpenDir(FBasePath);
3343 end;
3345 function TGUIFileListBox.SelectedItem(): String;
3346 begin
3347 Result := '';
3349 if (FIndex = -1) or (FItems = nil) or
3350 (FIndex > High(FItems)) or
3351 (FItems[FIndex][1] = '/') or
3352 (FItems[FIndex][1] = '\') then
3353 Exit;
3355 Result := FPath + FItems[FIndex];
3356 end;
3358 procedure TGUIFileListBox.UpdateFileList();
3359 var
3360 fn: String;
3361 begin
3362 if (FIndex = -1) or (FItems = nil) or
3363 (FIndex > High(FItems)) or
3364 (FItems[FIndex][1] = '/') or
3365 (FItems[FIndex][1] = '\') then
3366 fn := ''
3367 else
3368 fn := FItems[FIndex];
3370 OpenDir(FPath);
3372 if fn <> '' then
3373 SelectItem(fn);
3374 end;
3376 { TGUIMemo }
3378 procedure TGUIMemo.Clear;
3379 begin
3380 FLines := nil;
3381 FStartLine := 0;
3382 end;
3384 constructor TGUIMemo.Create(FontID: DWORD; Width, Height: Word);
3385 begin
3386 inherited Create();
3388 FFont := TFont.Create(FontID, TFontType.Character);
3390 FWidth := Width;
3391 FHeight := Height;
3392 FDrawBack := True;
3393 FDrawScroll := True;
3394 end;
3396 procedure TGUIMemo.Draw;
3397 var
3398 a: Integer;
3399 begin
3400 inherited;
3402 if FDrawBack then DrawBox(FX, FY, FWidth+1, FHeight);
3403 if FDrawScroll then
3404 DrawScroll(FX+4+FWidth*16, FY+4, FHeight, (FStartLine > 0) and (FLines <> nil),
3405 (FStartLine+FHeight-1 < High(FLines)) and (FLines <> nil));
3407 if FLines <> nil then
3408 for a := FStartLine to Min(High(FLines), FStartLine+FHeight-1) do
3409 FFont.Draw(FX+4, FY+4+(a-FStartLine)*16, FLines[a], FColor.R, FColor.G, FColor.B);
3410 end;
3412 function TGUIMemo.GetHeight: Integer;
3413 begin
3414 Result := 8+FHeight*16;
3415 end;
3417 function TGUIMemo.GetWidth: Integer;
3418 begin
3419 Result := 8+(FWidth+1)*16;
3420 end;
3422 procedure TGUIMemo.OnMessage(var Msg: TMessage);
3423 begin
3424 if not FEnabled then Exit;
3426 inherited;
3428 if FLines = nil then Exit;
3430 with Msg do
3431 case Msg of
3432 WM_KEYDOWN:
3433 case wParam of
3434 IK_UP, IK_LEFT, IK_KPUP, IK_KPLEFT, VK_UP, VK_LEFT, JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT:
3435 if FStartLine > 0 then
3436 Dec(FStartLine);
3437 IK_DOWN, IK_RIGHT, IK_KPDOWN, IK_KPRIGHT, VK_DOWN, VK_RIGHT, JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT:
3438 if FStartLine < Length(FLines)-FHeight then
3439 Inc(FStartLine);
3440 IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK:
3441 with FWindow do
3442 begin
3443 if FActiveControl <> Self then
3444 begin
3445 SetActive(Self);
3446 {FStartLine := 0;}
3447 end
3448 else
3449 if FDefControl <> '' then SetActive(GetControl(FDefControl))
3450 else SetActive(nil);
3451 end;
3452 end;
3453 end;
3454 end;
3456 procedure TGUIMemo.SetText(Text: string);
3457 begin
3458 FStartLine := 0;
3459 FLines := GetLines(Text, FFont.ID, FWidth*16);
3460 end;
3462 { TGUIimage }
3464 procedure TGUIimage.ClearImage();
3465 begin
3466 if FImageRes = '' then Exit;
3468 g_Texture_Delete(FImageRes);
3469 FImageRes := '';
3470 end;
3472 constructor TGUIimage.Create();
3473 begin
3474 inherited Create();
3476 FImageRes := '';
3477 end;
3479 destructor TGUIimage.Destroy();
3480 begin
3481 inherited;
3482 end;
3484 procedure TGUIimage.Draw();
3485 var
3486 ID: DWORD;
3487 begin
3488 inherited;
3490 if FImageRes = '' then
3491 begin
3492 if g_Texture_Get(FDefaultRes, ID) then e_Draw(ID, FX, FY, 0, True, False);
3493 end
3494 else
3495 if g_Texture_Get(FImageRes, ID) then e_Draw(ID, FX, FY, 0, True, False);
3496 end;
3498 procedure TGUIimage.OnMessage(var Msg: TMessage);
3499 begin
3500 inherited;
3501 end;
3503 procedure TGUIimage.SetImage(Res: string);
3504 begin
3505 ClearImage();
3507 if g_Texture_CreateWADEx(Res, Res) then FImageRes := Res;
3508 end;
3510 procedure TGUIimage.Update();
3511 begin
3512 inherited;
3513 end;
3515 end.