1 (* Copyright (C) Doom 2D: Forever Developers
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.
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.
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/>.
15 {$INCLUDE ../shared/a_modes.inc}
21 {$IFDEF USE_MEMPOOL}mempool
,{$ENDIF}
22 g_base
, r_graphics
, e_input
, e_log
, g_playermodel
, g_basic
, MAPDEF
, utils
;
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';
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);
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);
55 KEYREAD_QUERY
= '<...>';
56 KEYREAD_CLEAR
= '???';
59 MAPPREVIEW_HEIGHT
= 8;
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';
78 MESSAGE_DIKEY
= WM_USER
+ 1;
87 TFontType
= (Texture
, Character
);
89 TFont
= class{$IFDEF USE_MEMPOOL}(TPoolObject
){$ENDIF}
95 constructor Create(FontID
: DWORD
; FontType
: TFontType
);
96 destructor Destroy
; override;
97 procedure Draw(X
, Y
: Integer; Text: string; R
, G
, B
: Byte);
98 procedure GetTextSize(Text: string; var w
, h
: Word);
99 property Scale
: Single read FScale write FScale
;
105 TOnKeyDownEvent
= procedure(Key
: Byte);
106 TOnKeyDownEventEx
= procedure(win
: TGUIWindow
; Key
: Byte);
107 TOnCloseEvent
= procedure;
108 TOnShowEvent
= procedure;
109 TOnClickEvent
= procedure;
110 TOnChangeEvent
= procedure(Sender
: TGUIControl
);
111 TOnEnterEvent
= procedure(Sender
: TGUIControl
);
113 TGUIControl
= class{$IFDEF USE_MEMPOOL}(TPoolObject
){$ENDIF}
117 FWindow
: TGUIWindow
;
120 FRightAlign
: Boolean; //HACK! this works only for "normal" menus, only for menu text labels, and generally sux. sorry.
121 FMaxWidth
: Integer; //HACK! used for right-aligning labels
124 procedure OnMessage(var Msg
: TMessage
); virtual;
125 procedure Update
; virtual;
126 procedure Draw
; virtual;
127 function GetWidth(): Integer; virtual;
128 function GetHeight(): Integer; virtual;
129 function WantActivationKey (key
: LongInt): Boolean; virtual;
130 property X
: Integer read FX write FX
;
131 property Y
: Integer read FY write FY
;
132 property Enabled
: Boolean read FEnabled write FEnabled
;
133 property Name
: string read FName write FName
;
134 property UserData
: Pointer read FUserData write FUserData
;
135 property RightAlign
: Boolean read FRightAlign write FRightAlign
; // for menu
138 TGUIWindow
= class{$IFDEF USE_MEMPOOL}(TPoolObject
){$ENDIF}
140 FActiveControl
: TGUIControl
;
142 FPrevWindow
: TGUIWindow
;
144 FBackTexture
: string;
145 FMainWindow
: Boolean;
146 FOnKeyDown
: TOnKeyDownEvent
;
147 FOnKeyDownEx
: TOnKeyDownEventEx
;
148 FOnCloseEvent
: TOnCloseEvent
;
149 FOnShowEvent
: TOnShowEvent
;
152 Childs
: array of TGUIControl
;
153 constructor Create(Name
: string);
154 destructor Destroy
; override;
155 function AddChild(Child
: TGUIControl
): TGUIControl
;
156 procedure OnMessage(var Msg
: TMessage
);
159 procedure SetActive(Control
: TGUIControl
);
160 function GetControl(Name
: string): TGUIControl
;
161 property OnKeyDown
: TOnKeyDownEvent read FOnKeyDown write FOnKeyDown
;
162 property OnKeyDownEx
: TOnKeyDownEventEx read FOnKeyDownEx write FOnKeyDownEx
;
163 property OnClose
: TOnCloseEvent read FOnCloseEvent write FOnCloseEvent
;
164 property OnShow
: TOnShowEvent read FOnShowEvent write FOnShowEvent
;
165 property Name
: string read FName
;
166 property DefControl
: string read FDefControl write FDefControl
;
167 property BackTexture
: string read FBackTexture write FBackTexture
;
168 property MainWindow
: Boolean read FMainWindow write FMainWindow
;
169 property UserData
: Pointer read FUserData write FUserData
;
172 TGUITextButton
= class(TGUIControl
)
181 ProcEx
: procedure (sender
: TGUITextButton
);
182 constructor Create(aProc
: Pointer; FontID
: DWORD
; Text: string);
183 destructor Destroy(); override;
184 procedure OnMessage(var Msg
: TMessage
); override;
185 procedure Update(); override;
186 procedure Draw(); override;
187 function GetWidth(): Integer; override;
188 function GetHeight(): Integer; override;
189 procedure Click(Silent
: Boolean = False);
190 property Caption
: string read FText write FText
;
191 property Color
: TRGB read FColor write FColor
;
192 property Font
: TFont read FFont write FFont
;
193 property ShowWindow
: string read FShowWindow write FShowWindow
;
196 TGUILabel
= class(TGUIControl
)
202 FOnClickEvent
: TOnClickEvent
;
204 constructor Create(Text: string; FontID
: DWORD
);
205 procedure OnMessage(var Msg
: TMessage
); override;
206 procedure Draw
; override;
207 function GetWidth
: Integer; override;
208 function GetHeight
: Integer; override;
209 property OnClick
: TOnClickEvent read FOnClickEvent write FOnClickEvent
;
210 property FixedLength
: Word read FFixedLen write FFixedLen
;
211 property Text: string read FText write FText
;
212 property Color
: TRGB read FColor write FColor
;
213 property Font
: TFont read FFont write FFont
;
216 TGUIScroll
= class(TGUIControl
)
224 FOnChangeEvent
: TOnChangeEvent
;
225 procedure FSetValue(a
: Integer);
227 constructor Create();
228 procedure OnMessage(var Msg
: TMessage
); override;
229 procedure Update
; override;
230 procedure Draw
; override;
231 function GetWidth(): Integer; override;
232 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
233 property Max
: Word read FMax write FMax
;
234 property Value
: Integer read FValue write FSetValue
;
237 TGUISwitch
= class(TGUIControl
)
240 FItems
: array of string;
243 FOnChangeEvent
: TOnChangeEvent
;
245 constructor Create(FontID
: DWORD
);
246 procedure OnMessage(var Msg
: TMessage
); override;
247 procedure AddItem(Item
: string);
248 procedure Update
; override;
249 procedure Draw
; override;
250 function GetWidth(): Integer; override;
251 function GetText
: string;
252 property ItemIndex
: Integer read FIndex write FIndex
;
253 property Color
: TRGB read FColor write FColor
;
254 property Font
: TFont read FFont write FFont
;
255 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
258 TGUIEdit
= class(TGUIControl
)
266 FOnlyDigits
: Boolean;
270 FOnChangeEvent
: TOnChangeEvent
;
271 FOnEnterEvent
: TOnEnterEvent
;
273 procedure SetText(Text: string);
275 constructor Create(FontID
: DWORD
);
276 procedure OnMessage(var Msg
: TMessage
); override;
277 procedure Update
; override;
278 procedure Draw
; override;
279 function GetWidth(): Integer; override;
280 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
281 property OnEnter
: TOnEnterEvent read FOnEnterEvent write FOnEnterEvent
;
282 property Width
: Word read FWidth write FWidth
;
283 property MaxLength
: Word read FMaxLength write FMaxLength
;
284 property OnlyDigits
: Boolean read FOnlyDigits write FOnlyDigits
;
285 property Text: string read FText write SetText
;
286 property Color
: TRGB read FColor write FColor
;
287 property Font
: TFont read FFont write FFont
;
288 property Invalid
: Boolean read FInvalid write FInvalid
;
291 TGUIKeyRead
= class(TGUIControl
)
298 constructor Create(FontID
: DWORD
);
299 procedure OnMessage(var Msg
: TMessage
); override;
300 procedure Draw
; override;
301 function GetWidth(): Integer; override;
302 function WantActivationKey (key
: LongInt): Boolean; override;
303 property Key
: Word read FKey write FKey
;
304 property Color
: TRGB read FColor write FColor
;
305 property Font
: TFont read FFont write FFont
;
309 TGUIKeyRead2
= class(TGUIControl
)
314 FKey0
, FKey1
: Word; // this should be an array. sorry.
317 FMaxKeyNameWdt
: Integer;
319 constructor Create(FontID
: DWORD
);
320 procedure OnMessage(var Msg
: TMessage
); override;
321 procedure Draw
; override;
322 function GetWidth(): Integer; override;
323 function WantActivationKey (key
: LongInt): Boolean; override;
324 property Key0
: Word read FKey0 write FKey0
;
325 property Key1
: Word read FKey1 write FKey1
;
326 property Color
: TRGB read FColor write FColor
;
327 property Font
: TFont read FFont write FFont
;
330 TGUIModelView
= class(TGUIControl
)
332 FModel
: TPlayerModel
;
336 destructor Destroy
; override;
337 procedure OnMessage(var Msg
: TMessage
); override;
338 procedure SetModel(ModelName
: string);
339 procedure SetColor(Red
, Green
, Blue
: Byte);
340 procedure NextAnim();
341 procedure NextWeapon();
342 procedure Update
; override;
343 procedure Draw
; override;
344 property Model
: TPlayerModel read FModel
;
347 TPreviewPanel
= record
348 X1
, Y1
, X2
, Y2
: Integer;
352 TGUIMapPreview
= class(TGUIControl
)
354 FMapData
: array of TPreviewPanel
;
358 constructor Create();
359 destructor Destroy(); override;
360 procedure OnMessage(var Msg
: TMessage
); override;
361 procedure SetMap(Res
: string);
362 procedure ClearMap();
363 procedure Update(); override;
364 procedure Draw(); override;
365 function GetScaleStr
: String;
368 TGUIImage
= class(TGUIControl
)
373 constructor Create();
374 destructor Destroy(); override;
375 procedure OnMessage(var Msg
: TMessage
); override;
376 procedure SetImage(Res
: string);
377 procedure ClearImage();
378 procedure Update(); override;
379 procedure Draw(); override;
380 property DefaultRes
: string read FDefaultRes write FDefaultRes
;
383 TGUIListBox
= class(TGUIControl
)
387 FUnActiveColor
: TRGB
;
395 FDrawScroll
: Boolean;
396 FOnChangeEvent
: TOnChangeEvent
;
398 procedure FSetItems(Items
: SSArray
);
399 procedure FSetIndex(aIndex
: Integer);
402 constructor Create(FontID
: DWORD
; Width
, Height
: Word);
403 procedure OnMessage(var Msg
: TMessage
); override;
404 procedure Draw(); override;
405 procedure AddItem(Item
: String);
406 function ItemExists (item
: String): Boolean;
407 procedure SelectItem(Item
: String);
409 function GetWidth(): Integer; override;
410 function GetHeight(): Integer; override;
411 function SelectedItem(): String;
413 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
414 property Sort
: Boolean read FSort write FSort
;
415 property ItemIndex
: Integer read FIndex write FSetIndex
;
416 property Items
: SSArray read FItems write FSetItems
;
417 property DrawBack
: Boolean read FDrawBack write FDrawBack
;
418 property DrawScrollBar
: Boolean read FDrawScroll write FDrawScroll
;
419 property ActiveColor
: TRGB read FActiveColor write FActiveColor
;
420 property UnActiveColor
: TRGB read FUnActiveColor write FUnActiveColor
;
421 property Font
: TFont read FFont write FFont
;
424 TGUIFileListBox
= class(TGUIListBox
)
429 FBaseList
: SSArray
; // highter index have highter priority
434 procedure OnMessage (var Msg
: TMessage
); override;
435 procedure SetBase (dirs
: SSArray
; path
: String = '');
436 function SelectedItem(): String;
437 procedure UpdateFileList
;
439 property Dirs
: Boolean read FDirs write FDirs
;
440 property FileMask
: String read FFileMask write FFileMask
;
443 TGUIMemo
= class(TGUIControl
)
452 FDrawScroll
: Boolean;
454 constructor Create(FontID
: DWORD
; Width
, Height
: Word);
455 procedure OnMessage(var Msg
: TMessage
); override;
456 procedure Draw
; override;
458 function GetWidth(): Integer; override;
459 function GetHeight(): Integer; override;
460 procedure SetText(Text: string);
461 property DrawBack
: Boolean read FDrawBack write FDrawBack
;
462 property DrawScrollBar
: Boolean read FDrawScroll write FDrawScroll
;
463 property Color
: TRGB read FColor write FColor
;
464 property Font
: TFont read FFont write FFont
;
467 TGUIMainMenu
= class(TGUIControl
)
469 FButtons
: array of TGUITextButton
;
478 constructor Create(FontID
: DWORD
; Logo
, Header
: string);
479 destructor Destroy
; override;
480 procedure OnMessage(var Msg
: TMessage
); override;
481 function AddButton(fProc
: Pointer; Caption
: string; ShowWindow
: string = ''): TGUITextButton
;
482 function GetButton(aName
: string): TGUITextButton
;
483 procedure EnableButton(aName
: string; e
: Boolean);
484 procedure AddSpace();
485 procedure Update
; override;
486 procedure Draw
; override;
489 TControlType
= class of TGUIControl
;
491 PMenuItem
= ^TMenuItem
;
494 ControlType
: TControlType
;
495 Control
: TGUIControl
;
498 TGUIMenu
= class(TGUIControl
)
500 FItems
: array of TMenuItem
;
508 function NewItem(): Integer;
510 constructor Create(HeaderFont
, ItemsFont
: DWORD
; Header
: string);
511 destructor Destroy
; override;
512 procedure OnMessage(var Msg
: TMessage
); override;
513 procedure AddSpace();
514 procedure AddLine(fText
: string);
515 procedure AddText(fText
: string; MaxWidth
: Word);
516 function AddLabel(fText
: string): TGUILabel
;
517 function AddButton(Proc
: Pointer; fText
: string; _ShowWindow
: string = ''): TGUITextButton
;
518 function AddScroll(fText
: string): TGUIScroll
;
519 function AddSwitch(fText
: string): TGUISwitch
;
520 function AddEdit(fText
: string): TGUIEdit
;
521 function AddKeyRead(fText
: string): TGUIKeyRead
;
522 function AddKeyRead2(fText
: string): TGUIKeyRead2
;
523 function AddList(fText
: string; Width
, Height
: Word): TGUIListBox
;
524 function AddFileList(fText
: string; Width
, Height
: Word): TGUIFileListBox
;
525 function AddMemo(fText
: string; Width
, Height
: Word): TGUIMemo
;
527 function GetControl(aName
: string): TGUIControl
;
528 function GetControlsText(aName
: string): TGUILabel
;
529 procedure Draw
; override;
530 procedure Update
; override;
531 procedure UpdateIndex();
532 property Align
: Boolean read FAlign write FAlign
;
533 property Left
: Integer read FLeft write FLeft
;
534 property YesNo
: Boolean read FYesNo write FYesNo
;
538 g_GUIWindows
: array of TGUIWindow
;
539 g_ActiveWindow
: TGUIWindow
= nil;
540 g_GUIGrabInput
: Boolean = False;
542 procedure g_GUI_Init();
543 function g_GUI_AddWindow(Window
: TGUIWindow
): TGUIWindow
;
544 function g_GUI_GetWindow(Name
: string): TGUIWindow
;
545 procedure g_GUI_ShowWindow(Name
: string);
546 procedure g_GUI_HideWindow(PlaySound
: Boolean = True);
547 function g_GUI_Destroy(): Boolean;
548 procedure g_GUI_SaveMenuPos();
549 procedure g_GUI_LoadMenuPos();
555 {$IFDEF ENABLE_TOUCH}
558 g_sound
, SysUtils
, e_res
, r_textures
,
559 g_game
, Math
, StrUtils
, g_player
, g_options
, r_playermodel
,
560 g_map
, g_weapons
, xdynrec
, wadreader
;
564 Box
: Array [0..8] of DWORD
;
565 Saved_Windows
: SSArray
;
567 function GetLines (Text: string; FontID
: DWORD
; MaxWidth
: Word): SSArray
;
568 var i
, j
, len
, lines
: Integer;
570 function GetLine (j
, i
: Integer): String;
572 result
:= Copy(text, j
, i
- j
+ 1);
575 function GetWidth (j
, i
: Integer): Integer;
578 e_CharFont_GetSize(FontID
, GetLine(j
, i
), w
, h
);
583 result
:= nil; lines
:= 0;
584 j
:= 1; i
:= 1; len
:= Length(Text);
585 // e_LogWritefln('GetLines @%s len=%s [%s]', [MaxWidth, len, Text]);
588 (* --- Get longest possible sequence --- *)
589 while (i
+ 1 <= len
) and (GetWidth(j
, i
+ 1) <= MaxWidth
) do Inc(i
);
590 (* --- Do not include part of word --- *)
591 if (i
< len
) and (text[i
] <> ' ') then
592 while (i
>= j
) and (text[i
] <> ' ') do Dec(i
);
593 (* --- Do not include spaces --- *)
594 while (i
>= j
) and (text[i
] = ' ') do Dec(i
);
595 (* --- Add line --- *)
596 SetLength(result
, lines
+ 1);
597 result
[lines
] := GetLine(j
, i
);
598 // e_LogWritefln(' -> (%s:%s::%s) [%s]', [j, i, GetWidth(j, i), result[lines]]);
600 (* --- Skip spaces --- *)
601 while (i
<= len
) and (text[i
] = ' ') do Inc(i
);
606 procedure Sort (var a
: SSArray
);
607 var i
, j
: Integer; s
: string;
609 if a
= nil then Exit
;
611 for i
:= High(a
) downto Low(a
) do
612 for j
:= Low(a
) to High(a
) - 1 do
613 if LowerCase(a
[j
]) > LowerCase(a
[j
+ 1]) then
621 procedure g_GUI_Init();
623 g_Texture_Get(BOX1
, Box
[0]);
624 g_Texture_Get(BOX2
, Box
[1]);
625 g_Texture_Get(BOX3
, Box
[2]);
626 g_Texture_Get(BOX4
, Box
[3]);
627 g_Texture_Get(BOX5
, Box
[4]);
628 g_Texture_Get(BOX6
, Box
[5]);
629 g_Texture_Get(BOX7
, Box
[6]);
630 g_Texture_Get(BOX8
, Box
[7]);
631 g_Texture_Get(BOX9
, Box
[8]);
634 function g_GUI_Destroy(): Boolean;
638 Result
:= (Length(g_GUIWindows
) > 0);
640 for i
:= 0 to High(g_GUIWindows
) do
641 g_GUIWindows
[i
].Free();
644 g_ActiveWindow
:= nil;
647 function g_GUI_AddWindow(Window
: TGUIWindow
): TGUIWindow
;
649 SetLength(g_GUIWindows
, Length(g_GUIWindows
)+1);
650 g_GUIWindows
[High(g_GUIWindows
)] := Window
;
655 function g_GUI_GetWindow(Name
: string): TGUIWindow
;
661 if g_GUIWindows
<> nil then
662 for i
:= 0 to High(g_GUIWindows
) do
663 if g_GUIWindows
[i
].FName
= Name
then
665 Result
:= g_GUIWindows
[i
];
669 Assert(Result
<> nil, 'GUI_Window "'+Name
+'" not found');
672 procedure g_GUI_ShowWindow(Name
: string);
676 if g_GUIWindows
= nil then
679 for i
:= 0 to High(g_GUIWindows
) do
680 if g_GUIWindows
[i
].FName
= Name
then
682 g_GUIWindows
[i
].FPrevWindow
:= g_ActiveWindow
;
683 g_ActiveWindow
:= g_GUIWindows
[i
];
685 if g_ActiveWindow
.MainWindow
then
686 g_ActiveWindow
.FPrevWindow
:= nil;
688 if g_ActiveWindow
.FDefControl
<> '' then
689 g_ActiveWindow
.SetActive(g_ActiveWindow
.GetControl(g_ActiveWindow
.FDefControl
))
691 g_ActiveWindow
.SetActive(nil);
693 if @g_ActiveWindow
.FOnShowEvent
<> nil then
694 g_ActiveWindow
.FOnShowEvent();
700 procedure g_GUI_HideWindow(PlaySound
: Boolean = True);
702 if g_ActiveWindow
<> nil then
704 if @g_ActiveWindow
.OnClose
<> nil then
705 g_ActiveWindow
.OnClose();
706 g_ActiveWindow
:= g_ActiveWindow
.FPrevWindow
;
708 g_Sound_PlayEx(WINDOW_CLOSESOUND
);
712 procedure g_GUI_SaveMenuPos();
717 SetLength(Saved_Windows
, 0);
718 win
:= g_ActiveWindow
;
722 len
:= Length(Saved_Windows
);
723 SetLength(Saved_Windows
, len
+ 1);
725 Saved_Windows
[len
] := win
.Name
;
727 if win
.MainWindow
then
730 win
:= win
.FPrevWindow
;
734 procedure g_GUI_LoadMenuPos();
736 i
, j
, k
, len
: Integer;
739 g_ActiveWindow
:= nil;
740 len
:= Length(Saved_Windows
);
745 // Îêíî ñ ãëàâíûì ìåíþ:
746 g_GUI_ShowWindow(Saved_Windows
[len
-1]);
748 // Íå ïåðåêëþ÷èëîñü (èëè íåêóäà äàëüøå):
749 if (len
= 1) or (g_ActiveWindow
= nil) then
752 // Èùåì êíîïêè â îñòàëüíûõ îêíàõ:
753 for k
:= len
-1 downto 1 do
757 for i
:= 0 to Length(g_ActiveWindow
.Childs
)-1 do
759 if g_ActiveWindow
.Childs
[i
] is TGUIMainMenu
then
760 begin // GUI_MainMenu
761 with TGUIMainMenu(g_ActiveWindow
.Childs
[i
]) do
762 for j
:= 0 to Length(FButtons
)-1 do
763 if FButtons
[j
].ShowWindow
= Saved_Windows
[k
-1] then
765 FButtons
[j
].Click(True);
771 if g_ActiveWindow
.Childs
[i
] is TGUIMenu
then
772 with TGUIMenu(g_ActiveWindow
.Childs
[i
]) do
773 for j
:= 0 to Length(FItems
)-1 do
774 if FItems
[j
].ControlType
= TGUITextButton
then
775 if TGUITextButton(FItems
[j
].Control
).ShowWindow
= Saved_Windows
[k
-1] then
777 TGUITextButton(FItems
[j
].Control
).Click(True);
788 (g_ActiveWindow
.Name
= Saved_Windows
[k
]) then
793 procedure DrawBox(X
, Y
: Integer; Width
, Height
: Word);
795 e_Draw(Box
[0], X
, Y
, 0, False, False);
796 e_DrawFill(Box
[1], X
+4, Y
, Width
*4, 1, 0, False, False);
797 e_Draw(Box
[2], X
+4+Width
*16, Y
, 0, False, False);
798 e_DrawFill(Box
[3], X
, Y
+4, 1, Height
*4, 0, False, False);
799 e_DrawFill(Box
[4], X
+4, Y
+4, Width
, Height
, 0, False, False);
800 e_DrawFill(Box
[5], X
+4+Width
*16, Y
+4, 1, Height
*4, 0, False, False);
801 e_Draw(Box
[6], X
, Y
+4+Height
*16, 0, False, False);
802 e_DrawFill(Box
[7], X
+4, Y
+4+Height
*16, Width
*4, 1, 0, False, False);
803 e_Draw(Box
[8], X
+4+Width
*16, Y
+4+Height
*16, 0, False, False);
806 procedure DrawScroll(X
, Y
: Integer; Height
: Word; Up
, Down
: Boolean);
810 if Height
< 3 then Exit
;
813 g_Texture_Get(BSCROLL_UPA
, ID
)
815 g_Texture_Get(BSCROLL_UPU
, ID
);
816 e_Draw(ID
, X
, Y
, 0, False, False);
819 g_Texture_Get(BSCROLL_DOWNA
, ID
)
821 g_Texture_Get(BSCROLL_DOWNU
, ID
);
822 e_Draw(ID
, X
, Y
+(Height
-1)*16, 0, False, False);
824 g_Texture_Get(BSCROLL_MIDDLE
, ID
);
825 e_DrawFill(ID
, X
, Y
+16, 1, Height
-2, 0, False, False);
830 constructor TGUIWindow
.Create(Name
: string);
833 FActiveControl
:= nil;
837 FOnCloseEvent
:= nil;
841 destructor TGUIWindow
.Destroy
;
848 for i
:= 0 to High(Childs
) do
852 function TGUIWindow
.AddChild(Child
: TGUIControl
): TGUIControl
;
854 Child
.FWindow
:= Self
;
856 SetLength(Childs
, Length(Childs
) + 1);
857 Childs
[High(Childs
)] := Child
;
862 procedure TGUIWindow
.Update
;
866 for i
:= 0 to High(Childs
) do
867 if Childs
[i
] <> nil then Childs
[i
].Update
;
870 procedure TGUIWindow
.Draw
;
876 if FBackTexture
<> '' then // Here goes code duplication from g_game.pas:DrawMenuBackground()
877 if g_Texture_Get(FBackTexture
, ID
) then
880 e_GetTextureSize(ID
, @tw
, @th
);
882 tw
:= round(tw
* 1.333 * (gScreenHeight
/ th
))
884 tw
:= trunc(tw
* (gScreenHeight
/ th
));
885 e_DrawSize(ID
, (gScreenWidth
- tw
) div 2, 0, 0, False, False, tw
, gScreenHeight
);
888 e_Clear(0.5, 0.5, 0.5);
891 if FName
= 'AuthorsMenu' then
892 e_DarkenQuadWH(0, 0, gScreenWidth
, gScreenHeight
, 150);
894 for i
:= 0 to High(Childs
) do
895 if Childs
[i
] <> nil then Childs
[i
].Draw
;
898 procedure TGUIWindow
.OnMessage(var Msg
: TMessage
);
900 if FActiveControl
<> nil then FActiveControl
.OnMessage(Msg
);
901 if @FOnKeyDown
<> nil then FOnKeyDown(Msg
.wParam
);
902 if @FOnKeyDownEx
<> nil then FOnKeyDownEx(self
, Msg
.wParam
);
904 if Msg
.Msg
= WM_KEYDOWN
then
916 procedure TGUIWindow
.SetActive(Control
: TGUIControl
);
918 FActiveControl
:= Control
;
921 function TGUIWindow
.GetControl(Name
: String): TGUIControl
;
927 if Childs
<> nil then
928 for i
:= 0 to High(Childs
) do
929 if Childs
[i
] <> nil then
930 if LowerCase(Childs
[i
].FName
) = LowerCase(Name
) then
936 Assert(Result
<> nil, 'Window Control "'+Name
+'" not Found!');
941 constructor TGUIControl
.Create();
947 FRightAlign
:= false;
951 procedure TGUIControl
.OnMessage(var Msg
: TMessage
);
957 procedure TGUIControl
.Update();
961 procedure TGUIControl
.Draw();
965 function TGUIControl
.WantActivationKey (key
: LongInt): Boolean;
970 function TGUIControl
.GetWidth(): Integer;
975 function TGUIControl
.GetHeight(): Integer;
982 procedure TGUITextButton
.Click(Silent
: Boolean = False);
984 if (FSound
<> '') and (not Silent
) then g_Sound_PlayEx(FSound
);
986 if @Proc
<> nil then Proc();
987 if @ProcEx
<> nil then ProcEx(self
);
989 if FShowWindow
<> '' then g_GUI_ShowWindow(FShowWindow
);
992 constructor TGUITextButton
.Create(aProc
: Pointer; FontID
: DWORD
; Text: string);
999 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
1004 destructor TGUITextButton
.Destroy
;
1010 procedure TGUITextButton
.Draw
;
1012 FFont
.Draw(FX
, FY
, FText
, FColor
.R
, FColor
.G
, FColor
.B
)
1015 function TGUITextButton
.GetHeight
: Integer;
1019 FFont
.GetTextSize(FText
, w
, h
);
1023 function TGUITextButton
.GetWidth
: Integer;
1027 FFont
.GetTextSize(FText
, w
, h
);
1031 procedure TGUITextButton
.OnMessage(var Msg
: TMessage
);
1033 if not FEnabled
then Exit
;
1040 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
: Click();
1045 procedure TGUITextButton
.Update
;
1052 constructor TFont
.Create(FontID
: DWORD
; FontType
: TFontType
);
1057 FFontType
:= FontType
;
1060 destructor TFont
.Destroy
;
1066 procedure TFont
.Draw(X
, Y
: Integer; Text: string; R
, G
, B
: Byte);
1068 if FFontType
= TFontType
.Character
then e_CharFont_PrintEx(ID
, X
, Y
, Text, _RGB(R
, G
, B
), FScale
)
1069 else e_TextureFontPrintEx(X
, Y
, Text, ID
, R
, G
, B
, FScale
);
1072 procedure TFont
.GetTextSize(Text: string; var w
, h
: Word);
1076 if FFontType
= TFontType
.Character
then e_CharFont_GetSize(ID
, Text, w
, h
)
1079 e_TextureFontGetSize(ID
, cw
, ch
);
1080 w
:= cw
*Length(Text);
1084 w
:= Round(w
*FScale
);
1085 h
:= Round(h
*FScale
);
1090 function TGUIMainMenu
.AddButton(fProc
: Pointer; Caption
: string; ShowWindow
: string = ''): TGUITextButton
;
1098 SetLength(FButtons
, Length(FButtons
)+1);
1099 FButtons
[High(FButtons
)] := TGUITextButton
.Create(fProc
, FFontID
, Caption
);
1100 FButtons
[High(FButtons
)].ShowWindow
:= ShowWindow
;
1101 with FButtons
[High(FButtons
)] do
1103 if (fProc
<> nil) or (ShowWindow
<> '') then FColor
:= MAINMENU_ITEMS_COLOR
1104 else FColor
:= MAINMENU_UNACTIVEITEMS_COLOR
;
1105 FSound
:= MAINMENU_CLICKSOUND
;
1108 _x
:= gScreenWidth
div 2;
1110 for a
:= 0 to High(FButtons
) do
1111 if FButtons
[a
] <> nil then
1112 _x
:= Min(_x
, (gScreenWidth
div 2)-(FButtons
[a
].GetWidth
div 2));
1114 if FLogo
<> 0 then e_GetTextureSize(FLogo
, nil, @lh
);
1115 hh
:= FButtons
[High(FButtons
)].GetHeight
;
1117 if FLogo
<> 0 then h
:= lh
+ hh
* (1 + Length(FButtons
)) + MAINMENU_SPACE
* (Length(FButtons
) - 1)
1118 else h
:= hh
* (2 + Length(FButtons
)) + MAINMENU_SPACE
* (Length(FButtons
) - 1);
1119 h
:= (gScreenHeight
div 2) - (h
div 2);
1121 if FHeader
<> nil then with FHeader
do
1127 if FLogo
<> 0 then Inc(h
, lh
)
1130 for a
:= 0 to High(FButtons
) do
1132 if FButtons
[a
] <> nil then
1139 Inc(h
, hh
+MAINMENU_SPACE
);
1142 Result
:= FButtons
[High(FButtons
)];
1145 procedure TGUIMainMenu
.AddSpace
;
1147 SetLength(FButtons
, Length(FButtons
)+1);
1148 FButtons
[High(FButtons
)] := nil;
1151 constructor TGUIMainMenu
.Create(FontID
: DWORD
; Logo
, Header
: string);
1157 FCounter
:= MAINMENU_MARKERDELAY
;
1159 g_Texture_Get(MAINMENU_MARKER1
, FMarkerID1
);
1160 g_Texture_Get(MAINMENU_MARKER2
, FMarkerID2
);
1162 if not g_Texture_Get(Logo
, FLogo
) then
1164 FHeader
:= TGUILabel
.Create(Header
, FFontID
);
1167 FColor
:= MAINMENU_HEADER_COLOR
;
1168 FX
:= (gScreenWidth
div 2)-(GetWidth
div 2);
1169 FY
:= (gScreenHeight
div 2)-(GetHeight
div 2);
1174 destructor TGUIMainMenu
.Destroy
;
1178 if FButtons
<> nil then
1179 for a
:= 0 to High(FButtons
) do
1187 procedure TGUIMainMenu
.Draw
;
1195 if FHeader
<> nil then FHeader
.Draw
1197 e_GetTextureSize(FLogo
, @w
, @h
);
1198 e_Draw(FLogo
, ((gScreenWidth
div 2) - (w
div 2)), FButtons
[0].FY
- FButtons
[0].GetHeight
- h
, 0, True, False);
1201 if FButtons
<> nil then
1203 for a
:= 0 to High(FButtons
) do
1204 if FButtons
[a
] <> nil then FButtons
[a
].Draw
;
1206 if FIndex
<> -1 then
1207 e_Draw(FMarkerID1
, FButtons
[FIndex
].FX
-48, FButtons
[FIndex
].FY
, 0, True, False);
1211 procedure TGUIMainMenu
.EnableButton(aName
: string; e
: Boolean);
1215 if FButtons
= nil then Exit
;
1217 for a
:= 0 to High(FButtons
) do
1218 if (FButtons
[a
] <> nil) and (FButtons
[a
].Name
= aName
) then
1220 if e
then FButtons
[a
].FColor
:= MAINMENU_ITEMS_COLOR
1221 else FButtons
[a
].FColor
:= MAINMENU_UNACTIVEITEMS_COLOR
;
1222 FButtons
[a
].Enabled
:= e
;
1227 function TGUIMainMenu
.GetButton(aName
: string): TGUITextButton
;
1233 if FButtons
= nil then Exit
;
1235 for a
:= 0 to High(FButtons
) do
1236 if (FButtons
[a
] <> nil) and (FButtons
[a
].Name
= aName
) then
1238 Result
:= FButtons
[a
];
1243 procedure TGUIMainMenu
.OnMessage(var Msg
: TMessage
);
1248 if not FEnabled
then Exit
;
1252 if FButtons
= nil then Exit
;
1255 for a
:= 0 to High(FButtons
) do
1256 if FButtons
[a
] <> nil then
1262 if not ok
then Exit
;
1267 IK_UP
, IK_KPUP
, VK_UP
, JOY0_UP
, JOY1_UP
, JOY2_UP
, JOY3_UP
:
1271 if FIndex
< 0 then FIndex
:= High(FButtons
);
1272 until FButtons
[FIndex
] <> nil;
1274 g_Sound_PlayEx(MENU_CHANGESOUND
);
1276 IK_DOWN
, IK_KPDOWN
, VK_DOWN
, JOY0_DOWN
, JOY1_DOWN
, JOY2_DOWN
, JOY3_DOWN
:
1280 if FIndex
> High(FButtons
) then FIndex
:= 0;
1281 until FButtons
[FIndex
] <> nil;
1283 g_Sound_PlayEx(MENU_CHANGESOUND
);
1285 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
;
1290 procedure TGUIMainMenu
.Update
;
1296 if FCounter
= 0 then
1299 FMarkerID1
:= FMarkerID2
;
1302 FCounter
:= MAINMENU_MARKERDELAY
;
1303 end else Dec(FCounter
);
1308 constructor TGUILabel
.Create(Text: string; FontID
: DWORD
);
1312 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
1316 FOnClickEvent
:= nil;
1319 procedure TGUILabel
.Draw
;
1325 FFont
.GetTextSize(FText
, w
, h
);
1326 FFont
.Draw(FX
+FMaxWidth
-w
, FY
, FText
, FColor
.R
, FColor
.G
, FColor
.B
);
1330 FFont
.Draw(FX
, FY
, FText
, FColor
.R
, FColor
.G
, FColor
.B
);
1334 function TGUILabel
.GetHeight
: Integer;
1338 FFont
.GetTextSize(FText
, w
, h
);
1342 function TGUILabel
.GetWidth
: Integer;
1346 if FFixedLen
= 0 then
1347 FFont
.GetTextSize(FText
, w
, h
)
1349 w
:= e_CharFont_GetMaxWidth(FFont
.ID
)*FFixedLen
;
1353 procedure TGUILabel
.OnMessage(var Msg
: TMessage
);
1355 if not FEnabled
then Exit
;
1362 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
: if @FOnClickEvent
<> nil then FOnClickEvent();
1369 function TGUIMenu
.AddButton(Proc
: Pointer; fText
: string; _ShowWindow
: string = ''): TGUITextButton
;
1376 Control
:= TGUITextButton
.Create(Proc
, FFontID
, fText
);
1377 with Control
as TGUITextButton
do
1379 ShowWindow
:= _ShowWindow
;
1380 FColor
:= MENU_ITEMSCTRL_COLOR
;
1384 ControlType
:= TGUITextButton
;
1386 Result
:= (Control
as TGUITextButton
);
1389 if FIndex
= -1 then FIndex
:= i
;
1394 procedure TGUIMenu
.AddLine(fText
: string);
1401 Text := TGUILabel
.Create(fText
, FFontID
);
1404 FColor
:= MENU_ITEMSTEXT_COLOR
;
1413 procedure TGUIMenu
.AddText(fText
: string; MaxWidth
: Word);
1418 l
:= GetLines(fText
, FFontID
, MaxWidth
);
1420 if l
= nil then Exit
;
1422 for a
:= 0 to High(l
) do
1427 Text := TGUILabel
.Create(l
[a
], FFontID
);
1430 with Text do begin FColor
:= _RGB(255, 0, 0); end;
1434 with Text do begin FColor
:= MENU_ITEMSTEXT_COLOR
; end;
1444 procedure TGUIMenu
.AddSpace
;
1458 constructor TGUIMenu
.Create(HeaderFont
, ItemsFont
: DWORD
; Header
: string);
1464 FFontID
:= ItemsFont
;
1465 FCounter
:= MENU_MARKERDELAY
;
1469 FHeader
:= TGUILabel
.Create(Header
, HeaderFont
);
1472 FX
:= (gScreenWidth
div 2)-(GetWidth
div 2);
1474 FColor
:= MAINMENU_HEADER_COLOR
;
1478 destructor TGUIMenu
.Destroy
;
1482 if FItems
<> nil then
1483 for a
:= 0 to High(FItems
) do
1497 procedure TGUIMenu
.Draw
;
1499 a
, locx
, locy
: Integer;
1503 if FHeader
<> nil then FHeader
.Draw
;
1505 if FItems
<> nil then
1506 for a
:= 0 to High(FItems
) do
1508 if FItems
[a
].Text <> nil then FItems
[a
].Text.Draw
;
1509 if FItems
[a
].Control
<> nil then FItems
[a
].Control
.Draw
;
1512 if (FIndex
<> -1) and (FCounter
> MENU_MARKERDELAY
div 2) then
1517 if FItems
[FIndex
].Text <> nil then
1519 locx
:= FItems
[FIndex
].Text.FX
;
1520 locy
:= FItems
[FIndex
].Text.FY
;
1522 if FItems
[FIndex
].Text.RightAlign
then
1524 locx
:= locx
+FItems
[FIndex
].Text.FMaxWidth
-FItems
[FIndex
].Text.GetWidth
;
1527 else if FItems
[FIndex
].Control
<> nil then
1529 locx
:= FItems
[FIndex
].Control
.FX
;
1530 locy
:= FItems
[FIndex
].Control
.FY
;
1533 locx
:= locx
-e_CharFont_GetMaxWidth(FFontID
);
1535 e_CharFont_PrintEx(FFontID
, locx
, locy
, #16, _RGB(255, 0, 0));
1539 function TGUIMenu
.GetControl(aName
: String): TGUIControl
;
1545 if FItems
<> nil then
1546 for a
:= 0 to High(FItems
) do
1547 if FItems
[a
].Control
<> nil then
1548 if LowerCase(FItems
[a
].Control
.Name
) = LowerCase(aName
) then
1550 Result
:= FItems
[a
].Control
;
1554 Assert(Result
<> nil, 'GUI control "'+aName
+'" not found!');
1557 function TGUIMenu
.GetControlsText(aName
: String): TGUILabel
;
1563 if FItems
<> nil then
1564 for a
:= 0 to High(FItems
) do
1565 if FItems
[a
].Control
<> nil then
1566 if LowerCase(FItems
[a
].Control
.Name
) = LowerCase(aName
) then
1568 Result
:= FItems
[a
].Text;
1572 Assert(Result
<> nil, 'GUI control''s text "'+aName
+'" not found!');
1575 function TGUIMenu
.NewItem
: Integer;
1577 SetLength(FItems
, Length(FItems
)+1);
1578 Result
:= High(FItems
);
1581 procedure TGUIMenu
.OnMessage(var Msg
: TMessage
);
1586 if not FEnabled
then Exit
;
1590 if FItems
= nil then Exit
;
1593 for a
:= 0 to High(FItems
) do
1594 if FItems
[a
].Control
<> nil then
1600 if not ok
then Exit
;
1602 if (Msg
.Msg
= WM_KEYDOWN
) and (FIndex
<> -1) and (FItems
[FIndex
].Control
<> nil) and
1603 (FItems
[FIndex
].Control
.WantActivationKey(Msg
.wParam
)) then
1605 FItems
[FIndex
].Control
.OnMessage(Msg
);
1606 g_Sound_PlayEx(MENU_CLICKSOUND
);
1614 IK_UP
, IK_KPUP
, VK_UP
,JOY0_UP
, JOY1_UP
, JOY2_UP
, JOY3_UP
:
1619 if c
> Length(FItems
) then
1626 if FIndex
< 0 then FIndex
:= High(FItems
);
1627 until (FItems
[FIndex
].Control
<> nil) and
1628 (FItems
[FIndex
].Control
.Enabled
);
1632 g_Sound_PlayEx(MENU_CHANGESOUND
);
1635 IK_DOWN
, IK_KPDOWN
, VK_DOWN
, JOY0_DOWN
, JOY1_DOWN
, JOY2_DOWN
, JOY3_DOWN
:
1640 if c
> Length(FItems
) then
1647 if FIndex
> High(FItems
) then FIndex
:= 0;
1648 until (FItems
[FIndex
].Control
<> nil) and
1649 (FItems
[FIndex
].Control
.Enabled
);
1653 g_Sound_PlayEx(MENU_CHANGESOUND
);
1656 IK_LEFT
, IK_RIGHT
, IK_KPLEFT
, IK_KPRIGHT
, VK_LEFT
, VK_RIGHT
,
1657 JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
,
1658 JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
1660 if FIndex
<> -1 then
1661 if FItems
[FIndex
].Control
<> nil then
1662 FItems
[FIndex
].Control
.OnMessage(Msg
);
1664 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
1666 if FIndex
<> -1 then
1668 if FItems
[FIndex
].Control
<> nil then FItems
[FIndex
].Control
.OnMessage(Msg
);
1670 g_Sound_PlayEx(MENU_CLICKSOUND
);
1674 if FYesNo
and (length(FItems
) > 1) then
1676 Msg
.wParam
:= IK_RETURN
; // to register keypress
1677 FIndex
:= High(FItems
)-1;
1678 if FItems
[FIndex
].Control
<> nil then FItems
[FIndex
].Control
.OnMessage(Msg
);
1681 if FYesNo
and (length(FItems
) > 1) then
1683 Msg
.wParam
:= IK_RETURN
; // to register keypress
1684 FIndex
:= High(FItems
);
1685 if FItems
[FIndex
].Control
<> nil then FItems
[FIndex
].Control
.OnMessage(Msg
);
1692 procedure TGUIMenu
.ReAlign();
1694 a
, tx
, cx
, w
, h
: Integer;
1695 cww
: array of Integer; // cached widths
1698 if FItems
= nil then Exit
;
1700 SetLength(cww
, length(FItems
));
1702 for a
:= 0 to High(FItems
) do
1704 if FItems
[a
].Text <> nil then
1706 cww
[a
] := FItems
[a
].Text.GetWidth
;
1707 if maxcww
< cww
[a
] then maxcww
:= cww
[a
];
1718 for a
:= 0 to High(FItems
) do
1721 if FItems
[a
].Text <> nil then w
:= FItems
[a
].Text.GetWidth
;
1722 if FItems
[a
].Control
<> nil then
1725 if FItems
[a
].ControlType
= TGUILabel
then w
:= w
+(FItems
[a
].Control
as TGUILabel
).GetWidth
1726 else if FItems
[a
].ControlType
= TGUITextButton
then w
:= w
+(FItems
[a
].Control
as TGUITextButton
).GetWidth
1727 else if FItems
[a
].ControlType
= TGUIScroll
then w
:= w
+(FItems
[a
].Control
as TGUIScroll
).GetWidth
1728 else if FItems
[a
].ControlType
= TGUISwitch
then w
:= w
+(FItems
[a
].Control
as TGUISwitch
).GetWidth
1729 else if FItems
[a
].ControlType
= TGUIEdit
then w
:= w
+(FItems
[a
].Control
as TGUIEdit
).GetWidth
1730 else if FItems
[a
].ControlType
= TGUIKeyRead
then w
:= w
+(FItems
[a
].Control
as TGUIKeyRead
).GetWidth
1731 else if FItems
[a
].ControlType
= TGUIKeyRead2
then w
:= w
+(FItems
[a
].Control
as TGUIKeyRead2
).GetWidth
1732 else if FItems
[a
].ControlType
= TGUIListBox
then w
:= w
+(FItems
[a
].Control
as TGUIListBox
).GetWidth
1733 else if FItems
[a
].ControlType
= TGUIFileListBox
then w
:= w
+(FItems
[a
].Control
as TGUIFileListBox
).GetWidth
1734 else if FItems
[a
].ControlType
= TGUIMemo
then w
:= w
+(FItems
[a
].Control
as TGUIMemo
).GetWidth
;
1736 tx
:= Min(tx
, (gScreenWidth
div 2)-(w
div 2));
1741 for a
:= 0 to High(FItems
) do
1745 if (Text <> nil) and (Control
= nil) then Continue
;
1747 if Text <> nil then w
:= tx
+Text.GetWidth
;
1748 if w
> cx
then cx
:= w
;
1752 cx
:= cx
+MENU_HSPACE
;
1754 h
:= FHeader
.GetHeight
*2+MENU_VSPACE
*(Length(FItems
)-1);
1756 for a
:= 0 to High(FItems
) do
1760 if (ControlType
= TGUIListBox
) or (ControlType
= TGUIFileListBox
) then
1761 h
:= h
+(FItems
[a
].Control
as TGUIListBox
).GetHeight()
1763 h
:= h
+e_CharFont_GetMaxHeight(FFontID
);
1767 h
:= (gScreenHeight
div 2)-(h
div 2);
1771 FX
:= (gScreenWidth
div 2)-(GetWidth
div 2);
1774 Inc(h
, GetHeight
*2);
1777 for a
:= 0 to High(FItems
) do
1789 if Text.RightAlign
and (length(cww
) > a
) then
1791 //Text.FX := Text.FX+maxcww;
1792 Text.FMaxWidth
:= maxcww
;
1796 if Control
<> nil then
1813 if (ControlType
= TGUIListBox
) or (ControlType
= TGUIFileListBox
) then Inc(h
, (Control
as TGUIListBox
).GetHeight
+MENU_VSPACE
)
1814 else if ControlType
= TGUIMemo
then Inc(h
, (Control
as TGUIMemo
).GetHeight
+MENU_VSPACE
)
1815 else Inc(h
, e_CharFont_GetMaxHeight(FFontID
)+MENU_VSPACE
);
1819 // another ugly hack
1820 if FYesNo
and (length(FItems
) > 1) then
1823 for a
:= High(FItems
)-1 to High(FItems
) do
1825 if (FItems
[a
].Control
<> nil) and (FItems
[a
].ControlType
= TGUITextButton
) then
1827 cx
:= (FItems
[a
].Control
as TGUITextButton
).GetWidth
;
1828 if cx
> w
then w
:= cx
;
1833 for a
:= High(FItems
)-1 to High(FItems
) do
1835 if (FItems
[a
].Control
<> nil) and (FItems
[a
].ControlType
= TGUITextButton
) then
1837 FItems
[a
].Control
.FX
:= (gScreenWidth
-w
) div 2;
1844 function TGUIMenu
.AddScroll(fText
: string): TGUIScroll
;
1851 Control
:= TGUIScroll
.Create();
1853 Text := TGUILabel
.Create(fText
, FFontID
);
1856 FColor
:= MENU_ITEMSTEXT_COLOR
;
1859 ControlType
:= TGUIScroll
;
1861 Result
:= (Control
as TGUIScroll
);
1864 if FIndex
= -1 then FIndex
:= i
;
1869 function TGUIMenu
.AddSwitch(fText
: string): TGUISwitch
;
1876 Control
:= TGUISwitch
.Create(FFontID
);
1877 (Control
as TGUISwitch
).FColor
:= MENU_ITEMSCTRL_COLOR
;
1879 Text := TGUILabel
.Create(fText
, FFontID
);
1882 FColor
:= MENU_ITEMSTEXT_COLOR
;
1885 ControlType
:= TGUISwitch
;
1887 Result
:= (Control
as TGUISwitch
);
1890 if FIndex
= -1 then FIndex
:= i
;
1895 function TGUIMenu
.AddEdit(fText
: string): TGUIEdit
;
1902 Control
:= TGUIEdit
.Create(FFontID
);
1903 with Control
as TGUIEdit
do
1905 FWindow
:= Self
.FWindow
;
1906 FColor
:= MENU_ITEMSCTRL_COLOR
;
1909 if fText
= '' then Text := nil else
1911 Text := TGUILabel
.Create(fText
, FFontID
);
1912 Text.FColor
:= MENU_ITEMSTEXT_COLOR
;
1915 ControlType
:= TGUIEdit
;
1917 Result
:= (Control
as TGUIEdit
);
1920 if FIndex
= -1 then FIndex
:= i
;
1925 procedure TGUIMenu
.Update
;
1931 if FCounter
= 0 then FCounter
:= MENU_MARKERDELAY
else Dec(FCounter
);
1933 if FItems
<> nil then
1934 for a
:= 0 to High(FItems
) do
1935 if FItems
[a
].Control
<> nil then
1936 (FItems
[a
].Control
as FItems
[a
].ControlType
).Update
;
1939 function TGUIMenu
.AddKeyRead(fText
: string): TGUIKeyRead
;
1946 Control
:= TGUIKeyRead
.Create(FFontID
);
1947 with Control
as TGUIKeyRead
do
1949 FWindow
:= Self
.FWindow
;
1950 FColor
:= MENU_ITEMSCTRL_COLOR
;
1953 Text := TGUILabel
.Create(fText
, FFontID
);
1956 FColor
:= MENU_ITEMSTEXT_COLOR
;
1959 ControlType
:= TGUIKeyRead
;
1961 Result
:= (Control
as TGUIKeyRead
);
1964 if FIndex
= -1 then FIndex
:= i
;
1969 function TGUIMenu
.AddKeyRead2(fText
: string): TGUIKeyRead2
;
1976 Control
:= TGUIKeyRead2
.Create(FFontID
);
1977 with Control
as TGUIKeyRead2
do
1979 FWindow
:= Self
.FWindow
;
1980 FColor
:= MENU_ITEMSCTRL_COLOR
;
1983 Text := TGUILabel
.Create(fText
, FFontID
);
1986 FColor
:= MENU_ITEMSCTRL_COLOR
; //MENU_ITEMSTEXT_COLOR;
1990 ControlType
:= TGUIKeyRead2
;
1992 Result
:= (Control
as TGUIKeyRead2
);
1995 if FIndex
= -1 then FIndex
:= i
;
2000 function TGUIMenu
.AddList(fText
: string; Width
, Height
: Word): TGUIListBox
;
2007 Control
:= TGUIListBox
.Create(FFontID
, Width
, Height
);
2008 with Control
as TGUIListBox
do
2010 FWindow
:= Self
.FWindow
;
2011 FActiveColor
:= MENU_ITEMSCTRL_COLOR
;
2012 FUnActiveColor
:= MENU_ITEMSTEXT_COLOR
;
2015 Text := TGUILabel
.Create(fText
, FFontID
);
2018 FColor
:= MENU_ITEMSTEXT_COLOR
;
2021 ControlType
:= TGUIListBox
;
2023 Result
:= (Control
as TGUIListBox
);
2026 if FIndex
= -1 then FIndex
:= i
;
2031 function TGUIMenu
.AddFileList(fText
: string; Width
, Height
: Word): TGUIFileListBox
;
2038 Control
:= TGUIFileListBox
.Create(FFontID
, Width
, Height
);
2039 with Control
as TGUIFileListBox
do
2041 FWindow
:= Self
.FWindow
;
2042 FActiveColor
:= MENU_ITEMSCTRL_COLOR
;
2043 FUnActiveColor
:= MENU_ITEMSTEXT_COLOR
;
2046 if fText
= '' then Text := nil else
2048 Text := TGUILabel
.Create(fText
, FFontID
);
2049 Text.FColor
:= MENU_ITEMSTEXT_COLOR
;
2052 ControlType
:= TGUIFileListBox
;
2054 Result
:= (Control
as TGUIFileListBox
);
2057 if FIndex
= -1 then FIndex
:= i
;
2062 function TGUIMenu
.AddLabel(fText
: string): TGUILabel
;
2069 Control
:= TGUILabel
.Create('', FFontID
);
2070 with Control
as TGUILabel
do
2072 FWindow
:= Self
.FWindow
;
2073 FColor
:= MENU_ITEMSCTRL_COLOR
;
2076 Text := TGUILabel
.Create(fText
, FFontID
);
2079 FColor
:= MENU_ITEMSTEXT_COLOR
;
2082 ControlType
:= TGUILabel
;
2084 Result
:= (Control
as TGUILabel
);
2087 if FIndex
= -1 then FIndex
:= i
;
2092 function TGUIMenu
.AddMemo(fText
: string; Width
, Height
: Word): TGUIMemo
;
2099 Control
:= TGUIMemo
.Create(FFontID
, Width
, Height
);
2100 with Control
as TGUIMemo
do
2102 FWindow
:= Self
.FWindow
;
2103 FColor
:= MENU_ITEMSTEXT_COLOR
;
2106 if fText
= '' then Text := nil else
2108 Text := TGUILabel
.Create(fText
, FFontID
);
2109 Text.FColor
:= MENU_ITEMSTEXT_COLOR
;
2112 ControlType
:= TGUIMemo
;
2114 Result
:= (Control
as TGUIMemo
);
2117 if FIndex
= -1 then FIndex
:= i
;
2122 procedure TGUIMenu
.UpdateIndex();
2130 if (FIndex
< 0) or (FIndex
> High(FItems
)) then
2136 if FItems
[FIndex
].Control
.Enabled
then
2145 constructor TGUIScroll
.Create
;
2150 FOnChangeEvent
:= nil;
2152 g_Texture_Get(SCROLL_LEFT
, FLeftID
);
2153 g_Texture_Get(SCROLL_RIGHT
, FRightID
);
2154 g_Texture_Get(SCROLL_MIDDLE
, FMiddleID
);
2155 g_Texture_Get(SCROLL_MARKER
, FMarkerID
);
2158 procedure TGUIScroll
.Draw
;
2164 e_Draw(FLeftID
, FX
, FY
, 0, True, False);
2165 e_Draw(FRightID
, FX
+8+(FMax
+1)*8, FY
, 0, True, False);
2167 for a
:= 0 to FMax
do
2168 e_Draw(FMiddleID
, FX
+8+a
*8, FY
, 0, True, False);
2170 e_Draw(FMarkerID
, FX
+8+FValue
*8, FY
, 0, True, False);
2173 procedure TGUIScroll
.FSetValue(a
: Integer);
2175 if a
> FMax
then FValue
:= FMax
else FValue
:= a
;
2178 function TGUIScroll
.GetWidth
: Integer;
2180 Result
:= 16+(FMax
+1)*8;
2183 procedure TGUIScroll
.OnMessage(var Msg
: TMessage
);
2185 if not FEnabled
then Exit
;
2193 IK_LEFT
, IK_KPLEFT
, VK_LEFT
, JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
:
2197 g_Sound_PlayEx(SCROLL_SUBSOUND
);
2198 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2200 IK_RIGHT
, IK_KPRIGHT
, VK_RIGHT
, JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
2201 if FValue
< FMax
then
2204 g_Sound_PlayEx(SCROLL_ADDSOUND
);
2205 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2212 procedure TGUIScroll
.Update
;
2220 procedure TGUISwitch
.AddItem(Item
: string);
2222 SetLength(FItems
, Length(FItems
)+1);
2223 FItems
[High(FItems
)] := Item
;
2225 if FIndex
= -1 then FIndex
:= 0;
2228 constructor TGUISwitch
.Create(FontID
: DWORD
);
2234 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
2237 procedure TGUISwitch
.Draw
;
2241 FFont
.Draw(FX
, FY
, FItems
[FIndex
], FColor
.R
, FColor
.G
, FColor
.B
);
2244 function TGUISwitch
.GetText
: string;
2246 if FIndex
<> -1 then Result
:= FItems
[FIndex
]
2250 function TGUISwitch
.GetWidth
: Integer;
2257 if FItems
= nil then Exit
;
2259 for a
:= 0 to High(FItems
) do
2261 FFont
.GetTextSize(FItems
[a
], w
, h
);
2262 if w
> Result
then Result
:= w
;
2266 procedure TGUISwitch
.OnMessage(var Msg
: TMessage
);
2268 if not FEnabled
then Exit
;
2272 if FItems
= nil then Exit
;
2277 IK_RETURN
, IK_RIGHT
, IK_KPRETURN
, IK_KPRIGHT
, VK_FIRE
, VK_OPEN
, VK_RIGHT
,
2278 JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
,
2279 JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
2281 if FIndex
< High(FItems
) then
2286 g_Sound_PlayEx(SCROLL_ADDSOUND
);
2288 if @FOnChangeEvent
<> nil then
2289 FOnChangeEvent(Self
);
2292 IK_LEFT
, IK_KPLEFT
, VK_LEFT
,
2293 JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
:
2298 FIndex
:= High(FItems
);
2300 g_Sound_PlayEx(SCROLL_SUBSOUND
);
2302 if @FOnChangeEvent
<> nil then
2303 FOnChangeEvent(Self
);
2309 procedure TGUISwitch
.Update
;
2317 constructor TGUIEdit
.Create(FontID
: DWORD
);
2321 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
2327 g_Texture_Get(EDIT_LEFT
, FLeftID
);
2328 g_Texture_Get(EDIT_RIGHT
, FRightID
);
2329 g_Texture_Get(EDIT_MIDDLE
, FMiddleID
);
2332 procedure TGUIEdit
.Draw
;
2339 e_Draw(FLeftID
, FX
, FY
, 0, True, False);
2340 e_Draw(FRightID
, FX
+8+FWidth
*16, FY
, 0, True, False);
2342 for c
:= 0 to FWidth
-1 do
2343 e_Draw(FMiddleID
, FX
+8+c
*16, FY
, 0, True, False);
2348 if FInvalid
and (FWindow
.FActiveControl
<> self
) then begin r
:= 128; g
:= 128; b
:= 128; end;
2349 FFont
.Draw(FX
+8, FY
, FText
, r
, g
, b
);
2351 if (FWindow
.FActiveControl
= self
) then
2353 FFont
.GetTextSize(Copy(FText
, 1, FCaretPos
), w
, h
);
2354 h
:= e_CharFont_GetMaxHeight(FFont
.ID
);
2355 e_DrawLine(2, FX
+8+w
, FY
+h
-3, FX
+8+w
+EDIT_CURSORLEN
, FY
+h
-3,
2356 EDIT_CURSORCOLOR
.R
, EDIT_CURSORCOLOR
.G
, EDIT_CURSORCOLOR
.B
);
2360 function TGUIEdit
.GetWidth
: Integer;
2362 Result
:= 16+FWidth
*16;
2365 procedure TGUIEdit
.OnMessage(var Msg
: TMessage
);
2367 if not FEnabled
then Exit
;
2376 if (wParam
in [48..57]) and (Chr(wParam
) <> '`') then
2377 if Length(Text) < FMaxLength
then
2379 Insert(Chr(wParam
), FText
, FCaretPos
+ 1);
2385 if (wParam
in [32..255]) and (Chr(wParam
) <> '`') then
2386 if Length(Text) < FMaxLength
then
2388 Insert(Chr(wParam
), FText
, FCaretPos
+ 1);
2396 Delete(FText
, FCaretPos
, 1);
2397 if FCaretPos
> 0 then Dec(FCaretPos
);
2399 IK_DELETE
: Delete(FText
, FCaretPos
+ 1, 1);
2400 IK_END
, IK_KPEND
: FCaretPos
:= Length(FText
);
2401 IK_HOME
, IK_KPHOME
: FCaretPos
:= 0;
2402 IK_LEFT
, IK_KPLEFT
, VK_LEFT
, JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
: if FCaretPos
> 0 then Dec(FCaretPos
);
2403 IK_RIGHT
, IK_KPRIGHT
, VK_RIGHT
, JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
: if FCaretPos
< Length(FText
) then Inc(FCaretPos
);
2404 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
2407 if FActiveControl
<> Self
then
2410 if @FOnEnterEvent
<> nil then FOnEnterEvent(Self
);
2414 if FDefControl
<> '' then SetActive(GetControl(FDefControl
))
2415 else SetActive(nil);
2416 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2422 g_GUIGrabInput
:= (@FOnEnterEvent
= nil) and (FWindow
.FActiveControl
= Self
);
2424 {$IFDEF ENABLE_TOUCH}
2425 sys_ShowKeyboard(g_GUIGrabInput
)
2429 procedure TGUIEdit
.SetText(Text: string);
2431 if Length(Text) > FMaxLength
then SetLength(Text, FMaxLength
);
2433 FCaretPos
:= Length(FText
);
2436 procedure TGUIEdit
.Update
;
2443 constructor TGUIKeyRead
.Create(FontID
: DWORD
);
2449 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
2452 procedure TGUIKeyRead
.Draw
;
2456 FFont
.Draw(FX
, FY
, IfThen(FIsQuery
, KEYREAD_QUERY
, IfThen(FKey
<> 0, e_KeyNames
[FKey
], KEYREAD_CLEAR
)),
2457 FColor
.R
, FColor
.G
, FColor
.B
);
2460 function TGUIKeyRead
.GetWidth
: Integer;
2467 for a
:= 0 to 255 do
2469 FFont
.GetTextSize(e_KeyNames
[a
], w
, h
);
2470 Result
:= Max(Result
, w
);
2473 FFont
.GetTextSize(KEYREAD_QUERY
, w
, h
);
2474 if w
> Result
then Result
:= w
;
2476 FFont
.GetTextSize(KEYREAD_CLEAR
, w
, h
);
2477 if w
> Result
then Result
:= w
;
2480 function TGUIKeyRead
.WantActivationKey (key
: LongInt): Boolean;
2483 (key
= IK_BACKSPACE
) or
2487 procedure TGUIKeyRead
.OnMessage(var Msg
: TMessage
);
2488 procedure actDefCtl ();
2491 if FDefControl
<> '' then
2492 SetActive(GetControl(FDefControl
))
2500 if not FEnabled
then
2509 if FIsQuery
then actDefCtl();
2512 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
2514 if not FIsQuery
then
2517 if FActiveControl
<> Self
then
2522 else if (wParam
< VK_FIRSTKEY
) and (wParam
> VK_LASTKEY
) then
2524 // FKey := IK_ENTER; // <Enter>
2530 IK_BACKSPACE
: // clear keybinding if we aren't waiting for a key
2532 if not FIsQuery
then
2542 if not FIsQuery
and (wParam
= IK_BACKSPACE
) then
2547 else if FIsQuery
then
2550 IK_ENTER
, IK_KPRETURN
, VK_FIRSTKEY
..VK_LASTKEY (*, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK*): // Not <Enter
2552 if e_KeyNames
[wParam
] <> '' then
2561 g_GUIGrabInput
:= FIsQuery
2566 constructor TGUIKeyRead2
.Create(FontID
: DWORD
);
2579 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
2581 FMaxKeyNameWdt
:= 0;
2582 for a
:= 0 to 255 do
2584 FFont
.GetTextSize(e_KeyNames
[a
], w
, h
);
2585 FMaxKeyNameWdt
:= Max(FMaxKeyNameWdt
, w
);
2588 FMaxKeyNameWdt
:= FMaxKeyNameWdt
-(FMaxKeyNameWdt
div 3);
2590 FFont
.GetTextSize(KEYREAD_QUERY
, w
, h
);
2591 if w
> FMaxKeyNameWdt
then FMaxKeyNameWdt
:= w
;
2593 FFont
.GetTextSize(KEYREAD_CLEAR
, w
, h
);
2594 if w
> FMaxKeyNameWdt
then FMaxKeyNameWdt
:= w
;
2597 procedure TGUIKeyRead2
.Draw
;
2598 procedure drawText (idx
: Integer);
2604 if idx
= 0 then kk
:= FKey0
else kk
:= FKey1
;
2606 if idx
= 0 then x
:= FX
+8 else x
:= FX
+8+FMaxKeyNameWdt
+16;
2610 if FKeyIdx
= idx
then begin r
:= 255; g
:= 255; b
:= 255; end;
2611 if FIsQuery
and (FKeyIdx
= idx
) then
2612 FFont
.Draw(x
, y
, KEYREAD_QUERY
, r
, g
, b
)
2614 FFont
.Draw(x
, y
, IfThen(kk
<> 0, e_KeyNames
[kk
], KEYREAD_CLEAR
), r
, g
, b
);
2620 //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);
2621 //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);
2626 function TGUIKeyRead2
.GetWidth
: Integer;
2628 Result
:= FMaxKeyNameWdt
*2+8+8+16;
2631 function TGUIKeyRead2
.WantActivationKey (key
: LongInt): Boolean;
2634 IK_BACKSPACE
, IK_LEFT
, IK_RIGHT
, IK_KPLEFT
, IK_KPRIGHT
, VK_LEFT
, VK_RIGHT
,
2635 JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
,
2636 JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
2643 procedure TGUIKeyRead2
.OnMessage(var Msg
: TMessage
);
2644 procedure actDefCtl ();
2647 if FDefControl
<> '' then
2648 SetActive(GetControl(FDefControl
))
2656 if not FEnabled
then
2665 if FIsQuery
then actDefCtl();
2668 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
2670 if not FIsQuery
then
2673 if FActiveControl
<> Self
then
2678 else if (wParam
< VK_FIRSTKEY
) and (wParam
> VK_LASTKEY
) then
2680 // if (FKeyIdx = 0) then FKey0 := IK_ENTER else FKey1 := IK_ENTER; // <Enter>
2681 if (FKeyIdx
= 0) then FKey0
:= wParam
else FKey1
:= wParam
;
2686 IK_BACKSPACE
: // clear keybinding if we aren't waiting for a key
2688 if not FIsQuery
then
2690 if (FKeyIdx
= 0) then FKey0
:= 0 else FKey1
:= 0;
2694 IK_LEFT
, IK_KPLEFT
, VK_LEFT
, JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
:
2695 if not FIsQuery
then
2700 IK_RIGHT
, IK_KPRIGHT
, VK_RIGHT
, JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
2701 if not FIsQuery
then
2710 if not FIsQuery
and (wParam
= IK_BACKSPACE
) then
2712 if (FKeyIdx
= 0) then FKey0
:= 0 else FKey1
:= 0;
2715 else if FIsQuery
then
2718 IK_ENTER
, IK_KPRETURN
, VK_FIRSTKEY
..VK_LASTKEY (*, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK*): // Not <Enter
2720 if e_KeyNames
[wParam
] <> '' then
2722 if (FKeyIdx
= 0) then FKey0
:= wParam
else FKey1
:= wParam
;
2731 g_GUIGrabInput
:= FIsQuery
2737 constructor TGUIModelView
.Create
;
2744 destructor TGUIModelView
.Destroy
;
2751 procedure TGUIModelView
.Draw
;
2755 DrawBox(FX
, FY
, 4, 4);
2757 if FModel
<> nil then
2758 r_PlayerModel_Draw(FModel
, FX
+4, FY
+4);
2761 procedure TGUIModelView
.NextAnim();
2763 if FModel
= nil then
2766 if FModel
.Animation
< A_PAIN
then
2767 FModel
.ChangeAnimation(FModel
.Animation
+1, True)
2769 FModel
.ChangeAnimation(A_STAND
, True);
2772 procedure TGUIModelView
.NextWeapon();
2774 if FModel
= nil then
2777 if FModel
.Weapon
< WP_LAST
then
2778 FModel
.SetWeapon(FModel
.Weapon
+1)
2780 FModel
.SetWeapon(WEAPON_KASTET
);
2783 procedure TGUIModelView
.OnMessage(var Msg
: TMessage
);
2789 procedure TGUIModelView
.SetColor(Red
, Green
, Blue
: Byte);
2791 if FModel
<> nil then FModel
.SetColor(Red
, Green
, Blue
);
2794 procedure TGUIModelView
.SetModel(ModelName
: string);
2798 FModel
:= g_PlayerModel_Get(ModelName
);
2801 procedure TGUIModelView
.Update
;
2808 if FModel
<> nil then FModel
.Update
;
2813 constructor TGUIMapPreview
.Create();
2819 destructor TGUIMapPreview
.Destroy();
2825 procedure TGUIMapPreview
.Draw();
2832 DrawBox(FX
, FY
, MAPPREVIEW_WIDTH
, MAPPREVIEW_HEIGHT
);
2834 if (FMapSize
.X
<= 0) or (FMapSize
.Y
<= 0) then
2837 e_DrawFillQuad(FX
+4, FY
+4,
2838 FX
+4 + Trunc(FMapSize
.X
/ FScale
) - 1,
2839 FY
+4 + Trunc(FMapSize
.Y
/ FScale
) - 1,
2842 if FMapData
<> nil then
2843 for a
:= 0 to High(FMapData
) do
2846 if X1
> MAPPREVIEW_WIDTH
*16 then Continue
;
2847 if Y1
> MAPPREVIEW_HEIGHT
*16 then Continue
;
2849 if X2
< 0 then Continue
;
2850 if Y2
< 0 then Continue
;
2852 if X2
> MAPPREVIEW_WIDTH
*16 then X2
:= MAPPREVIEW_WIDTH
*16;
2853 if Y2
> MAPPREVIEW_HEIGHT
*16 then Y2
:= MAPPREVIEW_HEIGHT
*16;
2855 if X1
< 0 then X1
:= 0;
2856 if Y1
< 0 then Y1
:= 0;
2897 if ((X2
-X1
) > 0) and ((Y2
-Y1
) > 0) then
2898 e_DrawFillQuad(FX
+4 + X1
, FY
+4 + Y1
,
2899 FX
+4 + X2
- 1, FY
+4 + Y2
- 1, r
, g
, b
, 0);
2903 procedure TGUIMapPreview
.OnMessage(var Msg
: TMessage
);
2909 procedure TGUIMapPreview
.SetMap(Res
: string);
2914 //header: TMapHeaderRec_1;
2919 map
: TDynRecord
= nil;
2926 FileName
:= g_ExtractWadName(Res
);
2928 WAD
:= TWADFile
.Create();
2929 if not WAD
.ReadFile(FileName
) then
2935 //k8: ignores path again
2936 if not WAD
.GetMapResource(g_ExtractFileName(Res
), Data
, Len
) then
2945 map
:= g_Map_ParseMap(Data
, Len
);
2955 if (map
= nil) then exit
;
2958 panlist
:= map
.field
['panel'];
2959 //header := GetMapHeader(map);
2961 FMapSize
.X
:= map
.Width
div 16;
2962 FMapSize
.Y
:= map
.Height
div 16;
2964 rX
:= Ceil(map
.Width
/ (MAPPREVIEW_WIDTH
*256.0));
2965 rY
:= Ceil(map
.Height
/ (MAPPREVIEW_HEIGHT
*256.0));
2966 FScale
:= max(rX
, rY
);
2970 if (panlist
<> nil) then
2972 for pan
in panlist
do
2974 if (pan
.PanelType
and (PANEL_WALL
or PANEL_CLOSEDOOR
or
2975 PANEL_STEP
or PANEL_WATER
or
2976 PANEL_ACID1
or PANEL_ACID2
)) <> 0 then
2978 SetLength(FMapData
, Length(FMapData
)+1);
2979 with FMapData
[High(FMapData
)] do
2984 X2
:= (pan
.X
+ pan
.Width
) div 16;
2985 Y2
:= (pan
.Y
+ pan
.Height
) div 16;
2987 X1
:= Trunc(X1
/FScale
+ 0.5);
2988 Y1
:= Trunc(Y1
/FScale
+ 0.5);
2989 X2
:= Trunc(X2
/FScale
+ 0.5);
2990 Y2
:= Trunc(Y2
/FScale
+ 0.5);
2992 if (X1
<> X2
) or (Y1
<> Y2
) then
3000 PanelType
:= pan
.PanelType
;
3006 //writeln('freeing map');
3011 procedure TGUIMapPreview
.ClearMap();
3013 SetLength(FMapData
, 0);
3020 procedure TGUIMapPreview
.Update();
3026 function TGUIMapPreview
.GetScaleStr(): String;
3028 if FScale
> 0.0 then
3030 Result
:= FloatToStrF(FScale
*16.0, ffFixed
, 3, 3);
3031 while (Result
[Length(Result
)] = '0') do
3032 Delete(Result
, Length(Result
), 1);
3033 if (Result
[Length(Result
)] = ',') or (Result
[Length(Result
)] = '.') then
3034 Delete(Result
, Length(Result
), 1);
3035 Result
:= '1 : ' + Result
;
3043 procedure TGUIListBox
.AddItem(Item
: string);
3045 SetLength(FItems
, Length(FItems
)+1);
3046 FItems
[High(FItems
)] := Item
;
3048 if FSort
then g_gui
.Sort(FItems
);
3051 function TGUIListBox
.ItemExists (item
: String): Boolean;
3055 while (i
<= High(FItems
)) and (FItems
[i
] <> item
) do Inc(i
);
3056 result
:= i
<= High(FItems
)
3059 procedure TGUIListBox
.Clear
;
3067 constructor TGUIListBox
.Create(FontID
: DWORD
; Width
, Height
: Word);
3071 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
3076 FOnChangeEvent
:= nil;
3078 FDrawScroll
:= True;
3081 procedure TGUIListBox
.Draw
;
3089 if FDrawBack
then DrawBox(FX
, FY
, FWidth
+1, FHeight
);
3091 DrawScroll(FX
+4+FWidth
*16, FY
+4, FHeight
, (FStartLine
> 0) and (FItems
<> nil),
3092 (FStartLine
+FHeight
-1 < High(FItems
)) and (FItems
<> nil));
3094 if FItems
<> nil then
3095 for a
:= FStartLine
to Min(High(FItems
), FStartLine
+FHeight
-1) do
3099 FFont
.GetTextSize(s
, w2
, h2
);
3100 while (Length(s
) > 0) and (w2
> FWidth
*16) do
3102 SetLength(s
, Length(s
)-1);
3103 FFont
.GetTextSize(s
, w2
, h2
);
3107 FFont
.Draw(FX
+4, FY
+4+(a
-FStartLine
)*16, s
, FActiveColor
.R
, FActiveColor
.G
, FActiveColor
.B
)
3109 FFont
.Draw(FX
+4, FY
+4+(a
-FStartLine
)*16, s
, FUnActiveColor
.R
, FUnActiveColor
.G
, FUnActiveColor
.B
);
3113 function TGUIListBox
.GetHeight
: Integer;
3115 Result
:= 8+FHeight
*16;
3118 function TGUIListBox
.GetWidth
: Integer;
3120 Result
:= 8+(FWidth
+1)*16;
3123 procedure TGUIListBox
.OnMessage(var Msg
: TMessage
);
3127 if not FEnabled
then Exit
;
3131 if FItems
= nil then Exit
;
3144 FIndex
:= High(FItems
);
3145 FStartLine
:= Max(High(FItems
)-FHeight
+1, 0);
3147 IK_UP
, IK_LEFT
, IK_KPUP
, IK_KPLEFT
, VK_LEFT
, JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
:
3151 if FIndex
< FStartLine
then Dec(FStartLine
);
3152 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
3154 IK_DOWN
, IK_RIGHT
, IK_KPDOWN
, IK_KPRIGHT
, VK_RIGHT
, JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
3155 if FIndex
< High(FItems
) then
3158 if FIndex
> FStartLine
+FHeight
-1 then Inc(FStartLine
);
3159 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
3161 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
3164 if FActiveControl
<> Self
then SetActive(Self
)
3166 if FDefControl
<> '' then SetActive(GetControl(FDefControl
))
3167 else SetActive(nil);
3171 for a
:= 0 to High(FItems
) do
3172 if (Length(FItems
[a
]) > 0) and (LowerCase(FItems
[a
][1]) = LowerCase(Chr(wParam
))) then
3175 FStartLine
:= Min(Max(FIndex
-1, 0), Length(FItems
)-FHeight
);
3176 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
3182 function TGUIListBox
.SelectedItem(): String;
3186 if (FIndex
< 0) or (FItems
= nil) or
3187 (FIndex
> High(FItems
)) then
3190 Result
:= FItems
[FIndex
];
3193 procedure TGUIListBox
.FSetItems(Items
: SSArray
);
3195 if FItems
<> nil then
3203 if FSort
then g_gui
.Sort(FItems
);
3206 procedure TGUIListBox
.SelectItem(Item
: String);
3210 if FItems
= nil then
3214 Item
:= LowerCase(Item
);
3216 for a
:= 0 to High(FItems
) do
3217 if LowerCase(FItems
[a
]) = Item
then
3223 if FIndex
< FHeight
then
3226 FStartLine
:= Min(FIndex
, Length(FItems
)-FHeight
);
3229 procedure TGUIListBox
.FSetIndex(aIndex
: Integer);
3231 if FItems
= nil then
3234 if (aIndex
< 0) or (aIndex
> High(FItems
)) then
3239 if FIndex
<= FHeight
then
3242 FStartLine
:= Min(FIndex
, Length(FItems
)-FHeight
);
3247 procedure TGUIFileListBox
.OnMessage(var Msg
: TMessage
);
3249 a
, b
: Integer; s
: AnsiString;
3251 if not FEnabled
then
3254 if FItems
= nil then
3265 if @FOnChangeEvent
<> nil then
3266 FOnChangeEvent(Self
);
3271 FIndex
:= High(FItems
);
3272 FStartLine
:= Max(High(FItems
)-FHeight
+1, 0);
3273 if @FOnChangeEvent
<> nil then
3274 FOnChangeEvent(Self
);
3277 IK_PAGEUP
, IK_KPPAGEUP
:
3279 if FIndex
> FHeight
then
3280 FIndex
:= FIndex
-FHeight
3284 if FStartLine
> FHeight
then
3285 FStartLine
:= FStartLine
-FHeight
3290 IK_PAGEDN
, IK_KPPAGEDN
:
3292 if FIndex
< High(FItems
)-FHeight
then
3293 FIndex
:= FIndex
+FHeight
3295 FIndex
:= High(FItems
);
3297 if FStartLine
< High(FItems
)-FHeight
then
3298 FStartLine
:= FStartLine
+FHeight
3300 FStartLine
:= High(FItems
)-FHeight
+1;
3303 IK_UP
, IK_LEFT
, IK_KPUP
, IK_KPLEFT
, VK_UP
, VK_LEFT
, JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
:
3307 if FIndex
< FStartLine
then
3309 if @FOnChangeEvent
<> nil then
3310 FOnChangeEvent(Self
);
3313 IK_DOWN
, IK_RIGHT
, IK_KPDOWN
, IK_KPRIGHT
, VK_DOWN
, VK_RIGHT
, JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
3314 if FIndex
< High(FItems
) then
3317 if FIndex
> FStartLine
+FHeight
-1 then
3319 if @FOnChangeEvent
<> nil then
3320 FOnChangeEvent(Self
);
3323 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
3326 if FActiveControl
<> Self
then
3330 if FItems
[FIndex
][1] = #29 then // Ïàïêà
3332 if FItems
[FIndex
] = #29 + '..' then
3334 e_LogWritefln('TGUIFileListBox: Upper dir "%s" -> "%s"', [FSubPath
, e_UpperDir(FSubPath
)]);
3335 FSubPath
:= e_UpperDir(FSubPath
)
3339 s
:= Copy(AnsiString(FItems
[FIndex
]), 2);
3340 e_LogWritefln('TGUIFileListBox: Enter dir "%s" -> "%s"', [FSubPath
, e_CatPath(FSubPath
, s
)]);
3341 FSubPath
:= e_CatPath(FSubPath
, s
);
3348 if FDefControl
<> '' then
3349 SetActive(GetControl(FDefControl
))
3357 for b
:= FIndex
+ 1 to High(FItems
) + FIndex
do
3359 a
:= b
mod Length(FItems
);
3360 if ( (Length(FItems
[a
]) > 0) and
3361 (LowerCase(FItems
[a
][1]) = LowerCase(Chr(wParam
))) ) or
3362 ( (Length(FItems
[a
]) > 1) and
3363 (FItems
[a
][1] = #29) and // Ïàïêà
3364 (LowerCase(FItems
[a
][2]) = LowerCase(Chr(wParam
))) ) then
3367 FStartLine
:= Min(Max(FIndex
-1, 0), Length(FItems
)-FHeight
);
3368 if @FOnChangeEvent
<> nil then
3369 FOnChangeEvent(Self
);
3376 procedure TGUIFileListBox
.ScanDirs
;
3377 var i
, j
: Integer; path
: AnsiString; SR
: TSearchRec
; sm
, sc
: String;
3381 i
:= High(FBaseList
);
3384 path
:= e_CatPath(FBaseList
[i
], FSubPath
);
3387 if FindFirst(path
+ '/' + '*', faDirectory
, SR
) = 0 then
3390 if LongBool(SR
.Attr
and faDirectory
) then
3391 if (SR
.Name
<> '.') and ((FSubPath
<> '') or (SR
.Name
<> '..')) then
3392 if Self
.ItemExists(#1 + SR
.Name
) = false then
3393 Self
.AddItem(#1 + SR
.Name
)
3394 until FindNext(SR
) <> 0
3401 i
:= High(FBaseList
);
3404 path
:= e_CatPath(FBaseList
[i
], FSubPath
);
3410 j
:= length(sm
) + 1;
3411 sc
:= Copy(sm
, 1, j
- 1);
3413 if FindFirst(path
+ '/' + sc
, faAnyFile
, SR
) = 0 then
3416 if Self
.ItemExists(SR
.Name
) = false then
3418 until FindNext(SR
) <> 0
3425 for i
:= 0 to High(FItems
) do
3426 if FItems
[i
][1] = #1 then
3427 FItems
[i
][1] := #29;
3430 procedure TGUIFileListBox
.SetBase (dirs
: SSArray
; path
: String = '');
3437 function TGUIFileListBox
.SelectedItem (): String;
3441 if (FIndex
>= 0) and (FIndex
<= High(FItems
)) and (FItems
[FIndex
][1] <> '/') and (FItems
[FIndex
][1] <> '\') then
3443 s
:= e_CatPath(FSubPath
, FItems
[FIndex
]);
3444 if e_FindResource(FBaseList
, s
) = true then
3445 result
:= ExpandFileName(s
)
3447 e_LogWritefln('TGUIFileListBox.SelectedItem -> "%s"', [result
]);
3450 procedure TGUIFileListBox
.UpdateFileList();
3454 if (FIndex
= -1) or (FItems
= nil) or
3455 (FIndex
> High(FItems
)) or
3456 (FItems
[FIndex
][1] = '/') or
3457 (FItems
[FIndex
][1] = '\') then
3460 fn
:= FItems
[FIndex
];
3471 procedure TGUIMemo
.Clear
;
3477 constructor TGUIMemo
.Create(FontID
: DWORD
; Width
, Height
: Word);
3481 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
3486 FDrawScroll
:= True;
3489 procedure TGUIMemo
.Draw
;
3495 if FDrawBack
then DrawBox(FX
, FY
, FWidth
+1, FHeight
);
3497 DrawScroll(FX
+4+FWidth
*16, FY
+4, FHeight
, (FStartLine
> 0) and (FLines
<> nil),
3498 (FStartLine
+FHeight
-1 < High(FLines
)) and (FLines
<> nil));
3500 if FLines
<> nil then
3501 for a
:= FStartLine
to Min(High(FLines
), FStartLine
+FHeight
-1) do
3502 FFont
.Draw(FX
+4, FY
+4+(a
-FStartLine
)*16, FLines
[a
], FColor
.R
, FColor
.G
, FColor
.B
);
3505 function TGUIMemo
.GetHeight
: Integer;
3507 Result
:= 8+FHeight
*16;
3510 function TGUIMemo
.GetWidth
: Integer;
3512 Result
:= 8+(FWidth
+1)*16;
3515 procedure TGUIMemo
.OnMessage(var Msg
: TMessage
);
3517 if not FEnabled
then Exit
;
3521 if FLines
= nil then Exit
;
3527 IK_UP
, IK_LEFT
, IK_KPUP
, IK_KPLEFT
, VK_UP
, VK_LEFT
, JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
:
3528 if FStartLine
> 0 then
3530 IK_DOWN
, IK_RIGHT
, IK_KPDOWN
, IK_KPRIGHT
, VK_DOWN
, VK_RIGHT
, JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
3531 if FStartLine
< Length(FLines
)-FHeight
then
3533 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
3536 if FActiveControl
<> Self
then
3542 if FDefControl
<> '' then SetActive(GetControl(FDefControl
))
3543 else SetActive(nil);
3549 procedure TGUIMemo
.SetText(Text: string);
3552 FLines
:= GetLines(Text, FFont
.ID
, FWidth
*16);
3557 procedure TGUIimage
.ClearImage();
3559 if FImageRes
= '' then Exit
;
3561 g_Texture_Delete(FImageRes
);
3565 constructor TGUIimage
.Create();
3572 destructor TGUIimage
.Destroy();
3577 procedure TGUIimage
.Draw();
3583 if FImageRes
= '' then
3585 if g_Texture_Get(FDefaultRes
, ID
) then e_Draw(ID
, FX
, FY
, 0, True, False);
3588 if g_Texture_Get(FImageRes
, ID
) then e_Draw(ID
, FX
, FY
, 0, True, False);
3591 procedure TGUIimage
.OnMessage(var Msg
: TMessage
);
3596 procedure TGUIimage
.SetImage(Res
: string);
3600 if g_Texture_CreateWADEx(Res
, Res
) then FImageRes
:= Res
;
3603 procedure TGUIimage
.Update();