6 e_graphics
, e_input
, g_playermodel
, g_basic
, MAPSTRUCT
, WADEDITOR
;
9 MAINMENU_HEADER_COLOR
: TRGB
= (R
:255; G
:255; B
:255);
10 MAINMENU_ITEMS_COLOR
: TRGB
= (R
:255; G
:255; B
:255);
11 MAINMENU_UNACTIVEITEMS_COLOR
: TRGB
= (R
:192; G
:192; B
:192);
12 MAINMENU_CLICKSOUND
= 'MENU_SELECT';
13 MAINMENU_CHANGESOUND
= 'MENU_CHANGE';
15 MAINMENU_MARKER1
= 'MAINMENU_MARKER1';
16 MAINMENU_MARKER2
= 'MAINMENU_MARKER2';
17 MAINMENU_MARKERDELAY
= 24;
18 WINDOW_CLOSESOUND
= 'MENU_CLOSE';
19 MENU_HEADERCOLOR
: TRGB
= (R
:255; G
:255; B
:255);
20 MENU_ITEMSTEXT_COLOR
: TRGB
= (R
:255; G
:255; B
:255);
21 MENU_UNACTIVEITEMS_COLOR
: TRGB
= (R
:128; G
:128; B
:128);
22 MENU_ITEMSCTRL_COLOR
: TRGB
= (R
:255; G
:0; B
:0);
25 MENU_CLICKSOUND
= 'MENU_SELECT';
26 MENU_CHANGESOUND
= 'MENU_CHANGE';
27 MENU_MARKERDELAY
= 24;
28 SCROLL_LEFT
= 'SCROLL_LEFT';
29 SCROLL_RIGHT
= 'SCROLL_RIGHT';
30 SCROLL_MIDDLE
= 'SCROLL_MIDDLE';
31 SCROLL_MARKER
= 'SCROLL_MARKER';
32 SCROLL_ADDSOUND
= 'SCROLL_ADD';
33 SCROLL_SUBSOUND
= 'SCROLL_SUB';
34 EDIT_LEFT
= 'EDIT_LEFT';
35 EDIT_RIGHT
= 'EDIT_RIGHT';
36 EDIT_MIDDLE
= 'EDIT_MIDDLE';
37 EDIT_CURSORCOLOR
: TRGB
= (R
:200; G
:0; B
:0);
39 KEYREAD_QUERY
= '<...>';
40 KEYREAD_CLEAR
= '???';
43 MAPPREVIEW_HEIGHT
= 8;
53 BSCROLL_UPA
= 'BSCROLL_UP_A';
54 BSCROLL_UPU
= 'BSCROLL_UP_U';
55 BSCROLL_DOWNA
= 'BSCROLL_DOWN_A';
56 BSCROLL_DOWNU
= 'BSCROLL_DOWN_U';
57 BSCROLL_MIDDLE
= 'BSCROLL_MIDDLE';
69 TFontType
= (FONT_TEXTURE
, FONT_CHAR
);
71 TFont
= class(TObject
)
77 constructor Create(FontID
: DWORD
; FontType
: TFontType
);
78 destructor Destroy
; override;
79 procedure Draw(X
, Y
: Integer; Text: string; R
, G
, B
: Byte);
80 procedure GetTextSize(Text: string; var w
, h
: Word);
81 property Scale
: Single read FScale write FScale
;
87 TOnKeyDownEvent
= procedure(Key
: Byte);
88 TOnKeyDownEventEx
= procedure(win
: TGUIWindow
; Key
: Byte);
89 TOnCloseEvent
= procedure;
90 TOnShowEvent
= procedure;
91 TOnClickEvent
= procedure;
92 TOnChangeEvent
= procedure(Sender
: TGUIControl
);
93 TOnEnterEvent
= procedure(Sender
: TGUIControl
);
103 procedure OnMessage(var Msg
: TMessage
); virtual;
104 procedure Update
; virtual;
105 procedure Draw
; virtual;
106 property X
: Integer read FX write FX
;
107 property Y
: Integer read FY write FY
;
108 property Enabled
: Boolean read FEnabled write FEnabled
;
109 property Name
: string read FName write FName
;
114 FActiveControl
: TGUIControl
;
116 FPrevWindow
: TGUIWindow
;
118 FBackTexture
: string;
119 FMainWindow
: Boolean;
120 FOnKeyDown
: TOnKeyDownEvent
;
121 FOnKeyDownEx
: TOnKeyDownEventEx
;
122 FOnCloseEvent
: TOnCloseEvent
;
123 FOnShowEvent
: TOnShowEvent
;
126 Childs
: array of TGUIControl
;
127 constructor Create(Name
: string);
128 destructor Destroy
; override;
129 function AddChild(Child
: TGUIControl
): TGUIControl
;
130 procedure OnMessage(var Msg
: TMessage
);
133 procedure SetActive(Control
: TGUIControl
);
134 function GetControl(Name
: string): TGUIControl
;
135 property OnKeyDown
: TOnKeyDownEvent read FOnKeyDown write FOnKeyDown
;
136 property OnKeyDownEx
: TOnKeyDownEventEx read FOnKeyDownEx write FOnKeyDownEx
;
137 property OnClose
: TOnCloseEvent read FOnCloseEvent write FOnCloseEvent
;
138 property OnShow
: TOnShowEvent read FOnShowEvent write FOnShowEvent
;
139 property Name
: string read FName
;
140 property DefControl
: string read FDefControl write FDefControl
;
141 property BackTexture
: string read FBackTexture write FBackTexture
;
142 property MainWindow
: Boolean read FMainWindow write FMainWindow
;
143 property UserData
: Pointer read FUserData write FUserData
;
146 TGUITextButton
= class(TGUIControl
)
155 constructor Create(Proc
: Pointer; FontID
: DWORD
; Text: string);
156 destructor Destroy(); override;
157 procedure OnMessage(var Msg
: TMessage
); override;
158 procedure Update(); override;
159 procedure Draw(); override;
160 function GetWidth(): Integer;
161 function GetHeight(): Integer;
162 procedure Click(Silent
: Boolean = False);
163 property Caption
: string read FText write FText
;
164 property Color
: TRGB read FColor write FColor
;
165 property Font
: TFont read FFont write FFont
;
166 property ShowWindow
: string read FShowWindow write FShowWindow
;
169 TGUILabel
= class(TGUIControl
)
175 FOnClickEvent
: TOnClickEvent
;
177 constructor Create(Text: string; FontID
: DWORD
);
178 procedure OnMessage(var Msg
: TMessage
); override;
179 procedure Draw
; override;
180 function GetWidth
: Integer;
181 function GetHeight
: Integer;
182 property OnClick
: TOnClickEvent read FOnClickEvent write FOnClickEvent
;
183 property FixedLength
: Word read FFixedLen write FFixedLen
;
184 property Text: string read FText write FText
;
185 property Color
: TRGB read FColor write FColor
;
186 property Font
: TFont read FFont write FFont
;
189 TGUIScroll
= class(TGUIControl
)
197 FOnChangeEvent
: TOnChangeEvent
;
198 procedure FSetValue(a
: Integer);
200 constructor Create();
201 procedure OnMessage(var Msg
: TMessage
); override;
202 procedure Update
; override;
203 procedure Draw
; override;
204 function GetWidth(): Word;
205 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
206 property Max
: Word read FMax write FMax
;
207 property Value
: Integer read FValue write FSetValue
;
210 TGUISwitch
= class(TGUIControl
)
213 FItems
: array of string;
216 FOnChangeEvent
: TOnChangeEvent
;
218 constructor Create(FontID
: DWORD
);
219 procedure OnMessage(var Msg
: TMessage
); override;
220 procedure AddItem(Item
: string);
221 procedure Update
; override;
222 procedure Draw
; override;
223 function GetWidth(): Word;
224 function GetText
: string;
225 property ItemIndex
: Integer read FIndex write FIndex
;
226 property Color
: TRGB read FColor write FColor
;
227 property Font
: TFont read FFont write FFont
;
228 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
231 TGUIEdit
= class(TGUIControl
)
239 FOnlyDigits
: Boolean;
243 FOnChangeEvent
: TOnChangeEvent
;
244 FOnEnterEvent
: TOnEnterEvent
;
245 procedure SetText(Text: string);
247 constructor Create(FontID
: DWORD
);
248 procedure OnMessage(var Msg
: TMessage
); override;
249 procedure Update
; override;
250 procedure Draw
; override;
251 function GetWidth(): Word;
252 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
253 property OnEnter
: TOnEnterEvent read FOnEnterEvent write FOnEnterEvent
;
254 property Width
: Word read FWidth write FWidth
;
255 property MaxLength
: Word read FMaxLength write FMaxLength
;
256 property OnlyDigits
: Boolean read FOnlyDigits write FOnlyDigits
;
257 property Text: string read FText write SetText
;
258 property Color
: TRGB read FColor write FColor
;
259 property Font
: TFont read FFont write FFont
;
262 TGUIKeyRead
= class(TGUIControl
)
269 constructor Create(FontID
: DWORD
);
270 procedure OnMessage(var Msg
: TMessage
); override;
271 procedure Draw
; override;
272 function GetWidth(): Word;
273 property Key
: Word read FKey write FKey
;
274 property Color
: TRGB read FColor write FColor
;
275 property Font
: TFont read FFont write FFont
;
278 TGUIModelView
= class(TGUIControl
)
280 FModel
: TPlayerModel
;
284 destructor Destroy
; override;
285 procedure OnMessage(var Msg
: TMessage
); override;
286 procedure SetModel(ModelName
: string);
287 procedure SetColor(Red
, Green
, Blue
: Byte);
288 procedure NextAnim();
289 procedure NextWeapon();
290 procedure Update
; override;
291 procedure Draw
; override;
292 property Model
: TPlayerModel read FModel
;
295 TPreviewPanel
= record
296 X1
, Y1
, X2
, Y2
: Integer;
300 TGUIMapPreview
= class(TGUIControl
)
302 FMapData
: array of TPreviewPanel
;
306 constructor Create();
307 destructor Destroy(); override;
308 procedure OnMessage(var Msg
: TMessage
); override;
309 procedure SetMap(Res
: string);
310 procedure ClearMap();
311 procedure Update(); override;
312 procedure Draw(); override;
313 function GetScaleStr
: String;
316 TGUIImage
= class(TGUIControl
)
321 constructor Create();
322 destructor Destroy(); override;
323 procedure OnMessage(var Msg
: TMessage
); override;
324 procedure SetImage(Res
: string);
325 procedure ClearImage();
326 procedure Update(); override;
327 procedure Draw(); override;
328 property DefaultRes
: string read FDefaultRes write FDefaultRes
;
331 TGUIListBox
= class(TGUIControl
)
335 FUnActiveColor
: TRGB
;
343 FDrawScroll
: Boolean;
344 FOnChangeEvent
: TOnChangeEvent
;
346 procedure FSetItems(Items
: SArray
);
347 procedure FSetIndex(aIndex
: Integer);
350 constructor Create(FontID
: DWORD
; Width
, Height
: Word);
351 procedure OnMessage(var Msg
: TMessage
); override;
352 procedure Draw(); override;
353 procedure AddItem(Item
: String);
354 procedure SelectItem(Item
: String);
356 function GetWidth(): Word;
357 function GetHeight(): Word;
358 function SelectedItem(): String;
360 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
361 property Sort
: Boolean read FSort write FSort
;
362 property ItemIndex
: Integer read FIndex write FSetIndex
;
363 property Items
: SArray read FItems write FSetItems
;
364 property DrawBack
: Boolean read FDrawBack write FDrawBack
;
365 property DrawScrollBar
: Boolean read FDrawScroll write FDrawScroll
;
366 property ActiveColor
: TRGB read FActiveColor write FActiveColor
;
367 property UnActiveColor
: TRGB read FUnActiveColor write FUnActiveColor
;
368 property Font
: TFont read FFont write FFont
;
371 TGUIFileListBox
= class (TGUIListBox
)
378 procedure OpenDir(path
: String);
381 procedure OnMessage(var Msg
: TMessage
); override;
382 procedure SetBase(path
: String);
383 function SelectedItem(): String;
384 procedure UpdateFileList();
386 property Dirs
: Boolean read FDirs write FDirs
;
387 property FileMask
: String read FFileMask write FFileMask
;
388 property Path
: String read FPath
;
391 TGUIMemo
= class(TGUIControl
)
400 FDrawScroll
: Boolean;
402 constructor Create(FontID
: DWORD
; Width
, Height
: Word);
403 procedure OnMessage(var Msg
: TMessage
); override;
404 procedure Draw
; override;
406 function GetWidth(): Word;
407 function GetHeight(): Word;
408 procedure SetText(Text: string);
409 property DrawBack
: Boolean read FDrawBack write FDrawBack
;
410 property DrawScrollBar
: Boolean read FDrawScroll write FDrawScroll
;
411 property Color
: TRGB read FColor write FColor
;
412 property Font
: TFont read FFont write FFont
;
415 TGUIMainMenu
= class(TGUIControl
)
417 FButtons
: array of TGUITextButton
;
425 constructor Create(FontID
: DWORD
; Header
: string);
426 destructor Destroy
; override;
427 procedure OnMessage(var Msg
: TMessage
); override;
428 function AddButton(fProc
: Pointer; Caption
: string; ShowWindow
: string = ''): TGUITextButton
;
429 function GetButton(Name
: string): TGUITextButton
;
430 procedure EnableButton(Name
: string; e
: Boolean);
431 procedure AddSpace();
432 procedure Update
; override;
433 procedure Draw
; override;
436 TControlType
= class of TGUIControl
;
438 PMenuItem
= ^TMenuItem
;
441 ControlType
: TControlType
;
442 Control
: TGUIControl
;
445 TGUIMenu
= class(TGUIControl
)
447 FItems
: array of TMenuItem
;
454 function NewItem(): Integer;
456 constructor Create(HeaderFont
, ItemsFont
: DWORD
; Header
: string);
457 destructor Destroy
; override;
458 procedure OnMessage(var Msg
: TMessage
); override;
459 procedure AddSpace();
460 procedure AddLine(fText
: string);
461 procedure AddText(fText
: string; MaxWidth
: Word);
462 function AddLabel(fText
: string): TGUILabel
;
463 function AddButton(Proc
: Pointer; fText
: string; _ShowWindow
: string = ''): TGUITextButton
;
464 function AddScroll(fText
: string): TGUIScroll
;
465 function AddSwitch(fText
: string): TGUISwitch
;
466 function AddEdit(fText
: string): TGUIEdit
;
467 function AddKeyRead(fText
: string): TGUIKeyRead
;
468 function AddList(fText
: string; Width
, Height
: Word): TGUIListBox
;
469 function AddFileList(fText
: string; Width
, Height
: Word): TGUIFileListBox
;
470 function AddMemo(fText
: string; Width
, Height
: Word): TGUIMemo
;
472 function GetControl(Name
: string): TGUIControl
;
473 function GetControlsText(Name
: string): TGUILabel
;
474 procedure Draw
; override;
475 procedure Update
; override;
476 procedure UpdateIndex();
477 property Align
: Boolean read FAlign write FAlign
;
478 property Left
: Integer read FLeft write FLeft
;
482 g_GUIWindows
: array of TGUIWindow
;
483 g_ActiveWindow
: TGUIWindow
= nil;
485 procedure g_GUI_Init();
486 function g_GUI_AddWindow(Window
: TGUIWindow
): TGUIWindow
;
487 function g_GUI_GetWindow(Name
: string): TGUIWindow
;
488 procedure g_GUI_ShowWindow(Name
: string);
489 procedure g_GUI_HideWindow(PlaySound
: Boolean = True);
490 function g_GUI_Destroy(): Boolean;
491 procedure g_GUI_SaveMenuPos();
492 procedure g_GUI_LoadMenuPos();
497 GL
, GLExt
, g_textures
, g_sound
, SysUtils
,
498 g_game
, Math
, StrUtils
, g_player
, g_options
, MAPREADER
,
499 g_map
, MAPDEF
, g_weapons
;
502 Box
: Array [0..8] of DWORD
;
503 Saved_Windows
: SArray
;
505 procedure g_GUI_Init();
507 g_Texture_Get(BOX1
, Box
[0]);
508 g_Texture_Get(BOX2
, Box
[1]);
509 g_Texture_Get(BOX3
, Box
[2]);
510 g_Texture_Get(BOX4
, Box
[3]);
511 g_Texture_Get(BOX5
, Box
[4]);
512 g_Texture_Get(BOX6
, Box
[5]);
513 g_Texture_Get(BOX7
, Box
[6]);
514 g_Texture_Get(BOX8
, Box
[7]);
515 g_Texture_Get(BOX9
, Box
[8]);
518 function g_GUI_Destroy(): Boolean;
522 Result
:= (Length(g_GUIWindows
) > 0);
524 for i
:= 0 to High(g_GUIWindows
) do
525 g_GUIWindows
[i
].Free();
528 g_ActiveWindow
:= nil;
531 function g_GUI_AddWindow(Window
: TGUIWindow
): TGUIWindow
;
533 SetLength(g_GUIWindows
, Length(g_GUIWindows
)+1);
534 g_GUIWindows
[High(g_GUIWindows
)] := Window
;
539 function g_GUI_GetWindow(Name
: string): TGUIWindow
;
545 if g_GUIWindows
<> nil then
546 for i
:= 0 to High(g_GUIWindows
) do
547 if g_GUIWindows
[i
].FName
= Name
then
549 Result
:= g_GUIWindows
[i
];
553 Assert(Result
<> nil, 'GUI_Window "'+Name
+'" not found');
556 procedure g_GUI_ShowWindow(Name
: string);
560 if g_GUIWindows
= nil then
563 for i
:= 0 to High(g_GUIWindows
) do
564 if g_GUIWindows
[i
].FName
= Name
then
566 g_GUIWindows
[i
].FPrevWindow
:= g_ActiveWindow
;
567 g_ActiveWindow
:= g_GUIWindows
[i
];
569 if g_ActiveWindow
.MainWindow
then
570 g_ActiveWindow
.FPrevWindow
:= nil;
572 if g_ActiveWindow
.FDefControl
<> '' then
573 g_ActiveWindow
.SetActive(g_ActiveWindow
.GetControl(g_ActiveWindow
.FDefControl
))
575 g_ActiveWindow
.SetActive(nil);
577 if @g_ActiveWindow
.FOnShowEvent
<> nil then
578 g_ActiveWindow
.FOnShowEvent();
584 procedure g_GUI_HideWindow(PlaySound
: Boolean = True);
586 if g_ActiveWindow
<> nil then
588 if @g_ActiveWindow
.OnClose
<> nil then
589 g_ActiveWindow
.OnClose();
590 g_ActiveWindow
:= g_ActiveWindow
.FPrevWindow
;
592 g_Sound_PlayEx(WINDOW_CLOSESOUND
);
596 procedure g_GUI_SaveMenuPos();
601 SetLength(Saved_Windows
, 0);
602 win
:= g_ActiveWindow
;
606 len
:= Length(Saved_Windows
);
607 SetLength(Saved_Windows
, len
+ 1);
609 Saved_Windows
[len
] := win
.Name
;
611 if win
.MainWindow
then
614 win
:= win
.FPrevWindow
;
618 procedure g_GUI_LoadMenuPos();
620 i
, j
, k
, len
: Integer;
623 g_ActiveWindow
:= nil;
624 len
:= Length(Saved_Windows
);
629 // Îêíî ñ ãëàâíûì ìåíþ:
630 g_GUI_ShowWindow(Saved_Windows
[len
-1]);
632 // Íå ïåðåêëþ÷èëîñü (èëè íåêóäà äàëüøå):
633 if (len
= 1) or (g_ActiveWindow
= nil) then
636 // Èùåì êíîïêè â îñòàëüíûõ îêíàõ:
637 for k
:= len
-1 downto 1 do
641 for i
:= 0 to Length(g_ActiveWindow
.Childs
)-1 do
643 if g_ActiveWindow
.Childs
[i
] is TGUIMainMenu
then
644 begin // GUI_MainMenu
645 with TGUIMainMenu(g_ActiveWindow
.Childs
[i
]) do
646 for j
:= 0 to Length(FButtons
)-1 do
647 if FButtons
[j
].ShowWindow
= Saved_Windows
[k
-1] then
649 FButtons
[j
].Click(True);
655 if g_ActiveWindow
.Childs
[i
] is TGUIMenu
then
656 with TGUIMenu(g_ActiveWindow
.Childs
[i
]) do
657 for j
:= 0 to Length(FItems
)-1 do
658 if FItems
[j
].ControlType
= TGUITextButton
then
659 if TGUITextButton(FItems
[j
].Control
).ShowWindow
= Saved_Windows
[k
-1] then
661 TGUITextButton(FItems
[j
].Control
).Click(True);
672 (g_ActiveWindow
.Name
= Saved_Windows
[k
]) then
677 procedure DrawBox(X
, Y
: Integer; Width
, Height
: Word);
679 e_Draw(Box
[0], X
, Y
, 0, False, False);
680 e_DrawFill(Box
[1], X
+4, Y
, Width
*4, 1, 0, False, False);
681 e_Draw(Box
[2], X
+4+Width
*16, Y
, 0, False, False);
682 e_DrawFill(Box
[3], X
, Y
+4, 1, Height
*4, 0, False, False);
683 e_DrawFill(Box
[4], X
+4, Y
+4, Width
, Height
, 0, False, False);
684 e_DrawFill(Box
[5], X
+4+Width
*16, Y
+4, 1, Height
*4, 0, False, False);
685 e_Draw(Box
[6], X
, Y
+4+Height
*16, 0, False, False);
686 e_DrawFill(Box
[7], X
+4, Y
+4+Height
*16, Width
*4, 1, 0, False, False);
687 e_Draw(Box
[8], X
+4+Width
*16, Y
+4+Height
*16, 0, False, False);
690 procedure DrawScroll(X
, Y
: Integer; Height
: Word; Up
, Down
: Boolean);
694 if Height
< 3 then Exit
;
697 g_Texture_Get(BSCROLL_UPA
, ID
)
699 g_Texture_Get(BSCROLL_UPU
, ID
);
700 e_Draw(ID
, X
, Y
, 0, False, False);
703 g_Texture_Get(BSCROLL_DOWNA
, ID
)
705 g_Texture_Get(BSCROLL_DOWNU
, ID
);
706 e_Draw(ID
, X
, Y
+(Height
-1)*16, 0, False, False);
708 g_Texture_Get(BSCROLL_MIDDLE
, ID
);
709 e_DrawFill(ID
, X
, Y
+16, 1, Height
-2, 0, False, False);
714 constructor TGUIWindow
.Create(Name
: string);
717 FActiveControl
:= nil;
721 FOnCloseEvent
:= nil;
725 destructor TGUIWindow
.Destroy
;
732 for i
:= 0 to High(Childs
) do
736 function TGUIWindow
.AddChild(Child
: TGUIControl
): TGUIControl
;
738 Child
.FWindow
:= Self
;
740 SetLength(Childs
, Length(Childs
) + 1);
741 Childs
[High(Childs
)] := Child
;
746 procedure TGUIWindow
.Update
;
750 for i
:= 0 to High(Childs
) do
751 if Childs
[i
] <> nil then Childs
[i
].Update
;
754 procedure TGUIWindow
.Draw
;
759 if FBackTexture
<> '' then
760 if g_Texture_Get(FBackTexture
, ID
) then
761 e_DrawSize(ID
, 0, 0, 0, False, False, gScreenWidth
, gScreenHeight
)
763 e_Clear(GL_COLOR_BUFFER_BIT
, 0.5, 0.5, 0.5);
765 for i
:= 0 to High(Childs
) do
766 if Childs
[i
] <> nil then Childs
[i
].Draw
;
769 procedure TGUIWindow
.OnMessage(var Msg
: TMessage
);
771 if FActiveControl
<> nil then FActiveControl
.OnMessage(Msg
);
772 if @FOnKeyDown
<> nil then FOnKeyDown(Msg
.wParam
);
773 if @FOnKeyDownEx
<> nil then FOnKeyDownEx(self
, Msg
.wParam
);
775 if Msg
.Msg
= WM_KEYDOWN
then
776 if Msg
.wParam
= IK_ESCAPE
then
783 procedure TGUIWindow
.SetActive(Control
: TGUIControl
);
785 FActiveControl
:= Control
;
788 function TGUIWindow
.GetControl(Name
: String): TGUIControl
;
794 if Childs
<> nil then
795 for i
:= 0 to High(Childs
) do
796 if Childs
[i
] <> nil then
797 if LowerCase(Childs
[i
].FName
) = LowerCase(Name
) then
803 Assert(Result
<> nil, 'Window Control "'+Name
+'" not Found!');
808 constructor TGUIControl
.Create();
816 procedure TGUIControl
.OnMessage(var Msg
: TMessage
);
822 procedure TGUIControl
.Update();
827 procedure TGUIControl
.Draw();
834 procedure TGUITextButton
.Click(Silent
: Boolean = False);
836 if (FSound
<> '') and (not Silent
) then
837 g_Sound_PlayEx(FSound
);
841 if FShowWindow
<> '' then
842 g_GUI_ShowWindow(FShowWindow
);
845 constructor TGUITextButton
.Create(Proc
: Pointer; FontID
: DWORD
; Text: string);
851 FFont
:= TFont
.Create(FontID
, FONT_CHAR
);
856 destructor TGUITextButton
.Destroy
;
862 procedure TGUITextButton
.Draw
;
864 FFont
.Draw(FX
, FY
, FText
, FColor
.R
, FColor
.G
, FColor
.B
)
867 function TGUITextButton
.GetHeight
: Integer;
871 FFont
.GetTextSize(FText
, w
, h
);
875 function TGUITextButton
.GetWidth
: Integer;
879 FFont
.GetTextSize(FText
, w
, h
);
883 procedure TGUITextButton
.OnMessage(var Msg
: TMessage
);
885 if not FEnabled
then Exit
;
892 IK_RETURN
, IK_KPRETURN
: Click();
897 procedure TGUITextButton
.Update
;
904 constructor TFont
.Create(FontID
: DWORD
; FontType
: TFontType
);
909 FFontType
:= FontType
;
912 destructor TFont
.Destroy
;
918 procedure TFont
.Draw(X
, Y
: Integer; Text: string; R
, G
, B
: Byte);
920 if FFontType
= FONT_CHAR
then e_CharFont_PrintEx(ID
, X
, Y
, Text, _RGB(R
, G
, B
), FScale
)
921 else e_TextureFontPrintEx(X
, Y
, Text, ID
, R
, G
, B
, FScale
);
924 procedure TFont
.GetTextSize(Text: string; var w
, h
: Word);
928 if FFontType
= FONT_CHAR
then e_CharFont_GetSize(ID
, Text, w
, h
)
931 e_TextureFontGetSize(ID
, cw
, ch
);
932 w
:= cw
*Length(Text);
936 w
:= Round(w
*FScale
);
937 h
:= Round(h
*FScale
);
942 function TGUIMainMenu
.AddButton(fProc
: Pointer; Caption
: string; ShowWindow
: string = ''): TGUITextButton
;
949 SetLength(FButtons
, Length(FButtons
)+1);
950 FButtons
[High(FButtons
)] := TGUITextButton
.Create(fProc
, FFontID
, Caption
);
951 FButtons
[High(FButtons
)].ShowWindow
:= ShowWindow
;
952 with FButtons
[High(FButtons
)] do
954 if (fProc
<> nil) or (ShowWindow
<> '') then FColor
:= MAINMENU_ITEMS_COLOR
955 else FColor
:= MAINMENU_UNACTIVEITEMS_COLOR
;
956 FSound
:= MAINMENU_CLICKSOUND
;
959 _x
:= gScreenWidth
div 2;
961 for a
:= 0 to High(FButtons
) do
962 if FButtons
[a
] <> nil then
963 _x
:= Min(_x
, (gScreenWidth
div 2)-(FButtons
[a
].GetWidth
div 2));
965 hh
:= FHeader
.GetHeight
;
967 h
:= hh
*(2+Length(FButtons
))+MAINMENU_SPACE
*(Length(FButtons
)-1);
968 h
:= (gScreenHeight
div 2)-(h
div 2);
978 for a
:= 0 to High(FButtons
) do
980 if FButtons
[a
] <> nil then
987 Inc(h
, hh
+MAINMENU_SPACE
);
990 Result
:= FButtons
[High(FButtons
)];
993 procedure TGUIMainMenu
.AddSpace
;
995 SetLength(FButtons
, Length(FButtons
)+1);
996 FButtons
[High(FButtons
)] := nil;
999 constructor TGUIMainMenu
.Create(FontID
: DWORD
; Header
: string);
1005 FCounter
:= MAINMENU_MARKERDELAY
;
1007 g_Texture_Get(MAINMENU_MARKER1
, FMarkerID1
);
1008 g_Texture_Get(MAINMENU_MARKER2
, FMarkerID2
);
1010 FHeader
:= TGUILabel
.Create(Header
, FFontID
);
1013 FColor
:= MAINMENU_HEADER_COLOR
;
1014 FX
:= (gScreenWidth
div 2)-(GetWidth
div 2);
1015 FY
:= (gScreenHeight
div 2)-(GetHeight
div 2);
1019 destructor TGUIMainMenu
.Destroy
;
1023 if FButtons
<> nil then
1024 for a
:= 0 to High(FButtons
) do
1032 procedure TGUIMainMenu
.Draw
;
1040 if FButtons
<> nil then
1042 for a
:= 0 to High(FButtons
) do
1043 if FButtons
[a
] <> nil then FButtons
[a
].Draw
;
1045 if FIndex
<> -1 then
1046 e_Draw(FMarkerID1
, FButtons
[FIndex
].FX
-48, FButtons
[FIndex
].FY
, 0, True, False);
1050 procedure TGUIMainMenu
.EnableButton(Name
: string; e
: Boolean);
1054 if FButtons
= nil then Exit
;
1056 for a
:= 0 to High(FButtons
) do
1057 if (FButtons
[a
] <> nil) and (FButtons
[a
].Name
= Name
) then
1059 if e
then FButtons
[a
].FColor
:= MAINMENU_ITEMS_COLOR
1060 else FButtons
[a
].FColor
:= MAINMENU_UNACTIVEITEMS_COLOR
;
1061 FButtons
[a
].Enabled
:= e
;
1066 function TGUIMainMenu
.GetButton(Name
: string): TGUITextButton
;
1072 if FButtons
= nil then Exit
;
1074 for a
:= 0 to High(FButtons
) do
1075 if (FButtons
[a
] <> nil) and (FButtons
[a
].Name
= Name
) then
1077 Result
:= FButtons
[a
];
1082 procedure TGUIMainMenu
.OnMessage(var Msg
: TMessage
);
1087 if not FEnabled
then Exit
;
1091 if FButtons
= nil then Exit
;
1094 for a
:= 0 to High(FButtons
) do
1095 if FButtons
[a
] <> nil then
1101 if not ok
then Exit
;
1110 if FIndex
< 0 then FIndex
:= High(FButtons
);
1111 until FButtons
[FIndex
] <> nil;
1113 g_Sound_PlayEx(MENU_CHANGESOUND
);
1119 if FIndex
> High(FButtons
) then FIndex
:= 0;
1120 until FButtons
[FIndex
] <> nil;
1122 g_Sound_PlayEx(MENU_CHANGESOUND
);
1124 IK_RETURN
, IK_KPRETURN
: if (FIndex
<> -1) and FButtons
[FIndex
].FEnabled
then FButtons
[FIndex
].Click
;
1129 procedure TGUIMainMenu
.Update
;
1135 if FCounter
= 0 then
1138 FMarkerID1
:= FMarkerID2
;
1141 FCounter
:= MAINMENU_MARKERDELAY
;
1142 end else Dec(FCounter
);
1147 constructor TGUILabel
.Create(Text: string; FontID
: DWORD
);
1151 FFont
:= TFont
.Create(FontID
, FONT_CHAR
);
1155 FOnClickEvent
:= nil;
1158 procedure TGUILabel
.Draw
;
1160 FFont
.Draw(FX
, FY
, FText
, FColor
.R
, FColor
.G
, FColor
.B
);
1163 function TGUILabel
.GetHeight
: Integer;
1167 FFont
.GetTextSize(FText
, w
, h
);
1171 function TGUILabel
.GetWidth
: Integer;
1175 if FFixedLen
= 0 then
1176 FFont
.GetTextSize(FText
, w
, h
)
1178 w
:= e_CharFont_GetMaxWidth(FFont
.ID
)*FFixedLen
;
1182 procedure TGUILabel
.OnMessage(var Msg
: TMessage
);
1184 if not FEnabled
then Exit
;
1191 IK_RETURN
, IK_KPRETURN
: if @FOnClickEvent
<> nil then FOnClickEvent();
1198 function TGUIMenu
.AddButton(Proc
: Pointer; fText
: string; _ShowWindow
: string = ''): TGUITextButton
;
1205 Control
:= TGUITextButton
.Create(Proc
, FFontID
, fText
);
1206 with Control
as TGUITextButton
do
1208 ShowWindow
:= _ShowWindow
;
1209 FColor
:= MENU_ITEMSCTRL_COLOR
;
1213 ControlType
:= TGUITextButton
;
1215 Result
:= (Control
as TGUITextButton
);
1218 if FIndex
= -1 then FIndex
:= i
;
1223 procedure TGUIMenu
.AddLine(fText
: string);
1230 Text := TGUILabel
.Create(fText
, FFontID
);
1233 FColor
:= MENU_ITEMSTEXT_COLOR
;
1242 procedure TGUIMenu
.AddText(fText
: string; MaxWidth
: Word);
1247 l
:= GetLines(fText
, FFontID
, MaxWidth
);
1249 if l
= nil then Exit
;
1251 for a
:= 0 to High(l
) do
1256 Text := TGUILabel
.Create(l
[a
], FFontID
);
1259 FColor
:= MENU_ITEMSTEXT_COLOR
;
1269 procedure TGUIMenu
.AddSpace
;
1283 constructor TGUIMenu
.Create(HeaderFont
, ItemsFont
: DWORD
; Header
: string);
1289 FFontID
:= ItemsFont
;
1290 FCounter
:= MENU_MARKERDELAY
;
1293 FHeader
:= TGUILabel
.Create(Header
, HeaderFont
);
1296 FX
:= (gScreenWidth
div 2)-(GetWidth
div 2);
1298 FColor
:= MAINMENU_HEADER_COLOR
;
1302 destructor TGUIMenu
.Destroy
;
1306 if FItems
<> nil then
1307 for a
:= 0 to High(FItems
) do
1321 procedure TGUIMenu
.Draw
;
1327 if FHeader
<> nil then FHeader
.Draw
;
1329 if FItems
<> nil then
1330 for a
:= 0 to High(FItems
) do
1332 if FItems
[a
].Text <> nil then FItems
[a
].Text.Draw
;
1333 if FItems
[a
].Control
<> nil then FItems
[a
].Control
.Draw
;
1336 if (FIndex
<> -1) and (FCounter
> MENU_MARKERDELAY
div 2) then
1341 if FItems
[FIndex
].Text <> nil then
1343 x
:= FItems
[FIndex
].Text.FX
;
1344 y
:= FItems
[FIndex
].Text.FY
;
1346 else if FItems
[FIndex
].Control
<> nil then
1348 x
:= FItems
[FIndex
].Control
.FX
;
1349 y
:= FItems
[FIndex
].Control
.FY
;
1352 x
:= x
-e_CharFont_GetMaxWidth(FFontID
);
1354 e_CharFont_PrintEx(FFontID
, x
, y
, #16, _RGB(255, 0, 0));
1358 function TGUIMenu
.GetControl(Name
: String): TGUIControl
;
1364 if FItems
<> nil then
1365 for a
:= 0 to High(FItems
) do
1366 if FItems
[a
].Control
<> nil then
1367 if LowerCase(FItems
[a
].Control
.Name
) = LowerCase(Name
) then
1369 Result
:= FItems
[a
].Control
;
1373 Assert(Result
<> nil, 'GUI control "'+Name
+'" not found!');
1376 function TGUIMenu
.GetControlsText(Name
: String): TGUILabel
;
1382 if FItems
<> nil then
1383 for a
:= 0 to High(FItems
) do
1384 if FItems
[a
].Control
<> nil then
1385 if LowerCase(FItems
[a
].Control
.Name
) = LowerCase(Name
) then
1387 Result
:= FItems
[a
].Text;
1391 Assert(Result
<> nil, 'GUI control''s text "'+Name
+'" not found!');
1394 function TGUIMenu
.NewItem
: Integer;
1396 SetLength(FItems
, Length(FItems
)+1);
1397 Result
:= High(FItems
);
1400 procedure TGUIMenu
.OnMessage(var Msg
: TMessage
);
1405 if not FEnabled
then Exit
;
1409 if FItems
= nil then Exit
;
1412 for a
:= 0 to High(FItems
) do
1413 if FItems
[a
].Control
<> nil then
1419 if not ok
then Exit
;
1430 if c
> Length(FItems
) then
1437 if FIndex
< 0 then FIndex
:= High(FItems
);
1438 until (FItems
[FIndex
].Control
<> nil) and
1439 (FItems
[FIndex
].Control
.Enabled
);
1443 g_Sound_PlayEx(MENU_CHANGESOUND
);
1451 if c
> Length(FItems
) then
1458 if FIndex
> High(FItems
) then FIndex
:= 0;
1459 until (FItems
[FIndex
].Control
<> nil) and
1460 (FItems
[FIndex
].Control
.Enabled
);
1464 g_Sound_PlayEx(MENU_CHANGESOUND
);
1467 IK_LEFT
, IK_RIGHT
, IK_KPLEFT
, IK_KPRIGHT
:
1469 if FIndex
<> -1 then
1470 if FItems
[FIndex
].Control
<> nil then
1471 FItems
[FIndex
].Control
.OnMessage(Msg
);
1473 IK_RETURN
, IK_KPRETURN
:
1475 if FIndex
<> -1 then
1476 if FItems
[FIndex
].Control
<> nil then
1477 FItems
[FIndex
].Control
.OnMessage(Msg
);
1479 g_Sound_PlayEx(MENU_CLICKSOUND
);
1486 procedure TGUIMenu
.ReAlign();
1488 a
, tx
, cx
, w
, h
: Integer;
1490 if FItems
= nil then Exit
;
1492 if not FAlign
then tx
:= FLeft
else
1495 for a
:= 0 to High(FItems
) do
1498 if FItems
[a
].Text <> nil then w
:= FItems
[a
].Text.GetWidth
;
1499 if FItems
[a
].Control
<> nil then
1503 if FItems
[a
].ControlType
= TGUILabel
then
1504 w
:= w
+(FItems
[a
].Control
as TGUILabel
).GetWidth
1505 else if FItems
[a
].ControlType
= TGUITextButton
then
1506 w
:= w
+(FItems
[a
].Control
as TGUITextButton
).GetWidth
1507 else if FItems
[a
].ControlType
= TGUIScroll
then
1508 w
:= w
+(FItems
[a
].Control
as TGUIScroll
).GetWidth
1509 else if FItems
[a
].ControlType
= TGUISwitch
then
1510 w
:= w
+(FItems
[a
].Control
as TGUISwitch
).GetWidth
1511 else if FItems
[a
].ControlType
= TGUIEdit
then
1512 w
:= w
+(FItems
[a
].Control
as TGUIEdit
).GetWidth
1513 else if FItems
[a
].ControlType
= TGUIKeyRead
then
1514 w
:= w
+(FItems
[a
].Control
as TGUIKeyRead
).GetWidth
1515 else if (FItems
[a
].ControlType
= TGUIListBox
) then
1516 w
:= w
+(FItems
[a
].Control
as TGUIListBox
).GetWidth
1517 else if (FItems
[a
].ControlType
= TGUIFileListBox
) then
1518 w
:= w
+(FItems
[a
].Control
as TGUIFileListBox
).GetWidth
1519 else if FItems
[a
].ControlType
= TGUIMemo
then
1520 w
:= w
+(FItems
[a
].Control
as TGUIMemo
).GetWidth
;
1523 tx
:= Min(tx
, (gScreenWidth
div 2)-(w
div 2));
1528 for a
:= 0 to High(FItems
) do
1531 if (Text <> nil) and (Control
= nil) then Continue
;
1534 if Text <> nil then w
:= tx
+Text.GetWidth
;
1536 if w
> cx
then cx
:= w
;
1539 cx
:= cx
+MENU_HSPACE
;
1541 h
:= FHeader
.GetHeight
*2+MENU_VSPACE
*(Length(FItems
)-1);
1543 for a
:= 0 to High(FItems
) do
1546 if (ControlType
= TGUIListBox
) or (ControlType
= TGUIFileListBox
) then
1547 h
:= h
+(FItems
[a
].Control
as TGUIListBox
).GetHeight()
1549 h
:= h
+e_CharFont_GetMaxHeight(FFontID
);
1552 h
:= (gScreenHeight
div 2)-(h
div 2);
1556 FX
:= (gScreenWidth
div 2)-(GetWidth
div 2);
1559 Inc(h
, GetHeight
*2);
1562 for a
:= 0 to High(FItems
) do
1572 if Control
<> nil then
1585 if (ControlType
= TGUIListBox
) or (ControlType
= TGUIFileListBox
) then
1586 Inc(h
, (Control
as TGUIListBox
).GetHeight
+MENU_VSPACE
)
1587 else if ControlType
= TGUIMemo
then
1588 Inc(h
, (Control
as TGUIMemo
).GetHeight
+MENU_VSPACE
)
1590 Inc(h
, e_CharFont_GetMaxHeight(FFontID
)+MENU_VSPACE
);
1594 function TGUIMenu
.AddScroll(fText
: string): TGUIScroll
;
1601 Control
:= TGUIScroll
.Create();
1603 Text := TGUILabel
.Create(fText
, FFontID
);
1606 FColor
:= MENU_ITEMSTEXT_COLOR
;
1609 ControlType
:= TGUIScroll
;
1611 Result
:= (Control
as TGUIScroll
);
1614 if FIndex
= -1 then FIndex
:= i
;
1619 function TGUIMenu
.AddSwitch(fText
: string): TGUISwitch
;
1626 Control
:= TGUISwitch
.Create(FFontID
);
1627 (Control
as TGUISwitch
).FColor
:= MENU_ITEMSCTRL_COLOR
;
1629 Text := TGUILabel
.Create(fText
, FFontID
);
1632 FColor
:= MENU_ITEMSTEXT_COLOR
;
1635 ControlType
:= TGUISwitch
;
1637 Result
:= (Control
as TGUISwitch
);
1640 if FIndex
= -1 then FIndex
:= i
;
1645 function TGUIMenu
.AddEdit(fText
: string): TGUIEdit
;
1652 Control
:= TGUIEdit
.Create(FFontID
);
1653 with Control
as TGUIEdit
do
1655 FWindow
:= Self
.FWindow
;
1656 FColor
:= MENU_ITEMSCTRL_COLOR
;
1659 if fText
= '' then Text := nil else
1661 Text := TGUILabel
.Create(fText
, FFontID
);
1662 Text.FColor
:= MENU_ITEMSTEXT_COLOR
;
1665 ControlType
:= TGUIEdit
;
1667 Result
:= (Control
as TGUIEdit
);
1670 if FIndex
= -1 then FIndex
:= i
;
1675 procedure TGUIMenu
.Update
;
1681 if FCounter
= 0 then FCounter
:= MENU_MARKERDELAY
else Dec(FCounter
);
1683 if FItems
<> nil then
1684 for a
:= 0 to High(FItems
) do
1685 if FItems
[a
].Control
<> nil then
1686 (FItems
[a
].Control
as FItems
[a
].ControlType
).Update
;
1689 function TGUIMenu
.AddKeyRead(fText
: string): TGUIKeyRead
;
1696 Control
:= TGUIKeyRead
.Create(FFontID
);
1697 with Control
as TGUIKeyRead
do
1699 FWindow
:= Self
.FWindow
;
1700 FColor
:= MENU_ITEMSCTRL_COLOR
;
1703 Text := TGUILabel
.Create(fText
, FFontID
);
1706 FColor
:= MENU_ITEMSTEXT_COLOR
;
1709 ControlType
:= TGUIKeyRead
;
1711 Result
:= (Control
as TGUIKeyRead
);
1714 if FIndex
= -1 then FIndex
:= i
;
1719 function TGUIMenu
.AddList(fText
: string; Width
, Height
: Word): TGUIListBox
;
1726 Control
:= TGUIListBox
.Create(FFontID
, Width
, Height
);
1727 with Control
as TGUIListBox
do
1729 FWindow
:= Self
.FWindow
;
1730 FActiveColor
:= MENU_ITEMSCTRL_COLOR
;
1731 FUnActiveColor
:= MENU_ITEMSTEXT_COLOR
;
1734 Text := TGUILabel
.Create(fText
, FFontID
);
1737 FColor
:= MENU_ITEMSTEXT_COLOR
;
1740 ControlType
:= TGUIListBox
;
1742 Result
:= (Control
as TGUIListBox
);
1745 if FIndex
= -1 then FIndex
:= i
;
1750 function TGUIMenu
.AddFileList(fText
: string; Width
, Height
: Word): TGUIFileListBox
;
1757 Control
:= TGUIFileListBox
.Create(FFontID
, Width
, Height
);
1758 with Control
as TGUIFileListBox
do
1760 FWindow
:= Self
.FWindow
;
1761 FActiveColor
:= MENU_ITEMSCTRL_COLOR
;
1762 FUnActiveColor
:= MENU_ITEMSTEXT_COLOR
;
1765 if fText
= '' then Text := nil else
1767 Text := TGUILabel
.Create(fText
, FFontID
);
1768 Text.FColor
:= MENU_ITEMSTEXT_COLOR
;
1771 ControlType
:= TGUIFileListBox
;
1773 Result
:= (Control
as TGUIFileListBox
);
1776 if FIndex
= -1 then FIndex
:= i
;
1781 function TGUIMenu
.AddLabel(fText
: string): TGUILabel
;
1788 Control
:= TGUILabel
.Create('', FFontID
);
1789 with Control
as TGUILabel
do
1791 FWindow
:= Self
.FWindow
;
1792 FColor
:= MENU_ITEMSCTRL_COLOR
;
1795 Text := TGUILabel
.Create(fText
, FFontID
);
1798 FColor
:= MENU_ITEMSTEXT_COLOR
;
1801 ControlType
:= TGUILabel
;
1803 Result
:= (Control
as TGUILabel
);
1806 if FIndex
= -1 then FIndex
:= i
;
1811 function TGUIMenu
.AddMemo(fText
: string; Width
, Height
: Word): TGUIMemo
;
1818 Control
:= TGUIMemo
.Create(FFontID
, Width
, Height
);
1819 with Control
as TGUIMemo
do
1821 FWindow
:= Self
.FWindow
;
1822 FColor
:= MENU_ITEMSTEXT_COLOR
;
1825 if fText
= '' then Text := nil else
1827 Text := TGUILabel
.Create(fText
, FFontID
);
1828 Text.FColor
:= MENU_ITEMSTEXT_COLOR
;
1831 ControlType
:= TGUIMemo
;
1833 Result
:= (Control
as TGUIMemo
);
1836 if FIndex
= -1 then FIndex
:= i
;
1841 procedure TGUIMenu
.UpdateIndex();
1849 if (FIndex
< 0) or (FIndex
> High(FItems
)) then
1855 if FItems
[FIndex
].Control
.Enabled
then
1864 constructor TGUIScroll
.Create
;
1869 FOnChangeEvent
:= nil;
1871 g_Texture_Get(SCROLL_LEFT
, FLeftID
);
1872 g_Texture_Get(SCROLL_RIGHT
, FRightID
);
1873 g_Texture_Get(SCROLL_MIDDLE
, FMiddleID
);
1874 g_Texture_Get(SCROLL_MARKER
, FMarkerID
);
1877 procedure TGUIScroll
.Draw
;
1883 e_Draw(FLeftID
, FX
, FY
, 0, True, False);
1884 e_Draw(FRightID
, FX
+8+(FMax
+1)*8, FY
, 0, True, False);
1886 for a
:= 0 to FMax
do
1887 e_Draw(FMiddleID
, FX
+8+a
*8, FY
, 0, True, False);
1889 e_Draw(FMarkerID
, FX
+8+FValue
*8, FY
, 0, True, False);
1892 procedure TGUIScroll
.FSetValue(a
: Integer);
1894 if a
> FMax
then FValue
:= FMax
else FValue
:= a
;
1897 function TGUIScroll
.GetWidth
: Word;
1899 Result
:= 16+(FMax
+1)*8;
1902 procedure TGUIScroll
.OnMessage(var Msg
: TMessage
);
1904 if not FEnabled
then Exit
;
1916 g_Sound_PlayEx(SCROLL_SUBSOUND
);
1917 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
1919 IK_RIGHT
, IK_KPRIGHT
:
1920 if FValue
< FMax
then
1923 g_Sound_PlayEx(SCROLL_ADDSOUND
);
1924 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
1931 procedure TGUIScroll
.Update
;
1939 procedure TGUISwitch
.AddItem(Item
: string);
1941 SetLength(FItems
, Length(FItems
)+1);
1942 FItems
[High(FItems
)] := Item
;
1944 if FIndex
= -1 then FIndex
:= 0;
1947 constructor TGUISwitch
.Create(FontID
: DWORD
);
1953 FFont
:= TFont
.Create(FontID
, FONT_CHAR
);
1956 procedure TGUISwitch
.Draw
;
1960 FFont
.Draw(FX
, FY
, FItems
[FIndex
], FColor
.R
, FColor
.G
, FColor
.B
);
1963 function TGUISwitch
.GetText
: string;
1965 if FIndex
<> -1 then Result
:= FItems
[FIndex
]
1969 function TGUISwitch
.GetWidth
: Word;
1976 if FItems
= nil then Exit
;
1978 for a
:= 0 to High(FItems
) do
1980 FFont
.GetTextSize(FItems
[a
], w
, h
);
1981 if w
> Result
then Result
:= w
;
1985 procedure TGUISwitch
.OnMessage(var Msg
: TMessage
);
1987 if not FEnabled
then Exit
;
1991 if FItems
= nil then Exit
;
1996 IK_RETURN
, IK_RIGHT
, IK_KPRETURN
, IK_KPRIGHT
:
1998 if FIndex
< High(FItems
) then
2003 if @FOnChangeEvent
<> nil then
2004 FOnChangeEvent(Self
);
2012 FIndex
:= High(FItems
);
2014 if @FOnChangeEvent
<> nil then
2015 FOnChangeEvent(Self
);
2021 procedure TGUISwitch
.Update
;
2029 constructor TGUIEdit
.Create(FontID
: DWORD
);
2033 FFont
:= TFont
.Create(FontID
, FONT_CHAR
);
2038 g_Texture_Get(EDIT_LEFT
, FLeftID
);
2039 g_Texture_Get(EDIT_RIGHT
, FRightID
);
2040 g_Texture_Get(EDIT_MIDDLE
, FMiddleID
);
2043 procedure TGUIEdit
.Draw
;
2049 e_Draw(FLeftID
, FX
, FY
, 0, True, False);
2050 e_Draw(FRightID
, FX
+8+FWidth
*16, FY
, 0, True, False);
2052 for c
:= 0 to FWidth
-1 do
2053 e_Draw(FMiddleID
, FX
+8+c
*16, FY
, 0, True, False);
2055 FFont
.Draw(FX
+8, FY
, FText
, FColor
.R
, FColor
.G
, FColor
.B
);
2057 if FWindow
.FActiveControl
= Self
then
2059 FFont
.GetTextSize(Copy(FText
, 1, FCaretPos
), w
, h
);
2060 h
:= e_CharFont_GetMaxHeight(FFont
.ID
);
2061 e_DrawLine(2, FX
+8+w
, FY
+h
-3, FX
+8+w
+EDIT_CURSORLEN
, FY
+h
-3,
2062 EDIT_CURSORCOLOR
.R
, EDIT_CURSORCOLOR
.G
, EDIT_CURSORCOLOR
.B
);
2066 function TGUIEdit
.GetWidth
: Word;
2068 Result
:= 16+FWidth
*16;
2071 procedure TGUIEdit
.OnMessage(var Msg
: TMessage
);
2073 if not FEnabled
then Exit
;
2082 if (wParam
in [48..57]) and (Chr(wParam
) <> '`') then
2083 if Length(Text) < FMaxLength
then
2085 Insert(Chr(wParam
), FText
, FCaretPos
+ 1);
2091 if (wParam
in [32..255]) and (Chr(wParam
) <> '`') then
2092 if Length(Text) < FMaxLength
then
2094 Insert(Chr(wParam
), FText
, FCaretPos
+ 1);
2102 Delete(FText
, FCaretPos
, 1);
2103 if FCaretPos
> 0 then Dec(FCaretPos
);
2105 IK_DELETE
: Delete(FText
, FCaretPos
+ 1, 1);
2106 IK_END
, IK_KPEND
: FCaretPos
:= Length(FText
);
2107 IK_HOME
, IK_KPHOME
: FCaretPos
:= 0;
2108 IK_LEFT
, IK_KPLEFT
: if FCaretPos
> 0 then Dec(FCaretPos
);
2109 IK_RIGHT
, IK_KPRIGHT
: if FCaretPos
< Length(FText
) then Inc(FCaretPos
);
2110 IK_RETURN
, IK_KPRETURN
:
2113 if FActiveControl
<> Self
then
2116 if @FOnEnterEvent
<> nil then FOnEnterEvent(Self
);
2120 if FDefControl
<> '' then SetActive(GetControl(FDefControl
))
2121 else SetActive(nil);
2122 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2129 procedure TGUIEdit
.SetText(Text: string);
2131 if Length(Text) > FMaxLength
then SetLength(Text, FMaxLength
);
2133 FCaretPos
:= Length(FText
);
2136 procedure TGUIEdit
.Update
;
2143 constructor TGUIKeyRead
.Create(FontID
: DWORD
);
2147 FFont
:= TFont
.Create(FontID
, FONT_CHAR
);
2150 procedure TGUIKeyRead
.Draw
;
2154 FFont
.Draw(FX
, FY
, IfThen(FIsQuery
, KEYREAD_QUERY
, IfThen(FKey
<> 0, e_KeyNames
[FKey
], KEYREAD_CLEAR
)),
2155 FColor
.R
, FColor
.G
, FColor
.B
);
2158 function TGUIKeyRead
.GetWidth
: Word;
2165 for a
:= 0 to 255 do
2167 FFont
.GetTextSize(e_KeyNames
[a
], w
, h
);
2168 Result
:= Max(Result
, w
);
2171 FFont
.GetTextSize(KEYREAD_QUERY
, w
, h
);
2172 if w
> Result
then Result
:= w
;
2174 FFont
.GetTextSize(KEYREAD_CLEAR
, w
, h
);
2175 if w
> Result
then Result
:= w
;
2178 procedure TGUIKeyRead
.OnMessage(var Msg
: TMessage
);
2182 if not FEnabled
then
2193 if FDefControl
<> '' then
2194 SetActive(GetControl(FDefControl
))
2200 IK_RETURN
, IK_KPRETURN
:
2202 if not FIsQuery
then
2205 if FActiveControl
<> Self
then
2212 FKey
:= IK_ENTER
; // <Enter>
2216 if FDefControl
<> '' then
2217 SetActive(GetControl(FDefControl
))
2225 if FIsQuery
and (wParam
<> IK_ENTER
) and (wParam
<> IK_KPRETURN
) then // Not <Enter
2227 if e_KeyNames
[wParam
] <> '' then
2232 if FDefControl
<> '' then
2233 SetActive(GetControl(FDefControl
))
2242 constructor TGUIModelView
.Create
;
2249 destructor TGUIModelView
.Destroy
;
2256 procedure TGUIModelView
.Draw
;
2260 DrawBox(FX
, FY
, 4, 4);
2262 if FModel
<> nil then FModel
.Draw(FX
+4, FY
+4);
2265 procedure TGUIModelView
.NextAnim();
2267 if FModel
= nil then
2270 if FModel
.Animation
< A_PAIN
then
2271 FModel
.ChangeAnimation(FModel
.Animation
+1, True)
2273 FModel
.ChangeAnimation(A_STAND
, True);
2276 procedure TGUIModelView
.NextWeapon();
2278 if FModel
= nil then
2281 if FModel
.Weapon
< WEAPON_SUPERPULEMET
then
2282 FModel
.SetWeapon(FModel
.Weapon
+1)
2284 FModel
.SetWeapon(WEAPON_KASTET
);
2287 procedure TGUIModelView
.OnMessage(var Msg
: TMessage
);
2293 procedure TGUIModelView
.SetColor(Red
, Green
, Blue
: Byte);
2295 if FModel
<> nil then FModel
.SetColor(Red
, Green
, Blue
);
2298 procedure TGUIModelView
.SetModel(ModelName
: string);
2302 FModel
:= g_PlayerModel_Get(ModelName
);
2305 procedure TGUIModelView
.Update
;
2312 if FModel
<> nil then FModel
.Update
;
2317 constructor TGUIMapPreview
.Create();
2323 destructor TGUIMapPreview
.Destroy();
2329 procedure TGUIMapPreview
.Draw();
2336 DrawBox(FX
, FY
, MAPPREVIEW_WIDTH
, MAPPREVIEW_HEIGHT
);
2338 if (FMapSize
.X
<= 0) or (FMapSize
.Y
<= 0) then
2341 e_DrawFillQuad(FX
+4, FY
+4,
2342 FX
+4 + Trunc(FMapSize
.X
/ FScale
) - 1,
2343 FY
+4 + Trunc(FMapSize
.Y
/ FScale
) - 1,
2346 if FMapData
<> nil then
2347 for a
:= 0 to High(FMapData
) do
2350 if X1
> MAPPREVIEW_WIDTH
*16 then Continue
;
2351 if Y1
> MAPPREVIEW_HEIGHT
*16 then Continue
;
2353 if X2
< 0 then Continue
;
2354 if Y2
< 0 then Continue
;
2356 if X2
> MAPPREVIEW_WIDTH
*16 then X2
:= MAPPREVIEW_WIDTH
*16;
2357 if Y2
> MAPPREVIEW_HEIGHT
*16 then Y2
:= MAPPREVIEW_HEIGHT
*16;
2359 if X1
< 0 then X1
:= 0;
2360 if Y1
< 0 then Y1
:= 0;
2401 if ((X2
-X1
) > 0) and ((Y2
-Y1
) > 0) then
2402 e_DrawFillQuad(FX
+4 + X1
, FY
+4 + Y1
,
2403 FX
+4 + X2
- 1, FY
+4 + Y2
- 1, r
, g
, b
, 0);
2407 procedure TGUIMapPreview
.OnMessage(var Msg
: TMessage
);
2413 procedure TGUIMapPreview
.SetMap(Res
: string);
2416 MapReader
: TMapReader_1
;
2417 panels
: TPanelsRec1Array
;
2418 header
: TMapHeaderRec_1
;
2420 FileName
, SectionName
, ResName
: string;
2425 g_ProcessResourceStr(Res
, FileName
, SectionName
, ResName
);
2427 WAD
:= TWADEditor_1
.Create();
2428 if not WAD
.ReadFile(FileName
) then
2434 if not WAD
.GetResource('', ResName
, Data
, Len
) then
2442 MapReader
:= TMapReader_1
.Create();
2444 if not MapReader
.LoadMap(Data
) then
2457 panels
:= MapReader
.GetPanels();
2458 header
:= MapReader
.GetMapHeader();
2460 FMapSize
.X
:= header
.Width
div 16;
2461 FMapSize
.Y
:= header
.Height
div 16;
2463 rX
:= Ceil(header
.Width
/ (MAPPREVIEW_WIDTH
*256.0));
2464 rY
:= Ceil(header
.Height
/ (MAPPREVIEW_HEIGHT
*256.0));
2465 FScale
:= max(rX
, rY
);
2469 if panels
<> nil then
2470 for a
:= 0 to High(panels
) do
2471 if WordBool(panels
[a
].PanelType
and (PANEL_WALL
or PANEL_CLOSEDOOR
or
2472 PANEL_STEP
or PANEL_WATER
or
2473 PANEL_ACID1
or PANEL_ACID2
)) then
2475 SetLength(FMapData
, Length(FMapData
)+1);
2476 with FMapData
[High(FMapData
)] do
2478 X1
:= panels
[a
].X
div 16;
2479 Y1
:= panels
[a
].Y
div 16;
2481 X2
:= (panels
[a
].X
+ panels
[a
].Width
) div 16;
2482 Y2
:= (panels
[a
].Y
+ panels
[a
].Height
) div 16;
2484 X1
:= Trunc(X1
/FScale
+ 0.5);
2485 Y1
:= Trunc(Y1
/FScale
+ 0.5);
2486 X2
:= Trunc(X2
/FScale
+ 0.5);
2487 Y2
:= Trunc(Y2
/FScale
+ 0.5);
2489 if (X1
<> X2
) or (Y1
<> Y2
) then
2497 PanelType
:= panels
[a
].PanelType
;
2506 procedure TGUIMapPreview
.ClearMap();
2508 SetLength(FMapData
, 0);
2515 procedure TGUIMapPreview
.Update();
2521 function TGUIMapPreview
.GetScaleStr(): String;
2523 if FScale
> 0.0 then
2525 Result
:= FloatToStrF(FScale
*16.0, ffFixed
, 3, 3);
2526 while (Result
[Length(Result
)] = '0') do
2527 Delete(Result
, Length(Result
), 1);
2528 if (Result
[Length(Result
)] = ',') or (Result
[Length(Result
)] = '.') then
2529 Delete(Result
, Length(Result
), 1);
2530 Result
:= '1 : ' + Result
;
2538 procedure TGUIListBox
.AddItem(Item
: string);
2540 SetLength(FItems
, Length(FItems
)+1);
2541 FItems
[High(FItems
)] := Item
;
2543 if FSort
then g_Basic
.Sort(FItems
);
2546 procedure TGUIListBox
.Clear();
2554 constructor TGUIListBox
.Create(FontID
: DWORD
; Width
, Height
: Word);
2558 FFont
:= TFont
.Create(FontID
, FONT_CHAR
);
2563 FOnChangeEvent
:= nil;
2565 FDrawScroll
:= True;
2568 procedure TGUIListBox
.Draw
;
2576 if FDrawBack
then DrawBox(FX
, FY
, FWidth
+1, FHeight
);
2578 DrawScroll(FX
+4+FWidth
*16, FY
+4, FHeight
, (FStartLine
> 0) and (FItems
<> nil),
2579 (FStartLine
+FHeight
-1 < High(FItems
)) and (FItems
<> nil));
2581 if FItems
<> nil then
2582 for a
:= FStartLine
to Min(High(FItems
), FStartLine
+FHeight
-1) do
2586 FFont
.GetTextSize(s
, w2
, h2
);
2587 while (Length(s
) > 0) and (w2
> FWidth
*16) do
2589 SetLength(s
, Length(s
)-1);
2590 FFont
.GetTextSize(s
, w2
, h2
);
2594 FFont
.Draw(FX
+4, FY
+4+(a
-FStartLine
)*16, s
, FActiveColor
.R
, FActiveColor
.G
, FActiveColor
.B
)
2596 FFont
.Draw(FX
+4, FY
+4+(a
-FStartLine
)*16, s
, FUnActiveColor
.R
, FUnActiveColor
.G
, FUnActiveColor
.B
);
2600 function TGUIListBox
.GetHeight
: Word;
2602 Result
:= 8+FHeight
*16;
2605 function TGUIListBox
.GetWidth
: Word;
2607 Result
:= 8+(FWidth
+1)*16;
2610 procedure TGUIListBox
.OnMessage(var Msg
: TMessage
);
2614 if not FEnabled
then Exit
;
2618 if FItems
= nil then Exit
;
2631 FIndex
:= High(FItems
);
2632 FStartLine
:= Max(High(FItems
)-FHeight
+1, 0);
2634 IK_UP
, IK_LEFT
, IK_KPUP
, IK_KPLEFT
:
2638 if FIndex
< FStartLine
then Dec(FStartLine
);
2639 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2641 IK_DOWN
, IK_RIGHT
, IK_KPDOWN
, IK_KPRIGHT
:
2642 if FIndex
< High(FItems
) then
2645 if FIndex
> FStartLine
+FHeight
-1 then Inc(FStartLine
);
2646 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2648 IK_RETURN
, IK_KPRETURN
:
2651 if FActiveControl
<> Self
then SetActive(Self
)
2653 if FDefControl
<> '' then SetActive(GetControl(FDefControl
))
2654 else SetActive(nil);
2658 for a
:= 0 to High(FItems
) do
2659 if (Length(FItems
[a
]) > 0) and (LowerCase(FItems
[a
][1]) = LowerCase(Chr(wParam
))) then
2662 FStartLine
:= Min(Max(FIndex
-1, 0), Length(FItems
)-FHeight
);
2663 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2669 function TGUIListBox
.SelectedItem(): String;
2673 if (FIndex
< 0) or (FItems
= nil) or
2674 (FIndex
> High(FItems
)) then
2677 Result
:= FItems
[FIndex
];
2680 procedure TGUIListBox
.FSetItems(Items
: SArray
);
2682 if FItems
<> nil then
2690 if FSort
then g_Basic
.Sort(FItems
);
2693 procedure TGUIListBox
.SelectItem(Item
: String);
2697 if FItems
= nil then
2701 Item
:= LowerCase(Item
);
2703 for a
:= 0 to High(FItems
) do
2704 if LowerCase(FItems
[a
]) = Item
then
2710 if FIndex
< FHeight
then
2713 FStartLine
:= Min(FIndex
, Length(FItems
)-FHeight
);
2716 procedure TGUIListBox
.FSetIndex(aIndex
: Integer);
2718 if FItems
= nil then
2721 if (aIndex
< 0) or (aIndex
> High(FItems
)) then
2726 if FIndex
<= FHeight
then
2729 FStartLine
:= Min(FIndex
, Length(FItems
)-FHeight
);
2734 procedure TGUIFileListBox
.OnMessage(var Msg
: TMessage
);
2738 if not FEnabled
then
2741 if FItems
= nil then
2752 if @FOnChangeEvent
<> nil then
2753 FOnChangeEvent(Self
);
2758 FIndex
:= High(FItems
);
2759 FStartLine
:= Max(High(FItems
)-FHeight
+1, 0);
2760 if @FOnChangeEvent
<> nil then
2761 FOnChangeEvent(Self
);
2764 IK_PAGEUP
, IK_KPPAGEUP
:
2766 if FIndex
> FHeight
then
2767 FIndex
:= FIndex
-FHeight
2771 if FStartLine
> FHeight
then
2772 FStartLine
:= FStartLine
-FHeight
2777 IK_PAGEDN
, IK_KPPAGEDN
:
2779 if FIndex
< High(FItems
)-FHeight
then
2780 FIndex
:= FIndex
+FHeight
2782 FIndex
:= High(FItems
);
2784 if FStartLine
< High(FItems
)-FHeight
then
2785 FStartLine
:= FStartLine
+FHeight
2787 FStartLine
:= High(FItems
)-FHeight
+1;
2790 IK_UP
, IK_LEFT
, IK_KPUP
, IK_KPLEFT
:
2794 if FIndex
< FStartLine
then
2796 if @FOnChangeEvent
<> nil then
2797 FOnChangeEvent(Self
);
2800 IK_DOWN
, IK_RIGHT
, IK_KPDOWN
, IK_KPRIGHT
:
2801 if FIndex
< High(FItems
) then
2804 if FIndex
> FStartLine
+FHeight
-1 then
2806 if @FOnChangeEvent
<> nil then
2807 FOnChangeEvent(Self
);
2810 IK_RETURN
, IK_KPRETURN
:
2813 if FActiveControl
<> Self
then
2817 if FItems
[FIndex
][1] = #29 then // Ïàïêà
2819 OpenDir(FPath
+Copy(FItems
[FIndex
], 2, 255));
2824 if FDefControl
<> '' then
2825 SetActive(GetControl(FDefControl
))
2833 for a
:= 0 to High(FItems
) do
2834 if ( (Length(FItems
[a
]) > 0) and
2835 (LowerCase(FItems
[a
][1]) = LowerCase(Chr(wParam
))) ) or
2836 ( (Length(FItems
[a
]) > 1) and
2837 (FItems
[a
][1] = #29) and // Ïàïêà
2838 (LowerCase(FItems
[a
][2]) = LowerCase(Chr(wParam
))) ) then
2841 FStartLine
:= Min(Max(FIndex
-1, 0), Length(FItems
)-FHeight
);
2842 if @FOnChangeEvent
<> nil then
2843 FOnChangeEvent(Self
);
2849 procedure TGUIFileListBox
.OpenDir(path
: String);
2857 path
:= IncludeTrailingPathDelimiter(path
);
2858 path
:= ExpandFileName(path
);
2863 if FindFirst(path
+'*', faDirectory
, SR
) = 0 then
2865 if not LongBool(SR
.Attr
and faDirectory
) then
2867 if (SR
.Name
= '.') or
2868 ((SR
.Name
= '..') and (path
= ExpandFileName(FBasePath
))) then
2871 AddItem(#1 + SR
.Name
);
2872 until FindNext(SR
) <> 0;
2882 if i
= 0 then i
:= length(sm
)+1;
2883 sc
:= Copy(sm
, 1, i
-1);
2885 if FindFirst(path
+sc
, faAnyFile
, SR
) = 0 then repeat AddItem(SR
.Name
); until FindNext(SR
) <> 0;
2889 for i
:= 0 to High(FItems
) do
2890 if FItems
[i
][1] = #1 then
2891 FItems
[i
][1] := #29;
2896 procedure TGUIFileListBox
.SetBase(path
: String);
2902 function TGUIFileListBox
.SelectedItem(): String;
2906 if (FIndex
= -1) or (FItems
= nil) or
2907 (FIndex
> High(FItems
)) or
2908 (FItems
[FIndex
][1] = '/') or
2909 (FItems
[FIndex
][1] = '\') then
2912 Result
:= FPath
+ FItems
[FIndex
];
2915 procedure TGUIFileListBox
.UpdateFileList();
2919 if (FIndex
= -1) or (FItems
= nil) or
2920 (FIndex
> High(FItems
)) or
2921 (FItems
[FIndex
][1] = '/') or
2922 (FItems
[FIndex
][1] = '\') then
2925 fn
:= FItems
[FIndex
];
2935 procedure TGUIMemo
.Clear
;
2941 constructor TGUIMemo
.Create(FontID
: DWORD
; Width
, Height
: Word);
2945 FFont
:= TFont
.Create(FontID
, FONT_CHAR
);
2950 FDrawScroll
:= True;
2953 procedure TGUIMemo
.Draw
;
2959 if FDrawBack
then DrawBox(FX
, FY
, FWidth
+1, FHeight
);
2961 DrawScroll(FX
+4+FWidth
*16, FY
+4, FHeight
, (FStartLine
> 0) and (FLines
<> nil),
2962 (FStartLine
+FHeight
-1 < High(FLines
)) and (FLines
<> nil));
2964 if FLines
<> nil then
2965 for a
:= FStartLine
to Min(High(FLines
), FStartLine
+FHeight
-1) do
2966 FFont
.Draw(FX
+4, FY
+4+(a
-FStartLine
)*16, FLines
[a
], FColor
.R
, FColor
.G
, FColor
.B
);
2969 function TGUIMemo
.GetHeight
: Word;
2971 Result
:= 8+FHeight
*16;
2974 function TGUIMemo
.GetWidth
: Word;
2976 Result
:= 8+(FWidth
+1)*16;
2979 procedure TGUIMemo
.OnMessage(var Msg
: TMessage
);
2981 if not FEnabled
then Exit
;
2985 if FLines
= nil then Exit
;
2991 IK_UP
, IK_LEFT
, IK_KPUP
, IK_KPLEFT
:
2992 if FStartLine
> 0 then
2994 IK_DOWN
, IK_RIGHT
, IK_KPDOWN
, IK_KPRIGHT
:
2995 if FStartLine
< Length(FLines
)-FHeight
then
2997 IK_RETURN
, IK_KPRETURN
:
3000 if FActiveControl
<> Self
then
3006 if FDefControl
<> '' then SetActive(GetControl(FDefControl
))
3007 else SetActive(nil);
3013 procedure TGUIMemo
.SetText(Text: string);
3016 FLines
:= GetLines(Text, FFont
.ID
, FWidth
*16);
3021 procedure TGUIimage
.ClearImage();
3023 if FImageRes
= '' then Exit
;
3025 g_Texture_Delete(FImageRes
);
3029 constructor TGUIimage
.Create();
3036 destructor TGUIimage
.Destroy();
3041 procedure TGUIimage
.Draw();
3047 if FImageRes
= '' then
3049 if g_Texture_Get(FDefaultRes
, ID
) then e_Draw(ID
, FX
, FY
, 0, True, False);
3052 if g_Texture_Get(FImageRes
, ID
) then e_Draw(ID
, FX
, FY
, 0, True, False);
3055 procedure TGUIimage
.OnMessage(var Msg
: TMessage
);
3060 procedure TGUIimage
.SetImage(Res
: string);
3064 if g_Texture_CreateWADEx(Res
, Res
) then FImageRes
:= Res
;
3067 procedure TGUIimage
.Update();