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
, g_touch
, 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';
85 TFontType
= (Texture
, Character
);
87 TFont
= class{$IFDEF USE_MEMPOOL}(TPoolObject
){$ENDIF}
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
;
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}
115 FWindow
: TGUIWindow
;
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
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
136 TGUIWindow
= class{$IFDEF USE_MEMPOOL}(TPoolObject
){$ENDIF}
138 FActiveControl
: TGUIControl
;
140 FPrevWindow
: TGUIWindow
;
142 FBackTexture
: string;
143 FMainWindow
: Boolean;
144 FOnKeyDown
: TOnKeyDownEvent
;
145 FOnKeyDownEx
: TOnKeyDownEventEx
;
146 FOnCloseEvent
: TOnCloseEvent
;
147 FOnShowEvent
: TOnShowEvent
;
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
);
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
;
170 TGUITextButton
= class(TGUIControl
)
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
;
194 TGUILabel
= class(TGUIControl
)
200 FOnClickEvent
: TOnClickEvent
;
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
;
214 TGUIScroll
= class(TGUIControl
)
222 FOnChangeEvent
: TOnChangeEvent
;
223 procedure FSetValue(a
: Integer);
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
;
235 TGUISwitch
= class(TGUIControl
)
238 FItems
: array of string;
241 FOnChangeEvent
: TOnChangeEvent
;
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
;
256 TGUIEdit
= class(TGUIControl
)
264 FOnlyDigits
: Boolean;
268 FOnChangeEvent
: TOnChangeEvent
;
269 FOnEnterEvent
: TOnEnterEvent
;
271 procedure SetText(Text: string);
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
;
289 TGUIKeyRead
= class(TGUIControl
)
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
;
307 TGUIKeyRead2
= class(TGUIControl
)
312 FKey0
, FKey1
: Word; // this should be an array. sorry.
315 FMaxKeyNameWdt
: Integer;
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
;
328 TGUIModelView
= class(TGUIControl
)
330 FModel
: TPlayerModel
;
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
;
345 TPreviewPanel
= record
346 X1
, Y1
, X2
, Y2
: Integer;
350 TGUIMapPreview
= class(TGUIControl
)
352 FMapData
: array of TPreviewPanel
;
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;
366 TGUIImage
= class(TGUIControl
)
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
;
381 TGUIListBox
= class(TGUIControl
)
385 FUnActiveColor
: TRGB
;
393 FDrawScroll
: Boolean;
394 FOnChangeEvent
: TOnChangeEvent
;
396 procedure FSetItems(Items
: SSArray
);
397 procedure FSetIndex(aIndex
: Integer);
400 constructor Create(FontID
: DWORD
; Width
, Height
: Word);
401 procedure OnMessage(var Msg
: TMessage
); override;
402 procedure Draw(); override;
403 procedure AddItem(Item
: String);
404 function ItemExists (item
: String): Boolean;
405 procedure SelectItem(Item
: String);
407 function GetWidth(): Integer; override;
408 function GetHeight(): Integer; override;
409 function SelectedItem(): String;
411 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
412 property Sort
: Boolean read FSort write FSort
;
413 property ItemIndex
: Integer read FIndex write FSetIndex
;
414 property Items
: SSArray read FItems write FSetItems
;
415 property DrawBack
: Boolean read FDrawBack write FDrawBack
;
416 property DrawScrollBar
: Boolean read FDrawScroll write FDrawScroll
;
417 property ActiveColor
: TRGB read FActiveColor write FActiveColor
;
418 property UnActiveColor
: TRGB read FUnActiveColor write FUnActiveColor
;
419 property Font
: TFont read FFont write FFont
;
422 TGUIFileListBox
= class(TGUIListBox
)
427 FBaseList
: SSArray
; // highter index have highter priority
432 procedure OnMessage (var Msg
: TMessage
); override;
433 procedure SetBase (dirs
: SSArray
; path
: String = '');
434 function SelectedItem(): String;
435 procedure UpdateFileList
;
437 property Dirs
: Boolean read FDirs write FDirs
;
438 property FileMask
: String read FFileMask write FFileMask
;
441 TGUIMemo
= class(TGUIControl
)
450 FDrawScroll
: Boolean;
452 constructor Create(FontID
: DWORD
; Width
, Height
: Word);
453 procedure OnMessage(var Msg
: TMessage
); override;
454 procedure Draw
; override;
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
;
465 TGUIMainMenu
= class(TGUIControl
)
467 FButtons
: array of TGUITextButton
;
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;
487 TControlType
= class of TGUIControl
;
489 PMenuItem
= ^TMenuItem
;
492 ControlType
: TControlType
;
493 Control
: TGUIControl
;
496 TGUIMenu
= class(TGUIControl
)
498 FItems
: array of TMenuItem
;
506 function NewItem(): Integer;
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
;
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
;
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();
553 g_textures
, g_sound
, SysUtils
, e_res
,
554 g_game
, Math
, StrUtils
, g_player
, g_options
, g_console
, r_playermodel
,
555 g_map
, g_weapons
, xdynrec
, wadreader
;
559 Box
: Array [0..8] of DWORD
;
560 Saved_Windows
: SSArray
;
562 function GetLines (text: string; FontID
: DWORD
; MaxWidth
: Word): SSArray
;
566 i
, len
, lastsep
: Integer;
568 function PrepareStep (): Boolean; inline;
570 // Skip leading spaces.
571 while PChar(text)[k
-1] = ' ' do k
+= 1;
576 function GetLine (j
: Integer; Strip
: Boolean): String; inline;
578 // Exclude trailing spaces from the line.
580 while text[j
] = ' ' do j
-= 1;
582 Result
:= Copy(text, k
, j
-k
+1);
585 function LineWidth (): Integer; inline;
588 e_CharFont_GetSize(FontID
, GetLine(i
, False), w
, h
);
595 //e_LogWritefln('GetLines @%s len=%s [%s]', [MaxWidth, len, text]);
597 while PrepareStep() do
599 // Get longest possible sequence (this is not constant because fonts are not monospaced).
602 if text[i
] in [' ', '.', ',', ':', ';']
605 until (i
> len
) or (LineWidth() > MaxWidth
);
607 // Do not include part of a word if possible.
608 if (lastsep
-k
> 3) and (i
<= len
) and (text[i
] <> ' ')
609 then i
:= lastsep
+ 1;
612 SetLength(Result
, lines
+ 1);
613 Result
[lines
] := GetLine(i
-1, True);
614 //e_LogWritefln(' -> (%s:%s::%s) [%s]', [k, i, LineWidth(), Result[lines]]);
621 procedure Sort(var a
: SSArray
);
626 if a
= nil then Exit
;
628 for i
:= High(a
) downto Low(a
) do
629 for j
:= Low(a
) to High(a
)-1 do
630 if LowerCase(a
[j
]) > LowerCase(a
[j
+1]) then
638 procedure g_GUI_Init();
640 g_Texture_Get(BOX1
, Box
[0]);
641 g_Texture_Get(BOX2
, Box
[1]);
642 g_Texture_Get(BOX3
, Box
[2]);
643 g_Texture_Get(BOX4
, Box
[3]);
644 g_Texture_Get(BOX5
, Box
[4]);
645 g_Texture_Get(BOX6
, Box
[5]);
646 g_Texture_Get(BOX7
, Box
[6]);
647 g_Texture_Get(BOX8
, Box
[7]);
648 g_Texture_Get(BOX9
, Box
[8]);
651 function g_GUI_Destroy(): Boolean;
655 Result
:= (Length(g_GUIWindows
) > 0);
657 for i
:= 0 to High(g_GUIWindows
) do
658 g_GUIWindows
[i
].Free();
661 g_ActiveWindow
:= nil;
664 function g_GUI_AddWindow(Window
: TGUIWindow
): TGUIWindow
;
666 SetLength(g_GUIWindows
, Length(g_GUIWindows
)+1);
667 g_GUIWindows
[High(g_GUIWindows
)] := Window
;
672 function g_GUI_GetWindow(Name
: string): TGUIWindow
;
678 if g_GUIWindows
<> nil then
679 for i
:= 0 to High(g_GUIWindows
) do
680 if g_GUIWindows
[i
].FName
= Name
then
682 Result
:= g_GUIWindows
[i
];
686 Assert(Result
<> nil, 'GUI_Window "'+Name
+'" not found');
689 procedure g_GUI_ShowWindow(Name
: string);
693 if g_GUIWindows
= nil then
696 for i
:= 0 to High(g_GUIWindows
) do
697 if g_GUIWindows
[i
].FName
= Name
then
699 g_GUIWindows
[i
].FPrevWindow
:= g_ActiveWindow
;
700 g_ActiveWindow
:= g_GUIWindows
[i
];
702 if g_ActiveWindow
.MainWindow
then
703 g_ActiveWindow
.FPrevWindow
:= nil;
705 if g_ActiveWindow
.FDefControl
<> '' then
706 g_ActiveWindow
.SetActive(g_ActiveWindow
.GetControl(g_ActiveWindow
.FDefControl
))
708 g_ActiveWindow
.SetActive(nil);
710 if @g_ActiveWindow
.FOnShowEvent
<> nil then
711 g_ActiveWindow
.FOnShowEvent();
717 procedure g_GUI_HideWindow(PlaySound
: Boolean = True);
719 if g_ActiveWindow
<> nil then
721 if @g_ActiveWindow
.OnClose
<> nil then
722 g_ActiveWindow
.OnClose();
723 g_ActiveWindow
:= g_ActiveWindow
.FPrevWindow
;
725 g_Sound_PlayEx(WINDOW_CLOSESOUND
);
729 procedure g_GUI_SaveMenuPos();
734 SetLength(Saved_Windows
, 0);
735 win
:= g_ActiveWindow
;
739 len
:= Length(Saved_Windows
);
740 SetLength(Saved_Windows
, len
+ 1);
742 Saved_Windows
[len
] := win
.Name
;
744 if win
.MainWindow
then
747 win
:= win
.FPrevWindow
;
751 procedure g_GUI_LoadMenuPos();
753 i
, j
, k
, len
: Integer;
756 g_ActiveWindow
:= nil;
757 len
:= Length(Saved_Windows
);
762 // Îêíî ñ ãëàâíûì ìåíþ:
763 g_GUI_ShowWindow(Saved_Windows
[len
-1]);
765 // Íå ïåðåêëþ÷èëîñü (èëè íåêóäà äàëüøå):
766 if (len
= 1) or (g_ActiveWindow
= nil) then
769 // Èùåì êíîïêè â îñòàëüíûõ îêíàõ:
770 for k
:= len
-1 downto 1 do
774 for i
:= 0 to Length(g_ActiveWindow
.Childs
)-1 do
776 if g_ActiveWindow
.Childs
[i
] is TGUIMainMenu
then
777 begin // GUI_MainMenu
778 with TGUIMainMenu(g_ActiveWindow
.Childs
[i
]) do
779 for j
:= 0 to Length(FButtons
)-1 do
780 if FButtons
[j
].ShowWindow
= Saved_Windows
[k
-1] then
782 FButtons
[j
].Click(True);
788 if g_ActiveWindow
.Childs
[i
] is TGUIMenu
then
789 with TGUIMenu(g_ActiveWindow
.Childs
[i
]) do
790 for j
:= 0 to Length(FItems
)-1 do
791 if FItems
[j
].ControlType
= TGUITextButton
then
792 if TGUITextButton(FItems
[j
].Control
).ShowWindow
= Saved_Windows
[k
-1] then
794 TGUITextButton(FItems
[j
].Control
).Click(True);
805 (g_ActiveWindow
.Name
= Saved_Windows
[k
]) then
810 procedure DrawBox(X
, Y
: Integer; Width
, Height
: Word);
812 e_Draw(Box
[0], X
, Y
, 0, False, False);
813 e_DrawFill(Box
[1], X
+4, Y
, Width
*4, 1, 0, False, False);
814 e_Draw(Box
[2], X
+4+Width
*16, Y
, 0, False, False);
815 e_DrawFill(Box
[3], X
, Y
+4, 1, Height
*4, 0, False, False);
816 e_DrawFill(Box
[4], X
+4, Y
+4, Width
, Height
, 0, False, False);
817 e_DrawFill(Box
[5], X
+4+Width
*16, Y
+4, 1, Height
*4, 0, False, False);
818 e_Draw(Box
[6], X
, Y
+4+Height
*16, 0, False, False);
819 e_DrawFill(Box
[7], X
+4, Y
+4+Height
*16, Width
*4, 1, 0, False, False);
820 e_Draw(Box
[8], X
+4+Width
*16, Y
+4+Height
*16, 0, False, False);
823 procedure DrawScroll(X
, Y
: Integer; Height
: Word; Up
, Down
: Boolean);
827 if Height
< 3 then Exit
;
830 g_Texture_Get(BSCROLL_UPA
, ID
)
832 g_Texture_Get(BSCROLL_UPU
, ID
);
833 e_Draw(ID
, X
, Y
, 0, False, False);
836 g_Texture_Get(BSCROLL_DOWNA
, ID
)
838 g_Texture_Get(BSCROLL_DOWNU
, ID
);
839 e_Draw(ID
, X
, Y
+(Height
-1)*16, 0, False, False);
841 g_Texture_Get(BSCROLL_MIDDLE
, ID
);
842 e_DrawFill(ID
, X
, Y
+16, 1, Height
-2, 0, False, False);
847 constructor TGUIWindow
.Create(Name
: string);
850 FActiveControl
:= nil;
854 FOnCloseEvent
:= nil;
858 destructor TGUIWindow
.Destroy
;
865 for i
:= 0 to High(Childs
) do
869 function TGUIWindow
.AddChild(Child
: TGUIControl
): TGUIControl
;
871 Child
.FWindow
:= Self
;
873 SetLength(Childs
, Length(Childs
) + 1);
874 Childs
[High(Childs
)] := Child
;
879 procedure TGUIWindow
.Update
;
883 for i
:= 0 to High(Childs
) do
884 if Childs
[i
] <> nil then Childs
[i
].Update
;
887 procedure TGUIWindow
.Draw
;
893 if FBackTexture
<> '' then // Here goes code duplication from g_game.pas:DrawMenuBackground()
894 if g_Texture_Get(FBackTexture
, ID
) then
897 e_GetTextureSize(ID
, @tw
, @th
);
899 tw
:= round(tw
* 1.333 * (gScreenHeight
/ th
))
901 tw
:= trunc(tw
* (gScreenHeight
/ th
));
902 e_DrawSize(ID
, (gScreenWidth
- tw
) div 2, 0, 0, False, False, tw
, gScreenHeight
);
905 e_Clear(0.5, 0.5, 0.5);
908 if FName
= 'AuthorsMenu' then
909 e_DarkenQuadWH(0, 0, gScreenWidth
, gScreenHeight
, 150);
911 for i
:= 0 to High(Childs
) do
912 if Childs
[i
] <> nil then Childs
[i
].Draw
;
915 procedure TGUIWindow
.OnMessage(var Msg
: TMessage
);
917 if FActiveControl
<> nil then FActiveControl
.OnMessage(Msg
);
918 if @FOnKeyDown
<> nil then FOnKeyDown(Msg
.wParam
);
919 if @FOnKeyDownEx
<> nil then FOnKeyDownEx(self
, Msg
.wParam
);
921 if Msg
.Msg
= WM_KEYDOWN
then
933 procedure TGUIWindow
.SetActive(Control
: TGUIControl
);
935 FActiveControl
:= Control
;
938 function TGUIWindow
.GetControl(Name
: String): TGUIControl
;
944 if Childs
<> nil then
945 for i
:= 0 to High(Childs
) do
946 if Childs
[i
] <> nil then
947 if LowerCase(Childs
[i
].FName
) = LowerCase(Name
) then
953 Assert(Result
<> nil, 'Window Control "'+Name
+'" not Found!');
958 constructor TGUIControl
.Create();
964 FRightAlign
:= false;
968 procedure TGUIControl
.OnMessage(var Msg
: TMessage
);
974 procedure TGUIControl
.Update();
978 procedure TGUIControl
.Draw();
982 function TGUIControl
.WantActivationKey (key
: LongInt): Boolean;
987 function TGUIControl
.GetWidth(): Integer;
992 function TGUIControl
.GetHeight(): Integer;
999 procedure TGUITextButton
.Click(Silent
: Boolean = False);
1001 if (FSound
<> '') and (not Silent
) then g_Sound_PlayEx(FSound
);
1003 if @Proc
<> nil then Proc();
1004 if @ProcEx
<> nil then ProcEx(self
);
1006 if FShowWindow
<> '' then g_GUI_ShowWindow(FShowWindow
);
1009 constructor TGUITextButton
.Create(aProc
: Pointer; FontID
: DWORD
; Text: string);
1016 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
1021 destructor TGUITextButton
.Destroy
;
1027 procedure TGUITextButton
.Draw
;
1029 FFont
.Draw(FX
, FY
, FText
, FColor
.R
, FColor
.G
, FColor
.B
)
1032 function TGUITextButton
.GetHeight
: Integer;
1036 FFont
.GetTextSize(FText
, w
, h
);
1040 function TGUITextButton
.GetWidth
: Integer;
1044 FFont
.GetTextSize(FText
, w
, h
);
1048 procedure TGUITextButton
.OnMessage(var Msg
: TMessage
);
1050 if not FEnabled
then Exit
;
1057 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
: Click();
1062 procedure TGUITextButton
.Update
;
1069 constructor TFont
.Create(FontID
: DWORD
; FontType
: TFontType
);
1074 FFontType
:= FontType
;
1077 destructor TFont
.Destroy
;
1083 procedure TFont
.Draw(X
, Y
: Integer; Text: string; R
, G
, B
: Byte);
1085 if FFontType
= TFontType
.Character
then e_CharFont_PrintEx(ID
, X
, Y
, Text, _RGB(R
, G
, B
), FScale
)
1086 else e_TextureFontPrintEx(X
, Y
, Text, ID
, R
, G
, B
, FScale
);
1089 procedure TFont
.GetTextSize(Text: string; var w
, h
: Word);
1093 if FFontType
= TFontType
.Character
then e_CharFont_GetSize(ID
, Text, w
, h
)
1096 e_TextureFontGetSize(ID
, cw
, ch
);
1097 w
:= cw
*Length(Text);
1101 w
:= Round(w
*FScale
);
1102 h
:= Round(h
*FScale
);
1107 function TGUIMainMenu
.AddButton(fProc
: Pointer; Caption
: string; ShowWindow
: string = ''): TGUITextButton
;
1115 SetLength(FButtons
, Length(FButtons
)+1);
1116 FButtons
[High(FButtons
)] := TGUITextButton
.Create(fProc
, FFontID
, Caption
);
1117 FButtons
[High(FButtons
)].ShowWindow
:= ShowWindow
;
1118 with FButtons
[High(FButtons
)] do
1120 if (fProc
<> nil) or (ShowWindow
<> '') then FColor
:= MAINMENU_ITEMS_COLOR
1121 else FColor
:= MAINMENU_UNACTIVEITEMS_COLOR
;
1122 FSound
:= MAINMENU_CLICKSOUND
;
1125 _x
:= gScreenWidth
div 2;
1127 for a
:= 0 to High(FButtons
) do
1128 if FButtons
[a
] <> nil then
1129 _x
:= Min(_x
, (gScreenWidth
div 2)-(FButtons
[a
].GetWidth
div 2));
1131 if FLogo
<> 0 then e_GetTextureSize(FLogo
, nil, @lh
);
1132 hh
:= FButtons
[High(FButtons
)].GetHeight
;
1134 if FLogo
<> 0 then h
:= lh
+ hh
* (1 + Length(FButtons
)) + MAINMENU_SPACE
* (Length(FButtons
) - 1)
1135 else h
:= hh
* (2 + Length(FButtons
)) + MAINMENU_SPACE
* (Length(FButtons
) - 1);
1136 h
:= (gScreenHeight
div 2) - (h
div 2);
1138 if FHeader
<> nil then with FHeader
do
1144 if FLogo
<> 0 then Inc(h
, lh
)
1147 for a
:= 0 to High(FButtons
) do
1149 if FButtons
[a
] <> nil then
1156 Inc(h
, hh
+MAINMENU_SPACE
);
1159 Result
:= FButtons
[High(FButtons
)];
1162 procedure TGUIMainMenu
.AddSpace
;
1164 SetLength(FButtons
, Length(FButtons
)+1);
1165 FButtons
[High(FButtons
)] := nil;
1168 constructor TGUIMainMenu
.Create(FontID
: DWORD
; Logo
, Header
: string);
1174 FCounter
:= MAINMENU_MARKERDELAY
;
1176 g_Texture_Get(MAINMENU_MARKER1
, FMarkerID1
);
1177 g_Texture_Get(MAINMENU_MARKER2
, FMarkerID2
);
1179 if not g_Texture_Get(Logo
, FLogo
) then
1181 FHeader
:= TGUILabel
.Create(Header
, FFontID
);
1184 FColor
:= MAINMENU_HEADER_COLOR
;
1185 FX
:= (gScreenWidth
div 2)-(GetWidth
div 2);
1186 FY
:= (gScreenHeight
div 2)-(GetHeight
div 2);
1191 destructor TGUIMainMenu
.Destroy
;
1195 if FButtons
<> nil then
1196 for a
:= 0 to High(FButtons
) do
1204 procedure TGUIMainMenu
.Draw
;
1212 if FHeader
<> nil then FHeader
.Draw
1214 e_GetTextureSize(FLogo
, @w
, @h
);
1215 e_Draw(FLogo
, ((gScreenWidth
div 2) - (w
div 2)), FButtons
[0].FY
- FButtons
[0].GetHeight
- h
, 0, True, False);
1218 if FButtons
<> nil then
1220 for a
:= 0 to High(FButtons
) do
1221 if FButtons
[a
] <> nil then FButtons
[a
].Draw
;
1223 if FIndex
<> -1 then
1224 e_Draw(FMarkerID1
, FButtons
[FIndex
].FX
-48, FButtons
[FIndex
].FY
, 0, True, False);
1228 procedure TGUIMainMenu
.EnableButton(aName
: string; e
: Boolean);
1232 if FButtons
= nil then Exit
;
1234 for a
:= 0 to High(FButtons
) do
1235 if (FButtons
[a
] <> nil) and (FButtons
[a
].Name
= aName
) then
1237 if e
then FButtons
[a
].FColor
:= MAINMENU_ITEMS_COLOR
1238 else FButtons
[a
].FColor
:= MAINMENU_UNACTIVEITEMS_COLOR
;
1239 FButtons
[a
].Enabled
:= e
;
1244 function TGUIMainMenu
.GetButton(aName
: string): TGUITextButton
;
1250 if FButtons
= nil then Exit
;
1252 for a
:= 0 to High(FButtons
) do
1253 if (FButtons
[a
] <> nil) and (FButtons
[a
].Name
= aName
) then
1255 Result
:= FButtons
[a
];
1260 procedure TGUIMainMenu
.OnMessage(var Msg
: TMessage
);
1265 if not FEnabled
then Exit
;
1269 if FButtons
= nil then Exit
;
1272 for a
:= 0 to High(FButtons
) do
1273 if FButtons
[a
] <> nil then
1279 if not ok
then Exit
;
1284 IK_UP
, IK_KPUP
, VK_UP
, JOY0_UP
, JOY1_UP
, JOY2_UP
, JOY3_UP
:
1288 if FIndex
< 0 then FIndex
:= High(FButtons
);
1289 until FButtons
[FIndex
] <> nil;
1291 g_Sound_PlayEx(MENU_CHANGESOUND
);
1293 IK_DOWN
, IK_KPDOWN
, VK_DOWN
, JOY0_DOWN
, JOY1_DOWN
, JOY2_DOWN
, JOY3_DOWN
:
1297 if FIndex
> High(FButtons
) then FIndex
:= 0;
1298 until FButtons
[FIndex
] <> nil;
1300 g_Sound_PlayEx(MENU_CHANGESOUND
);
1302 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
;
1307 procedure TGUIMainMenu
.Update
;
1313 if FCounter
= 0 then
1316 FMarkerID1
:= FMarkerID2
;
1319 FCounter
:= MAINMENU_MARKERDELAY
;
1320 end else Dec(FCounter
);
1325 constructor TGUILabel
.Create(Text: string; FontID
: DWORD
);
1329 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
1333 FOnClickEvent
:= nil;
1336 procedure TGUILabel
.Draw
;
1342 FFont
.GetTextSize(FText
, w
, h
);
1343 FFont
.Draw(FX
+FMaxWidth
-w
, FY
, FText
, FColor
.R
, FColor
.G
, FColor
.B
);
1347 FFont
.Draw(FX
, FY
, FText
, FColor
.R
, FColor
.G
, FColor
.B
);
1351 function TGUILabel
.GetHeight
: Integer;
1355 FFont
.GetTextSize(FText
, w
, h
);
1359 function TGUILabel
.GetWidth
: Integer;
1363 if FFixedLen
= 0 then
1364 FFont
.GetTextSize(FText
, w
, h
)
1366 w
:= e_CharFont_GetMaxWidth(FFont
.ID
)*FFixedLen
;
1370 procedure TGUILabel
.OnMessage(var Msg
: TMessage
);
1372 if not FEnabled
then Exit
;
1379 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
: if @FOnClickEvent
<> nil then FOnClickEvent();
1386 function TGUIMenu
.AddButton(Proc
: Pointer; fText
: string; _ShowWindow
: string = ''): TGUITextButton
;
1393 Control
:= TGUITextButton
.Create(Proc
, FFontID
, fText
);
1394 with Control
as TGUITextButton
do
1396 ShowWindow
:= _ShowWindow
;
1397 FColor
:= MENU_ITEMSCTRL_COLOR
;
1401 ControlType
:= TGUITextButton
;
1403 Result
:= (Control
as TGUITextButton
);
1406 if FIndex
= -1 then FIndex
:= i
;
1411 procedure TGUIMenu
.AddLine(fText
: string);
1418 Text := TGUILabel
.Create(fText
, FFontID
);
1421 FColor
:= MENU_ITEMSTEXT_COLOR
;
1430 procedure TGUIMenu
.AddText(fText
: string; MaxWidth
: Word);
1435 l
:= GetLines(fText
, FFontID
, MaxWidth
);
1437 if l
= nil then Exit
;
1439 for a
:= 0 to High(l
) do
1444 Text := TGUILabel
.Create(l
[a
], FFontID
);
1447 with Text do begin FColor
:= _RGB(255, 0, 0); end;
1451 with Text do begin FColor
:= MENU_ITEMSTEXT_COLOR
; end;
1461 procedure TGUIMenu
.AddSpace
;
1475 constructor TGUIMenu
.Create(HeaderFont
, ItemsFont
: DWORD
; Header
: string);
1481 FFontID
:= ItemsFont
;
1482 FCounter
:= MENU_MARKERDELAY
;
1486 FHeader
:= TGUILabel
.Create(Header
, HeaderFont
);
1489 FX
:= (gScreenWidth
div 2)-(GetWidth
div 2);
1491 FColor
:= MAINMENU_HEADER_COLOR
;
1495 destructor TGUIMenu
.Destroy
;
1499 if FItems
<> nil then
1500 for a
:= 0 to High(FItems
) do
1514 procedure TGUIMenu
.Draw
;
1516 a
, locx
, locy
: Integer;
1520 if FHeader
<> nil then FHeader
.Draw
;
1522 if FItems
<> nil then
1523 for a
:= 0 to High(FItems
) do
1525 if FItems
[a
].Text <> nil then FItems
[a
].Text.Draw
;
1526 if FItems
[a
].Control
<> nil then FItems
[a
].Control
.Draw
;
1529 if (FIndex
<> -1) and (FCounter
> MENU_MARKERDELAY
div 2) then
1534 if FItems
[FIndex
].Text <> nil then
1536 locx
:= FItems
[FIndex
].Text.FX
;
1537 locy
:= FItems
[FIndex
].Text.FY
;
1539 if FItems
[FIndex
].Text.RightAlign
then
1541 locx
:= locx
+FItems
[FIndex
].Text.FMaxWidth
-FItems
[FIndex
].Text.GetWidth
;
1544 else if FItems
[FIndex
].Control
<> nil then
1546 locx
:= FItems
[FIndex
].Control
.FX
;
1547 locy
:= FItems
[FIndex
].Control
.FY
;
1550 locx
:= locx
-e_CharFont_GetMaxWidth(FFontID
);
1552 e_CharFont_PrintEx(FFontID
, locx
, locy
, #16, _RGB(255, 0, 0));
1556 function TGUIMenu
.GetControl(aName
: String): TGUIControl
;
1562 if FItems
<> nil then
1563 for a
:= 0 to High(FItems
) do
1564 if FItems
[a
].Control
<> nil then
1565 if LowerCase(FItems
[a
].Control
.Name
) = LowerCase(aName
) then
1567 Result
:= FItems
[a
].Control
;
1571 Assert(Result
<> nil, 'GUI control "'+aName
+'" not found!');
1574 function TGUIMenu
.GetControlsText(aName
: String): TGUILabel
;
1580 if FItems
<> nil then
1581 for a
:= 0 to High(FItems
) do
1582 if FItems
[a
].Control
<> nil then
1583 if LowerCase(FItems
[a
].Control
.Name
) = LowerCase(aName
) then
1585 Result
:= FItems
[a
].Text;
1589 Assert(Result
<> nil, 'GUI control''s text "'+aName
+'" not found!');
1592 function TGUIMenu
.NewItem
: Integer;
1594 SetLength(FItems
, Length(FItems
)+1);
1595 Result
:= High(FItems
);
1598 procedure TGUIMenu
.OnMessage(var Msg
: TMessage
);
1603 if not FEnabled
then Exit
;
1607 if FItems
= nil then Exit
;
1610 for a
:= 0 to High(FItems
) do
1611 if FItems
[a
].Control
<> nil then
1617 if not ok
then Exit
;
1619 if (Msg
.Msg
= WM_KEYDOWN
) and (FIndex
<> -1) and (FItems
[FIndex
].Control
<> nil) and
1620 (FItems
[FIndex
].Control
.WantActivationKey(Msg
.wParam
)) then
1622 FItems
[FIndex
].Control
.OnMessage(Msg
);
1623 g_Sound_PlayEx(MENU_CLICKSOUND
);
1631 IK_UP
, IK_KPUP
, VK_UP
,JOY0_UP
, JOY1_UP
, JOY2_UP
, JOY3_UP
:
1636 if c
> Length(FItems
) then
1643 if FIndex
< 0 then FIndex
:= High(FItems
);
1644 until (FItems
[FIndex
].Control
<> nil) and
1645 (FItems
[FIndex
].Control
.Enabled
);
1649 g_Sound_PlayEx(MENU_CHANGESOUND
);
1652 IK_DOWN
, IK_KPDOWN
, VK_DOWN
, JOY0_DOWN
, JOY1_DOWN
, JOY2_DOWN
, JOY3_DOWN
:
1657 if c
> Length(FItems
) then
1664 if FIndex
> High(FItems
) then FIndex
:= 0;
1665 until (FItems
[FIndex
].Control
<> nil) and
1666 (FItems
[FIndex
].Control
.Enabled
);
1670 g_Sound_PlayEx(MENU_CHANGESOUND
);
1673 IK_LEFT
, IK_RIGHT
, IK_KPLEFT
, IK_KPRIGHT
, VK_LEFT
, VK_RIGHT
,
1674 JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
,
1675 JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
1677 if FIndex
<> -1 then
1678 if FItems
[FIndex
].Control
<> nil then
1679 FItems
[FIndex
].Control
.OnMessage(Msg
);
1681 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
1683 if FIndex
<> -1 then
1685 if FItems
[FIndex
].Control
<> nil then FItems
[FIndex
].Control
.OnMessage(Msg
);
1687 g_Sound_PlayEx(MENU_CLICKSOUND
);
1691 if FYesNo
and (length(FItems
) > 1) then
1693 Msg
.wParam
:= IK_RETURN
; // to register keypress
1694 FIndex
:= High(FItems
)-1;
1695 if FItems
[FIndex
].Control
<> nil then FItems
[FIndex
].Control
.OnMessage(Msg
);
1698 if FYesNo
and (length(FItems
) > 1) then
1700 Msg
.wParam
:= IK_RETURN
; // to register keypress
1701 FIndex
:= High(FItems
);
1702 if FItems
[FIndex
].Control
<> nil then FItems
[FIndex
].Control
.OnMessage(Msg
);
1709 procedure TGUIMenu
.ReAlign();
1711 a
, tx
, cx
, w
, h
: Integer;
1712 cww
: array of Integer; // cached widths
1715 if FItems
= nil then Exit
;
1717 SetLength(cww
, length(FItems
));
1719 for a
:= 0 to High(FItems
) do
1721 if FItems
[a
].Text <> nil then
1723 cww
[a
] := FItems
[a
].Text.GetWidth
;
1724 if maxcww
< cww
[a
] then maxcww
:= cww
[a
];
1735 for a
:= 0 to High(FItems
) do
1738 if FItems
[a
].Text <> nil then w
:= FItems
[a
].Text.GetWidth
;
1739 if FItems
[a
].Control
<> nil then
1742 if FItems
[a
].ControlType
= TGUILabel
then w
:= w
+(FItems
[a
].Control
as TGUILabel
).GetWidth
1743 else if FItems
[a
].ControlType
= TGUITextButton
then w
:= w
+(FItems
[a
].Control
as TGUITextButton
).GetWidth
1744 else if FItems
[a
].ControlType
= TGUIScroll
then w
:= w
+(FItems
[a
].Control
as TGUIScroll
).GetWidth
1745 else if FItems
[a
].ControlType
= TGUISwitch
then w
:= w
+(FItems
[a
].Control
as TGUISwitch
).GetWidth
1746 else if FItems
[a
].ControlType
= TGUIEdit
then w
:= w
+(FItems
[a
].Control
as TGUIEdit
).GetWidth
1747 else if FItems
[a
].ControlType
= TGUIKeyRead
then w
:= w
+(FItems
[a
].Control
as TGUIKeyRead
).GetWidth
1748 else if FItems
[a
].ControlType
= TGUIKeyRead2
then w
:= w
+(FItems
[a
].Control
as TGUIKeyRead2
).GetWidth
1749 else if FItems
[a
].ControlType
= TGUIListBox
then w
:= w
+(FItems
[a
].Control
as TGUIListBox
).GetWidth
1750 else if FItems
[a
].ControlType
= TGUIFileListBox
then w
:= w
+(FItems
[a
].Control
as TGUIFileListBox
).GetWidth
1751 else if FItems
[a
].ControlType
= TGUIMemo
then w
:= w
+(FItems
[a
].Control
as TGUIMemo
).GetWidth
;
1753 tx
:= Min(tx
, (gScreenWidth
div 2)-(w
div 2));
1758 for a
:= 0 to High(FItems
) do
1762 if (Text <> nil) and (Control
= nil) then Continue
;
1764 if Text <> nil then w
:= tx
+Text.GetWidth
;
1765 if w
> cx
then cx
:= w
;
1769 cx
:= cx
+MENU_HSPACE
;
1771 h
:= FHeader
.GetHeight
*2+MENU_VSPACE
*(Length(FItems
)-1);
1773 for a
:= 0 to High(FItems
) do
1777 if (ControlType
= TGUIListBox
) or (ControlType
= TGUIFileListBox
) then
1778 h
:= h
+(FItems
[a
].Control
as TGUIListBox
).GetHeight()
1780 h
:= h
+e_CharFont_GetMaxHeight(FFontID
);
1784 h
:= (gScreenHeight
div 2)-(h
div 2);
1788 FX
:= (gScreenWidth
div 2)-(GetWidth
div 2);
1791 Inc(h
, GetHeight
*2);
1794 for a
:= 0 to High(FItems
) do
1806 if Text.RightAlign
and (length(cww
) > a
) then
1808 //Text.FX := Text.FX+maxcww;
1809 Text.FMaxWidth
:= maxcww
;
1813 if Control
<> nil then
1830 if (ControlType
= TGUIListBox
) or (ControlType
= TGUIFileListBox
) then Inc(h
, (Control
as TGUIListBox
).GetHeight
+MENU_VSPACE
)
1831 else if ControlType
= TGUIMemo
then Inc(h
, (Control
as TGUIMemo
).GetHeight
+MENU_VSPACE
)
1832 else Inc(h
, e_CharFont_GetMaxHeight(FFontID
)+MENU_VSPACE
);
1836 // another ugly hack
1837 if FYesNo
and (length(FItems
) > 1) then
1840 for a
:= High(FItems
)-1 to High(FItems
) do
1842 if (FItems
[a
].Control
<> nil) and (FItems
[a
].ControlType
= TGUITextButton
) then
1844 cx
:= (FItems
[a
].Control
as TGUITextButton
).GetWidth
;
1845 if cx
> w
then w
:= cx
;
1850 for a
:= High(FItems
)-1 to High(FItems
) do
1852 if (FItems
[a
].Control
<> nil) and (FItems
[a
].ControlType
= TGUITextButton
) then
1854 FItems
[a
].Control
.FX
:= (gScreenWidth
-w
) div 2;
1861 function TGUIMenu
.AddScroll(fText
: string): TGUIScroll
;
1868 Control
:= TGUIScroll
.Create();
1870 Text := TGUILabel
.Create(fText
, FFontID
);
1873 FColor
:= MENU_ITEMSTEXT_COLOR
;
1876 ControlType
:= TGUIScroll
;
1878 Result
:= (Control
as TGUIScroll
);
1881 if FIndex
= -1 then FIndex
:= i
;
1886 function TGUIMenu
.AddSwitch(fText
: string): TGUISwitch
;
1893 Control
:= TGUISwitch
.Create(FFontID
);
1894 (Control
as TGUISwitch
).FColor
:= MENU_ITEMSCTRL_COLOR
;
1896 Text := TGUILabel
.Create(fText
, FFontID
);
1899 FColor
:= MENU_ITEMSTEXT_COLOR
;
1902 ControlType
:= TGUISwitch
;
1904 Result
:= (Control
as TGUISwitch
);
1907 if FIndex
= -1 then FIndex
:= i
;
1912 function TGUIMenu
.AddEdit(fText
: string): TGUIEdit
;
1919 Control
:= TGUIEdit
.Create(FFontID
);
1920 with Control
as TGUIEdit
do
1922 FWindow
:= Self
.FWindow
;
1923 FColor
:= MENU_ITEMSCTRL_COLOR
;
1926 if fText
= '' then Text := nil else
1928 Text := TGUILabel
.Create(fText
, FFontID
);
1929 Text.FColor
:= MENU_ITEMSTEXT_COLOR
;
1932 ControlType
:= TGUIEdit
;
1934 Result
:= (Control
as TGUIEdit
);
1937 if FIndex
= -1 then FIndex
:= i
;
1942 procedure TGUIMenu
.Update
;
1948 if FCounter
= 0 then FCounter
:= MENU_MARKERDELAY
else Dec(FCounter
);
1950 if FItems
<> nil then
1951 for a
:= 0 to High(FItems
) do
1952 if FItems
[a
].Control
<> nil then
1953 (FItems
[a
].Control
as FItems
[a
].ControlType
).Update
;
1956 function TGUIMenu
.AddKeyRead(fText
: string): TGUIKeyRead
;
1963 Control
:= TGUIKeyRead
.Create(FFontID
);
1964 with Control
as TGUIKeyRead
do
1966 FWindow
:= Self
.FWindow
;
1967 FColor
:= MENU_ITEMSCTRL_COLOR
;
1970 Text := TGUILabel
.Create(fText
, FFontID
);
1973 FColor
:= MENU_ITEMSTEXT_COLOR
;
1976 ControlType
:= TGUIKeyRead
;
1978 Result
:= (Control
as TGUIKeyRead
);
1981 if FIndex
= -1 then FIndex
:= i
;
1986 function TGUIMenu
.AddKeyRead2(fText
: string): TGUIKeyRead2
;
1993 Control
:= TGUIKeyRead2
.Create(FFontID
);
1994 with Control
as TGUIKeyRead2
do
1996 FWindow
:= Self
.FWindow
;
1997 FColor
:= MENU_ITEMSCTRL_COLOR
;
2000 Text := TGUILabel
.Create(fText
, FFontID
);
2003 FColor
:= MENU_ITEMSCTRL_COLOR
; //MENU_ITEMSTEXT_COLOR;
2007 ControlType
:= TGUIKeyRead2
;
2009 Result
:= (Control
as TGUIKeyRead2
);
2012 if FIndex
= -1 then FIndex
:= i
;
2017 function TGUIMenu
.AddList(fText
: string; Width
, Height
: Word): TGUIListBox
;
2024 Control
:= TGUIListBox
.Create(FFontID
, Width
, Height
);
2025 with Control
as TGUIListBox
do
2027 FWindow
:= Self
.FWindow
;
2028 FActiveColor
:= MENU_ITEMSCTRL_COLOR
;
2029 FUnActiveColor
:= MENU_ITEMSTEXT_COLOR
;
2032 Text := TGUILabel
.Create(fText
, FFontID
);
2035 FColor
:= MENU_ITEMSTEXT_COLOR
;
2038 ControlType
:= TGUIListBox
;
2040 Result
:= (Control
as TGUIListBox
);
2043 if FIndex
= -1 then FIndex
:= i
;
2048 function TGUIMenu
.AddFileList(fText
: string; Width
, Height
: Word): TGUIFileListBox
;
2055 Control
:= TGUIFileListBox
.Create(FFontID
, Width
, Height
);
2056 with Control
as TGUIFileListBox
do
2058 FWindow
:= Self
.FWindow
;
2059 FActiveColor
:= MENU_ITEMSCTRL_COLOR
;
2060 FUnActiveColor
:= MENU_ITEMSTEXT_COLOR
;
2063 if fText
= '' then Text := nil else
2065 Text := TGUILabel
.Create(fText
, FFontID
);
2066 Text.FColor
:= MENU_ITEMSTEXT_COLOR
;
2069 ControlType
:= TGUIFileListBox
;
2071 Result
:= (Control
as TGUIFileListBox
);
2074 if FIndex
= -1 then FIndex
:= i
;
2079 function TGUIMenu
.AddLabel(fText
: string): TGUILabel
;
2086 Control
:= TGUILabel
.Create('', FFontID
);
2087 with Control
as TGUILabel
do
2089 FWindow
:= Self
.FWindow
;
2090 FColor
:= MENU_ITEMSCTRL_COLOR
;
2093 Text := TGUILabel
.Create(fText
, FFontID
);
2096 FColor
:= MENU_ITEMSTEXT_COLOR
;
2099 ControlType
:= TGUILabel
;
2101 Result
:= (Control
as TGUILabel
);
2104 if FIndex
= -1 then FIndex
:= i
;
2109 function TGUIMenu
.AddMemo(fText
: string; Width
, Height
: Word): TGUIMemo
;
2116 Control
:= TGUIMemo
.Create(FFontID
, Width
, Height
);
2117 with Control
as TGUIMemo
do
2119 FWindow
:= Self
.FWindow
;
2120 FColor
:= MENU_ITEMSTEXT_COLOR
;
2123 if fText
= '' then Text := nil else
2125 Text := TGUILabel
.Create(fText
, FFontID
);
2126 Text.FColor
:= MENU_ITEMSTEXT_COLOR
;
2129 ControlType
:= TGUIMemo
;
2131 Result
:= (Control
as TGUIMemo
);
2134 if FIndex
= -1 then FIndex
:= i
;
2139 procedure TGUIMenu
.UpdateIndex();
2147 if (FIndex
< 0) or (FIndex
> High(FItems
)) then
2153 if FItems
[FIndex
].Control
.Enabled
then
2162 constructor TGUIScroll
.Create
;
2167 FOnChangeEvent
:= nil;
2169 g_Texture_Get(SCROLL_LEFT
, FLeftID
);
2170 g_Texture_Get(SCROLL_RIGHT
, FRightID
);
2171 g_Texture_Get(SCROLL_MIDDLE
, FMiddleID
);
2172 g_Texture_Get(SCROLL_MARKER
, FMarkerID
);
2175 procedure TGUIScroll
.Draw
;
2181 e_Draw(FLeftID
, FX
, FY
, 0, True, False);
2182 e_Draw(FRightID
, FX
+8+(FMax
+1)*8, FY
, 0, True, False);
2184 for a
:= 0 to FMax
do
2185 e_Draw(FMiddleID
, FX
+8+a
*8, FY
, 0, True, False);
2187 e_Draw(FMarkerID
, FX
+8+FValue
*8, FY
, 0, True, False);
2190 procedure TGUIScroll
.FSetValue(a
: Integer);
2192 if a
> FMax
then FValue
:= FMax
else FValue
:= a
;
2195 function TGUIScroll
.GetWidth
: Integer;
2197 Result
:= 16+(FMax
+1)*8;
2200 procedure TGUIScroll
.OnMessage(var Msg
: TMessage
);
2202 if not FEnabled
then Exit
;
2210 IK_LEFT
, IK_KPLEFT
, VK_LEFT
, JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
:
2214 g_Sound_PlayEx(SCROLL_SUBSOUND
);
2215 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2217 IK_RIGHT
, IK_KPRIGHT
, VK_RIGHT
, JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
2218 if FValue
< FMax
then
2221 g_Sound_PlayEx(SCROLL_ADDSOUND
);
2222 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2229 procedure TGUIScroll
.Update
;
2237 procedure TGUISwitch
.AddItem(Item
: string);
2239 SetLength(FItems
, Length(FItems
)+1);
2240 FItems
[High(FItems
)] := Item
;
2242 if FIndex
= -1 then FIndex
:= 0;
2245 constructor TGUISwitch
.Create(FontID
: DWORD
);
2251 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
2254 procedure TGUISwitch
.Draw
;
2258 FFont
.Draw(FX
, FY
, FItems
[FIndex
], FColor
.R
, FColor
.G
, FColor
.B
);
2261 function TGUISwitch
.GetText
: string;
2263 if FIndex
<> -1 then Result
:= FItems
[FIndex
]
2267 function TGUISwitch
.GetWidth
: Integer;
2274 if FItems
= nil then Exit
;
2276 for a
:= 0 to High(FItems
) do
2278 FFont
.GetTextSize(FItems
[a
], w
, h
);
2279 if w
> Result
then Result
:= w
;
2283 procedure TGUISwitch
.OnMessage(var Msg
: TMessage
);
2285 if not FEnabled
then Exit
;
2289 if FItems
= nil then Exit
;
2294 IK_RETURN
, IK_RIGHT
, IK_KPRETURN
, IK_KPRIGHT
, VK_FIRE
, VK_OPEN
, VK_RIGHT
,
2295 JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
,
2296 JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
2298 if FIndex
< High(FItems
) then
2303 g_Sound_PlayEx(SCROLL_ADDSOUND
);
2305 if @FOnChangeEvent
<> nil then
2306 FOnChangeEvent(Self
);
2309 IK_LEFT
, IK_KPLEFT
, VK_LEFT
,
2310 JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
:
2315 FIndex
:= High(FItems
);
2317 g_Sound_PlayEx(SCROLL_SUBSOUND
);
2319 if @FOnChangeEvent
<> nil then
2320 FOnChangeEvent(Self
);
2326 procedure TGUISwitch
.Update
;
2334 constructor TGUIEdit
.Create(FontID
: DWORD
);
2338 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
2344 g_Texture_Get(EDIT_LEFT
, FLeftID
);
2345 g_Texture_Get(EDIT_RIGHT
, FRightID
);
2346 g_Texture_Get(EDIT_MIDDLE
, FMiddleID
);
2349 procedure TGUIEdit
.Draw
;
2356 e_Draw(FLeftID
, FX
, FY
, 0, True, False);
2357 e_Draw(FRightID
, FX
+8+FWidth
*16, FY
, 0, True, False);
2359 for c
:= 0 to FWidth
-1 do
2360 e_Draw(FMiddleID
, FX
+8+c
*16, FY
, 0, True, False);
2365 if FInvalid
and (FWindow
.FActiveControl
<> self
) then begin r
:= 128; g
:= 128; b
:= 128; end;
2366 FFont
.Draw(FX
+8, FY
, FText
, r
, g
, b
);
2368 if (FWindow
.FActiveControl
= self
) then
2370 FFont
.GetTextSize(Copy(FText
, 1, FCaretPos
), w
, h
);
2371 h
:= e_CharFont_GetMaxHeight(FFont
.ID
);
2372 e_DrawLine(2, FX
+8+w
, FY
+h
-3, FX
+8+w
+EDIT_CURSORLEN
, FY
+h
-3,
2373 EDIT_CURSORCOLOR
.R
, EDIT_CURSORCOLOR
.G
, EDIT_CURSORCOLOR
.B
);
2377 function TGUIEdit
.GetWidth
: Integer;
2379 Result
:= 16+FWidth
*16;
2382 procedure TGUIEdit
.OnMessage(var Msg
: TMessage
);
2384 if not FEnabled
then Exit
;
2393 if (wParam
in [48..57]) and (Chr(wParam
) <> '`') then
2394 if Length(Text) < FMaxLength
then
2396 Insert(Chr(wParam
), FText
, FCaretPos
+ 1);
2402 if (wParam
in [32..255]) and (Chr(wParam
) <> '`') then
2403 if Length(Text) < FMaxLength
then
2405 Insert(Chr(wParam
), FText
, FCaretPos
+ 1);
2413 Delete(FText
, FCaretPos
, 1);
2414 if FCaretPos
> 0 then Dec(FCaretPos
);
2416 IK_DELETE
: Delete(FText
, FCaretPos
+ 1, 1);
2417 IK_END
, IK_KPEND
: FCaretPos
:= Length(FText
);
2418 IK_HOME
, IK_KPHOME
: FCaretPos
:= 0;
2419 IK_LEFT
, IK_KPLEFT
, VK_LEFT
, JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
: if FCaretPos
> 0 then Dec(FCaretPos
);
2420 IK_RIGHT
, IK_KPRIGHT
, VK_RIGHT
, JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
: if FCaretPos
< Length(FText
) then Inc(FCaretPos
);
2421 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
2424 if FActiveControl
<> Self
then
2427 if @FOnEnterEvent
<> nil then FOnEnterEvent(Self
);
2431 if FDefControl
<> '' then SetActive(GetControl(FDefControl
))
2432 else SetActive(nil);
2433 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2439 g_GUIGrabInput
:= (@FOnEnterEvent
= nil) and (FWindow
.FActiveControl
= Self
);
2440 g_Touch_ShowKeyboard(g_GUIGrabInput
)
2443 procedure TGUIEdit
.SetText(Text: string);
2445 if Length(Text) > FMaxLength
then SetLength(Text, FMaxLength
);
2447 FCaretPos
:= Length(FText
);
2450 procedure TGUIEdit
.Update
;
2457 constructor TGUIKeyRead
.Create(FontID
: DWORD
);
2463 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
2466 procedure TGUIKeyRead
.Draw
;
2470 FFont
.Draw(FX
, FY
, IfThen(FIsQuery
, KEYREAD_QUERY
, IfThen(FKey
<> 0, e_KeyNames
[FKey
], KEYREAD_CLEAR
)),
2471 FColor
.R
, FColor
.G
, FColor
.B
);
2474 function TGUIKeyRead
.GetWidth
: Integer;
2481 for a
:= 0 to 255 do
2483 FFont
.GetTextSize(e_KeyNames
[a
], w
, h
);
2484 Result
:= Max(Result
, w
);
2487 FFont
.GetTextSize(KEYREAD_QUERY
, w
, h
);
2488 if w
> Result
then Result
:= w
;
2490 FFont
.GetTextSize(KEYREAD_CLEAR
, w
, h
);
2491 if w
> Result
then Result
:= w
;
2494 function TGUIKeyRead
.WantActivationKey (key
: LongInt): Boolean;
2497 (key
= IK_BACKSPACE
) or
2501 procedure TGUIKeyRead
.OnMessage(var Msg
: TMessage
);
2502 procedure actDefCtl ();
2505 if FDefControl
<> '' then
2506 SetActive(GetControl(FDefControl
))
2514 if not FEnabled
then
2520 if not FIsQuery
then
2523 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
2526 if FActiveControl
<> Self
then
2530 IK_BACKSPACE
: // clear keybinding if we aren't waiting for a key
2543 VK_FIRSTKEY
..VK_LASTKEY
: // do not allow to bind virtual keys
2549 if (e_KeyNames
[wParam
] <> '') and not g_Console_MatchBind(wParam
, 'togglemenu') then
2557 g_GUIGrabInput
:= FIsQuery
2562 constructor TGUIKeyRead2
.Create(FontID
: DWORD
);
2575 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
2577 FMaxKeyNameWdt
:= 0;
2578 for a
:= 0 to 255 do
2580 FFont
.GetTextSize(e_KeyNames
[a
], w
, h
);
2581 FMaxKeyNameWdt
:= Max(FMaxKeyNameWdt
, w
);
2584 FMaxKeyNameWdt
:= FMaxKeyNameWdt
-(FMaxKeyNameWdt
div 3);
2586 FFont
.GetTextSize(KEYREAD_QUERY
, w
, h
);
2587 if w
> FMaxKeyNameWdt
then FMaxKeyNameWdt
:= w
;
2589 FFont
.GetTextSize(KEYREAD_CLEAR
, w
, h
);
2590 if w
> FMaxKeyNameWdt
then FMaxKeyNameWdt
:= w
;
2593 procedure TGUIKeyRead2
.Draw
;
2594 procedure drawText (idx
: Integer);
2600 if idx
= 0 then kk
:= FKey0
else kk
:= FKey1
;
2602 if idx
= 0 then x
:= FX
+8 else x
:= FX
+8+FMaxKeyNameWdt
+16;
2606 if FKeyIdx
= idx
then begin r
:= 255; g
:= 255; b
:= 255; end;
2607 if FIsQuery
and (FKeyIdx
= idx
) then
2608 FFont
.Draw(x
, y
, KEYREAD_QUERY
, r
, g
, b
)
2610 FFont
.Draw(x
, y
, IfThen(kk
<> 0, e_KeyNames
[kk
], KEYREAD_CLEAR
), r
, g
, b
);
2616 //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);
2617 //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);
2622 function TGUIKeyRead2
.GetWidth
: Integer;
2624 Result
:= FMaxKeyNameWdt
*2+8+8+16;
2627 function TGUIKeyRead2
.WantActivationKey (key
: LongInt): Boolean;
2630 IK_BACKSPACE
, IK_LEFT
, IK_RIGHT
, IK_KPLEFT
, IK_KPRIGHT
, VK_LEFT
, VK_RIGHT
,
2631 JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
,
2632 JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
2639 procedure TGUIKeyRead2
.OnMessage(var Msg
: TMessage
);
2640 procedure actDefCtl ();
2643 if FDefControl
<> '' then
2644 SetActive(GetControl(FDefControl
))
2652 if not FEnabled
then
2658 if not FIsQuery
then
2661 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
2664 if FActiveControl
<> Self
then
2668 IK_BACKSPACE
: // clear keybinding if we aren't waiting for a key
2670 if (FKeyIdx
= 0) then FKey0
:= 0 else FKey1
:= 0;
2673 IK_LEFT
, IK_KPLEFT
, VK_LEFT
, JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
:
2678 IK_RIGHT
, IK_KPRIGHT
, VK_RIGHT
, JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
2691 VK_FIRSTKEY
..VK_LASTKEY
: // do not allow to bind virtual keys
2697 if (e_KeyNames
[wParam
] <> '') and not g_Console_MatchBind(wParam
, 'togglemenu') then
2699 if (FKeyIdx
= 0) then FKey0
:= wParam
else FKey1
:= wParam
;
2707 g_GUIGrabInput
:= FIsQuery
2713 constructor TGUIModelView
.Create
;
2720 destructor TGUIModelView
.Destroy
;
2727 procedure TGUIModelView
.Draw
;
2731 DrawBox(FX
, FY
, 4, 4);
2733 if FModel
<> nil then
2734 r_PlayerModel_Draw(FModel
, FX
+4, FY
+4);
2737 procedure TGUIModelView
.NextAnim();
2739 if FModel
= nil then
2742 if FModel
.Animation
< A_PAIN
then
2743 FModel
.ChangeAnimation(FModel
.Animation
+1, True)
2745 FModel
.ChangeAnimation(A_STAND
, True);
2748 procedure TGUIModelView
.NextWeapon();
2750 if FModel
= nil then
2753 if FModel
.Weapon
< WP_LAST
then
2754 FModel
.SetWeapon(FModel
.Weapon
+1)
2756 FModel
.SetWeapon(WEAPON_KASTET
);
2759 procedure TGUIModelView
.OnMessage(var Msg
: TMessage
);
2765 procedure TGUIModelView
.SetColor(Red
, Green
, Blue
: Byte);
2767 if FModel
<> nil then FModel
.SetColor(Red
, Green
, Blue
);
2770 procedure TGUIModelView
.SetModel(ModelName
: string);
2774 FModel
:= g_PlayerModel_Get(ModelName
);
2777 procedure TGUIModelView
.Update
;
2784 if FModel
<> nil then FModel
.Update
;
2789 constructor TGUIMapPreview
.Create();
2795 destructor TGUIMapPreview
.Destroy();
2801 procedure TGUIMapPreview
.Draw();
2808 DrawBox(FX
, FY
, MAPPREVIEW_WIDTH
, MAPPREVIEW_HEIGHT
);
2810 if (FMapSize
.X
<= 0) or (FMapSize
.Y
<= 0) then
2813 e_DrawFillQuad(FX
+4, FY
+4,
2814 FX
+4 + Trunc(FMapSize
.X
/ FScale
) - 1,
2815 FY
+4 + Trunc(FMapSize
.Y
/ FScale
) - 1,
2818 if FMapData
<> nil then
2819 for a
:= 0 to High(FMapData
) do
2822 if X1
> MAPPREVIEW_WIDTH
*16 then Continue
;
2823 if Y1
> MAPPREVIEW_HEIGHT
*16 then Continue
;
2825 if X2
< 0 then Continue
;
2826 if Y2
< 0 then Continue
;
2828 if X2
> MAPPREVIEW_WIDTH
*16 then X2
:= MAPPREVIEW_WIDTH
*16;
2829 if Y2
> MAPPREVIEW_HEIGHT
*16 then Y2
:= MAPPREVIEW_HEIGHT
*16;
2831 if X1
< 0 then X1
:= 0;
2832 if Y1
< 0 then Y1
:= 0;
2873 if ((X2
-X1
) > 0) and ((Y2
-Y1
) > 0) then
2874 e_DrawFillQuad(FX
+4 + X1
, FY
+4 + Y1
,
2875 FX
+4 + X2
- 1, FY
+4 + Y2
- 1, r
, g
, b
, 0);
2879 procedure TGUIMapPreview
.OnMessage(var Msg
: TMessage
);
2885 procedure TGUIMapPreview
.SetMap(Res
: string);
2890 //header: TMapHeaderRec_1;
2895 map
: TDynRecord
= nil;
2902 FileName
:= g_ExtractWadName(Res
);
2904 WAD
:= TWADFile
.Create();
2905 if not WAD
.ReadFile(FileName
) then
2911 //k8: ignores path again
2912 if not WAD
.GetMapResource(g_ExtractFileName(Res
), Data
, Len
) then
2921 map
:= g_Map_ParseMap(Data
, Len
);
2931 if (map
= nil) then exit
;
2934 panlist
:= map
.field
['panel'];
2935 //header := GetMapHeader(map);
2937 FMapSize
.X
:= map
.Width
div 16;
2938 FMapSize
.Y
:= map
.Height
div 16;
2940 rX
:= Ceil(map
.Width
/ (MAPPREVIEW_WIDTH
*256.0));
2941 rY
:= Ceil(map
.Height
/ (MAPPREVIEW_HEIGHT
*256.0));
2942 FScale
:= max(rX
, rY
);
2946 if (panlist
<> nil) then
2948 for pan
in panlist
do
2950 if (pan
.PanelType
and (PANEL_WALL
or PANEL_CLOSEDOOR
or
2951 PANEL_STEP
or PANEL_WATER
or
2952 PANEL_ACID1
or PANEL_ACID2
)) <> 0 then
2954 SetLength(FMapData
, Length(FMapData
)+1);
2955 with FMapData
[High(FMapData
)] do
2960 X2
:= (pan
.X
+ pan
.Width
) div 16;
2961 Y2
:= (pan
.Y
+ pan
.Height
) div 16;
2963 X1
:= Trunc(X1
/FScale
+ 0.5);
2964 Y1
:= Trunc(Y1
/FScale
+ 0.5);
2965 X2
:= Trunc(X2
/FScale
+ 0.5);
2966 Y2
:= Trunc(Y2
/FScale
+ 0.5);
2968 if (X1
<> X2
) or (Y1
<> Y2
) then
2976 PanelType
:= pan
.PanelType
;
2982 //writeln('freeing map');
2987 procedure TGUIMapPreview
.ClearMap();
2989 SetLength(FMapData
, 0);
2996 procedure TGUIMapPreview
.Update();
3002 function TGUIMapPreview
.GetScaleStr(): String;
3004 if FScale
> 0.0 then
3006 Result
:= FloatToStrF(FScale
*16.0, ffFixed
, 3, 3);
3007 while (Result
[Length(Result
)] = '0') do
3008 Delete(Result
, Length(Result
), 1);
3009 if (Result
[Length(Result
)] = ',') or (Result
[Length(Result
)] = '.') then
3010 Delete(Result
, Length(Result
), 1);
3011 Result
:= '1 : ' + Result
;
3019 procedure TGUIListBox
.AddItem(Item
: string);
3021 SetLength(FItems
, Length(FItems
)+1);
3022 FItems
[High(FItems
)] := Item
;
3024 if FSort
then g_gui
.Sort(FItems
);
3027 function TGUIListBox
.ItemExists (item
: String): Boolean;
3031 while (i
<= High(FItems
)) and (FItems
[i
] <> item
) do Inc(i
);
3032 result
:= i
<= High(FItems
)
3035 procedure TGUIListBox
.Clear
;
3043 constructor TGUIListBox
.Create(FontID
: DWORD
; Width
, Height
: Word);
3047 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
3052 FOnChangeEvent
:= nil;
3054 FDrawScroll
:= True;
3057 procedure TGUIListBox
.Draw
;
3065 if FDrawBack
then DrawBox(FX
, FY
, FWidth
+1, FHeight
);
3067 DrawScroll(FX
+4+FWidth
*16, FY
+4, FHeight
, (FStartLine
> 0) and (FItems
<> nil),
3068 (FStartLine
+FHeight
-1 < High(FItems
)) and (FItems
<> nil));
3070 if FItems
<> nil then
3071 for a
:= FStartLine
to Min(High(FItems
), FStartLine
+FHeight
-1) do
3075 FFont
.GetTextSize(s
, w2
, h2
);
3076 while (Length(s
) > 0) and (w2
> FWidth
*16) do
3078 SetLength(s
, Length(s
)-1);
3079 FFont
.GetTextSize(s
, w2
, h2
);
3083 FFont
.Draw(FX
+4, FY
+4+(a
-FStartLine
)*16, s
, FActiveColor
.R
, FActiveColor
.G
, FActiveColor
.B
)
3085 FFont
.Draw(FX
+4, FY
+4+(a
-FStartLine
)*16, s
, FUnActiveColor
.R
, FUnActiveColor
.G
, FUnActiveColor
.B
);
3089 function TGUIListBox
.GetHeight
: Integer;
3091 Result
:= 8+FHeight
*16;
3094 function TGUIListBox
.GetWidth
: Integer;
3096 Result
:= 8+(FWidth
+1)*16;
3099 procedure TGUIListBox
.OnMessage(var Msg
: TMessage
);
3103 if not FEnabled
then Exit
;
3107 if FItems
= nil then Exit
;
3120 FIndex
:= High(FItems
);
3121 FStartLine
:= Max(High(FItems
)-FHeight
+1, 0);
3123 IK_UP
, IK_LEFT
, IK_KPUP
, IK_KPLEFT
, VK_LEFT
, JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
:
3127 if FIndex
< FStartLine
then Dec(FStartLine
);
3128 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
3130 IK_DOWN
, IK_RIGHT
, IK_KPDOWN
, IK_KPRIGHT
, VK_RIGHT
, JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
3131 if FIndex
< High(FItems
) then
3134 if FIndex
> FStartLine
+FHeight
-1 then Inc(FStartLine
);
3135 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
3137 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
3140 if FActiveControl
<> Self
then SetActive(Self
)
3142 if FDefControl
<> '' then SetActive(GetControl(FDefControl
))
3143 else SetActive(nil);
3147 for a
:= 0 to High(FItems
) do
3148 if (Length(FItems
[a
]) > 0) and (LowerCase(FItems
[a
][1]) = LowerCase(Chr(wParam
))) then
3151 FStartLine
:= Min(Max(FIndex
-1, 0), Length(FItems
)-FHeight
);
3152 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
3158 function TGUIListBox
.SelectedItem(): String;
3162 if (FIndex
< 0) or (FItems
= nil) or
3163 (FIndex
> High(FItems
)) then
3166 Result
:= FItems
[FIndex
];
3169 procedure TGUIListBox
.FSetItems(Items
: SSArray
);
3171 if FItems
<> nil then
3179 if FSort
then g_gui
.Sort(FItems
);
3182 procedure TGUIListBox
.SelectItem(Item
: String);
3186 if FItems
= nil then
3190 Item
:= LowerCase(Item
);
3192 for a
:= 0 to High(FItems
) do
3193 if LowerCase(FItems
[a
]) = Item
then
3199 if FIndex
< FHeight
then
3202 FStartLine
:= Min(FIndex
, Length(FItems
)-FHeight
);
3205 procedure TGUIListBox
.FSetIndex(aIndex
: Integer);
3207 if FItems
= nil then
3210 if (aIndex
< 0) or (aIndex
> High(FItems
)) then
3215 if FIndex
<= FHeight
then
3218 FStartLine
:= Min(FIndex
, Length(FItems
)-FHeight
);
3223 procedure TGUIFileListBox
.OnMessage(var Msg
: TMessage
);
3225 a
, b
: Integer; s
: AnsiString;
3227 if not FEnabled
then
3230 if FItems
= nil then
3241 if @FOnChangeEvent
<> nil then
3242 FOnChangeEvent(Self
);
3247 FIndex
:= High(FItems
);
3248 FStartLine
:= Max(High(FItems
)-FHeight
+1, 0);
3249 if @FOnChangeEvent
<> nil then
3250 FOnChangeEvent(Self
);
3253 IK_PAGEUP
, IK_KPPAGEUP
:
3255 if FIndex
> FHeight
then
3256 FIndex
:= FIndex
-FHeight
3260 if FStartLine
> FHeight
then
3261 FStartLine
:= FStartLine
-FHeight
3266 IK_PAGEDN
, IK_KPPAGEDN
:
3268 if FIndex
< High(FItems
)-FHeight
then
3269 FIndex
:= FIndex
+FHeight
3271 FIndex
:= High(FItems
);
3273 if FStartLine
< High(FItems
)-FHeight
then
3274 FStartLine
:= FStartLine
+FHeight
3276 FStartLine
:= High(FItems
)-FHeight
+1;
3279 IK_UP
, IK_LEFT
, IK_KPUP
, IK_KPLEFT
, VK_UP
, VK_LEFT
, JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
:
3283 if FIndex
< FStartLine
then
3285 if @FOnChangeEvent
<> nil then
3286 FOnChangeEvent(Self
);
3289 IK_DOWN
, IK_RIGHT
, IK_KPDOWN
, IK_KPRIGHT
, VK_DOWN
, VK_RIGHT
, JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
3290 if FIndex
< High(FItems
) then
3293 if FIndex
> FStartLine
+FHeight
-1 then
3295 if @FOnChangeEvent
<> nil then
3296 FOnChangeEvent(Self
);
3299 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
3302 if FActiveControl
<> Self
then
3306 if FItems
[FIndex
][1] = #29 then // Ïàïêà
3308 if FItems
[FIndex
] = #29 + '..' then
3310 //e_LogWritefln('TGUIFileListBox: Upper dir "%s" -> "%s"', [FSubPath, e_UpperDir(FSubPath)]);
3311 FSubPath
:= e_UpperDir(FSubPath
)
3315 s
:= Copy(AnsiString(FItems
[FIndex
]), 2);
3316 //e_LogWritefln('TGUIFileListBox: Enter dir "%s" -> "%s"', [FSubPath, e_CatPath(FSubPath, s)]);
3317 FSubPath
:= e_CatPath(FSubPath
, s
);
3324 if FDefControl
<> '' then
3325 SetActive(GetControl(FDefControl
))
3333 for b
:= FIndex
+ 1 to High(FItems
) + FIndex
do
3335 a
:= b
mod Length(FItems
);
3336 if ( (Length(FItems
[a
]) > 0) and
3337 (LowerCase(FItems
[a
][1]) = LowerCase(Chr(wParam
))) ) or
3338 ( (Length(FItems
[a
]) > 1) and
3339 (FItems
[a
][1] = #29) and // Ïàïêà
3340 (LowerCase(FItems
[a
][2]) = LowerCase(Chr(wParam
))) ) then
3343 FStartLine
:= Min(Max(FIndex
-1, 0), Length(FItems
)-FHeight
);
3344 if @FOnChangeEvent
<> nil then
3345 FOnChangeEvent(Self
);
3352 procedure TGUIFileListBox
.ScanDirs
;
3353 var i
, j
: Integer; path
: AnsiString; SR
: TSearchRec
; sm
, sc
: String;
3357 i
:= High(FBaseList
);
3360 path
:= e_CatPath(FBaseList
[i
], FSubPath
);
3363 if FindFirst(path
+ '/' + '*', faDirectory
, SR
) = 0 then
3366 if LongBool(SR
.Attr
and faDirectory
) then
3367 if (SR
.Name
<> '.') and ((FSubPath
<> '') or (SR
.Name
<> '..')) then
3368 if Self
.ItemExists(#1 + SR
.Name
) = false then
3369 Self
.AddItem(#1 + SR
.Name
)
3370 until FindNext(SR
) <> 0
3377 i
:= High(FBaseList
);
3380 path
:= e_CatPath(FBaseList
[i
], FSubPath
);
3386 j
:= length(sm
) + 1;
3387 sc
:= Copy(sm
, 1, j
- 1);
3389 if FindFirst(path
+ '/' + sc
, faAnyFile
, SR
) = 0 then
3392 if Self
.ItemExists(SR
.Name
) = false then
3394 until FindNext(SR
) <> 0
3401 for i
:= 0 to High(FItems
) do
3402 if FItems
[i
][1] = #1 then
3403 FItems
[i
][1] := #29;
3406 procedure TGUIFileListBox
.SetBase (dirs
: SSArray
; path
: String = '');
3413 function TGUIFileListBox
.SelectedItem (): String;
3417 if (FIndex
>= 0) and (FIndex
<= High(FItems
)) and (FItems
[FIndex
][1] <> '/') and (FItems
[FIndex
][1] <> '\') then
3419 s
:= e_CatPath(FSubPath
, FItems
[FIndex
]);
3420 if e_FindResource(FBaseList
, s
) = true then
3421 result
:= ExpandFileName(s
)
3423 e_LogWritefln('TGUIFileListBox.SelectedItem -> "%s"', [result
]);
3426 procedure TGUIFileListBox
.UpdateFileList();
3430 if (FIndex
= -1) or (FItems
= nil) or
3431 (FIndex
> High(FItems
)) or
3432 (FItems
[FIndex
][1] = '/') or
3433 (FItems
[FIndex
][1] = '\') then
3436 fn
:= FItems
[FIndex
];
3447 procedure TGUIMemo
.Clear
;
3453 constructor TGUIMemo
.Create(FontID
: DWORD
; Width
, Height
: Word);
3457 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
3462 FDrawScroll
:= True;
3465 procedure TGUIMemo
.Draw
;
3471 if FDrawBack
then DrawBox(FX
, FY
, FWidth
+1, FHeight
);
3473 DrawScroll(FX
+4+FWidth
*16, FY
+4, FHeight
, (FStartLine
> 0) and (FLines
<> nil),
3474 (FStartLine
+FHeight
-1 < High(FLines
)) and (FLines
<> nil));
3476 if FLines
<> nil then
3477 for a
:= FStartLine
to Min(High(FLines
), FStartLine
+FHeight
-1) do
3478 FFont
.Draw(FX
+4, FY
+4+(a
-FStartLine
)*16, FLines
[a
], FColor
.R
, FColor
.G
, FColor
.B
);
3481 function TGUIMemo
.GetHeight
: Integer;
3483 Result
:= 8+FHeight
*16;
3486 function TGUIMemo
.GetWidth
: Integer;
3488 Result
:= 8+(FWidth
+1)*16;
3491 procedure TGUIMemo
.OnMessage(var Msg
: TMessage
);
3493 if not FEnabled
then Exit
;
3497 if FLines
= nil then Exit
;
3503 IK_UP
, IK_LEFT
, IK_KPUP
, IK_KPLEFT
, VK_UP
, VK_LEFT
, JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
:
3504 if FStartLine
> 0 then
3506 IK_DOWN
, IK_RIGHT
, IK_KPDOWN
, IK_KPRIGHT
, VK_DOWN
, VK_RIGHT
, JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
3507 if FStartLine
< Length(FLines
)-FHeight
then
3509 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
3512 if FActiveControl
<> Self
then
3518 if FDefControl
<> '' then SetActive(GetControl(FDefControl
))
3519 else SetActive(nil);
3525 procedure TGUIMemo
.SetText(Text: string);
3528 FLines
:= GetLines(Text, FFont
.ID
, FWidth
*16);
3533 procedure TGUIimage
.ClearImage();
3535 if FImageRes
= '' then Exit
;
3537 g_Texture_Delete(FImageRes
);
3541 constructor TGUIimage
.Create();
3548 destructor TGUIimage
.Destroy();
3553 procedure TGUIimage
.Draw();
3559 if FImageRes
= '' then
3561 if g_Texture_Get(FDefaultRes
, ID
) then e_Draw(ID
, FX
, FY
, 0, True, False);
3564 if g_Texture_Get(FImageRes
, ID
) then e_Draw(ID
, FX
, FY
, 0, True, False);
3567 procedure TGUIimage
.OnMessage(var Msg
: TMessage
);
3572 procedure TGUIimage
.SetImage(Res
: string);
3576 if g_Texture_CreateWADEx(Res
, Res
) then FImageRes
:= Res
;
3579 procedure TGUIimage
.Update();