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
;
86 TOnKeyDownEvent
= procedure(Key
: Byte);
87 TOnCloseEvent
= procedure;
88 TOnShowEvent
= procedure;
89 TOnClickEvent
= procedure;
90 TOnChangeEvent
= procedure(Sender
: TGUIControl
);
91 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 FOnCloseEvent
: TOnCloseEvent
;
122 FOnShowEvent
: TOnShowEvent
;
124 Childs
: array of TGUIControl
;
125 constructor Create(Name
: string);
126 destructor Destroy
; override;
127 function AddChild(Child
: TGUIControl
): TGUIControl
;
128 procedure OnMessage(var Msg
: TMessage
);
131 procedure SetActive(Control
: TGUIControl
);
132 function GetControl(Name
: string): TGUIControl
;
133 property OnKeyDown
: TOnKeyDownEvent read FOnKeyDown write FOnKeyDown
;
134 property OnClose
: TOnCloseEvent read FOnCloseEvent write FOnCloseEvent
;
135 property OnShow
: TOnShowEvent read FOnShowEvent write FOnShowEvent
;
136 property Name
: string read FName
;
137 property DefControl
: string read FDefControl write FDefControl
;
138 property BackTexture
: string read FBackTexture write FBackTexture
;
139 property MainWindow
: Boolean read FMainWindow write FMainWindow
;
142 TGUITextButton
= class(TGUIControl
)
151 constructor Create(Proc
: Pointer; FontID
: DWORD
; Text: string);
152 destructor Destroy(); override;
153 procedure OnMessage(var Msg
: TMessage
); override;
154 procedure Update(); override;
155 procedure Draw(); override;
156 function GetWidth(): Integer;
157 function GetHeight(): Integer;
158 procedure Click(Silent
: Boolean = False);
159 property Caption
: string read FText write FText
;
160 property Color
: TRGB read FColor write FColor
;
161 property Font
: TFont read FFont write FFont
;
162 property ShowWindow
: string read FShowWindow write FShowWindow
;
165 TGUILabel
= class(TGUIControl
)
171 FOnClickEvent
: TOnClickEvent
;
173 constructor Create(Text: string; FontID
: DWORD
);
174 procedure OnMessage(var Msg
: TMessage
); override;
175 procedure Draw
; override;
176 function GetWidth
: Integer;
177 function GetHeight
: Integer;
178 property OnClick
: TOnClickEvent read FOnClickEvent write FOnClickEvent
;
179 property FixedLength
: Word read FFixedLen write FFixedLen
;
180 property Text: string read FText write FText
;
181 property Color
: TRGB read FColor write FColor
;
182 property Font
: TFont read FFont write FFont
;
185 TGUIScroll
= class(TGUIControl
)
193 FOnChangeEvent
: TOnChangeEvent
;
194 procedure FSetValue(a
: Integer);
196 constructor Create();
197 procedure OnMessage(var Msg
: TMessage
); override;
198 procedure Update
; override;
199 procedure Draw
; override;
200 function GetWidth(): Word;
201 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
202 property Max
: Word read FMax write FMax
;
203 property Value
: Integer read FValue write FSetValue
;
206 TGUISwitch
= class(TGUIControl
)
209 FItems
: array of string;
212 FOnChangeEvent
: TOnChangeEvent
;
214 constructor Create(FontID
: DWORD
);
215 procedure OnMessage(var Msg
: TMessage
); override;
216 procedure AddItem(Item
: string);
217 procedure Update
; override;
218 procedure Draw
; override;
219 function GetWidth(): Word;
220 function GetText
: string;
221 property ItemIndex
: Integer read FIndex write FIndex
;
222 property Color
: TRGB read FColor write FColor
;
223 property Font
: TFont read FFont write FFont
;
224 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
227 TGUIEdit
= class(TGUIControl
)
235 FOnlyDigits
: Boolean;
239 FOnChangeEvent
: TOnChangeEvent
;
240 FOnEnterEvent
: TOnEnterEvent
;
241 procedure SetText(Text: string);
243 constructor Create(FontID
: DWORD
);
244 procedure OnMessage(var Msg
: TMessage
); override;
245 procedure Update
; override;
246 procedure Draw
; override;
247 function GetWidth(): Word;
248 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
249 property OnEnter
: TOnEnterEvent read FOnEnterEvent write FOnEnterEvent
;
250 property Width
: Word read FWidth write FWidth
;
251 property MaxLength
: Word read FMaxLength write FMaxLength
;
252 property OnlyDigits
: Boolean read FOnlyDigits write FOnlyDigits
;
253 property Text: string read FText write SetText
;
254 property Color
: TRGB read FColor write FColor
;
255 property Font
: TFont read FFont write FFont
;
258 TGUIKeyRead
= class(TGUIControl
)
265 constructor Create(FontID
: DWORD
);
266 procedure OnMessage(var Msg
: TMessage
); override;
267 procedure Draw
; override;
268 function GetWidth(): Word;
269 property Key
: Word read FKey write FKey
;
270 property Color
: TRGB read FColor write FColor
;
271 property Font
: TFont read FFont write FFont
;
274 TGUIModelView
= class(TGUIControl
)
276 FModel
: TPlayerModel
;
280 destructor Destroy
; override;
281 procedure OnMessage(var Msg
: TMessage
); override;
282 procedure SetModel(ModelName
: string);
283 procedure SetColor(Red
, Green
, Blue
: Byte);
284 procedure NextAnim();
285 procedure NextWeapon();
286 procedure Update
; override;
287 procedure Draw
; override;
288 property Model
: TPlayerModel read FModel
;
291 TPreviewPanel
= record
292 X1
, Y1
, X2
, Y2
: Integer;
296 TGUIMapPreview
= class(TGUIControl
)
298 FMapData
: array of TPreviewPanel
;
302 constructor Create();
303 destructor Destroy(); override;
304 procedure OnMessage(var Msg
: TMessage
); override;
305 procedure SetMap(Res
: string);
306 procedure ClearMap();
307 procedure Update(); override;
308 procedure Draw(); override;
309 function GetScaleStr
: String;
312 TGUIImage
= class(TGUIControl
)
317 constructor Create();
318 destructor Destroy(); override;
319 procedure OnMessage(var Msg
: TMessage
); override;
320 procedure SetImage(Res
: string);
321 procedure ClearImage();
322 procedure Update(); override;
323 procedure Draw(); override;
324 property DefaultRes
: string read FDefaultRes write FDefaultRes
;
327 TGUIListBox
= class(TGUIControl
)
331 FUnActiveColor
: TRGB
;
339 FDrawScroll
: Boolean;
340 FOnChangeEvent
: TOnChangeEvent
;
342 procedure FSetItems(Items
: SArray
);
343 procedure FSetIndex(aIndex
: Integer);
346 constructor Create(FontID
: DWORD
; Width
, Height
: Word);
347 procedure OnMessage(var Msg
: TMessage
); override;
348 procedure Draw(); override;
349 procedure AddItem(Item
: String);
350 procedure SelectItem(Item
: String);
352 function GetWidth(): Word;
353 function GetHeight(): Word;
354 function SelectedItem(): String;
356 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
357 property Sort
: Boolean read FSort write FSort
;
358 property ItemIndex
: Integer read FIndex write FSetIndex
;
359 property Items
: SArray read FItems write FSetItems
;
360 property DrawBack
: Boolean read FDrawBack write FDrawBack
;
361 property DrawScrollBar
: Boolean read FDrawScroll write FDrawScroll
;
362 property ActiveColor
: TRGB read FActiveColor write FActiveColor
;
363 property UnActiveColor
: TRGB read FUnActiveColor write FUnActiveColor
;
364 property Font
: TFont read FFont write FFont
;
367 TGUIFileListBox
= class (TGUIListBox
)
374 procedure OpenDir(path
: String);
377 procedure OnMessage(var Msg
: TMessage
); override;
378 procedure SetBase(path
: String);
379 function SelectedItem(): String;
380 procedure UpdateFileList();
382 property Dirs
: Boolean read FDirs write FDirs
;
383 property FileMask
: String read FFileMask write FFileMask
;
384 property Path
: String read FPath
;
387 TGUIMemo
= class(TGUIControl
)
396 FDrawScroll
: Boolean;
398 constructor Create(FontID
: DWORD
; Width
, Height
: Word);
399 procedure OnMessage(var Msg
: TMessage
); override;
400 procedure Draw
; override;
402 function GetWidth(): Word;
403 function GetHeight(): Word;
404 procedure SetText(Text: string);
405 property DrawBack
: Boolean read FDrawBack write FDrawBack
;
406 property DrawScrollBar
: Boolean read FDrawScroll write FDrawScroll
;
407 property Color
: TRGB read FColor write FColor
;
408 property Font
: TFont read FFont write FFont
;
411 TGUIMainMenu
= class(TGUIControl
)
413 FButtons
: array of TGUITextButton
;
421 constructor Create(FontID
: DWORD
; Header
: string);
422 destructor Destroy
; override;
423 procedure OnMessage(var Msg
: TMessage
); override;
424 function AddButton(fProc
: Pointer; Caption
: string; ShowWindow
: string = ''): TGUITextButton
;
425 function GetButton(Name
: string): TGUITextButton
;
426 procedure EnableButton(Name
: string; e
: Boolean);
427 procedure AddSpace();
428 procedure Update
; override;
429 procedure Draw
; override;
432 TControlType
= class of TGUIControl
;
434 PMenuItem
= ^TMenuItem
;
437 ControlType
: TControlType
;
438 Control
: TGUIControl
;
441 TGUIMenu
= class(TGUIControl
)
443 FItems
: array of TMenuItem
;
450 function NewItem(): Integer;
452 constructor Create(HeaderFont
, ItemsFont
: DWORD
; Header
: string);
453 destructor Destroy
; override;
454 procedure OnMessage(var Msg
: TMessage
); override;
455 procedure AddSpace();
456 procedure AddLine(fText
: string);
457 procedure AddText(fText
: string; MaxWidth
: Word);
458 function AddLabel(fText
: string): TGUILabel
;
459 function AddButton(Proc
: Pointer; fText
: string; _ShowWindow
: string = ''): TGUITextButton
;
460 function AddScroll(fText
: string): TGUIScroll
;
461 function AddSwitch(fText
: string): TGUISwitch
;
462 function AddEdit(fText
: string): TGUIEdit
;
463 function AddKeyRead(fText
: string): TGUIKeyRead
;
464 function AddList(fText
: string; Width
, Height
: Word): TGUIListBox
;
465 function AddFileList(fText
: string; Width
, Height
: Word): TGUIFileListBox
;
466 function AddMemo(fText
: string; Width
, Height
: Word): TGUIMemo
;
468 function GetControl(Name
: string): TGUIControl
;
469 function GetControlsText(Name
: string): TGUILabel
;
470 procedure Draw
; override;
471 procedure Update
; override;
472 procedure UpdateIndex();
473 property Align
: Boolean read FAlign write FAlign
;
474 property Left
: Integer read FLeft write FLeft
;
478 g_GUIWindows
: array of TGUIWindow
;
479 g_ActiveWindow
: TGUIWindow
= nil;
481 procedure g_GUI_Init();
482 function g_GUI_AddWindow(Window
: TGUIWindow
): TGUIWindow
;
483 function g_GUI_GetWindow(Name
: string): TGUIWindow
;
484 procedure g_GUI_ShowWindow(Name
: string);
485 procedure g_GUI_HideWindow(PlaySound
: Boolean = True);
486 function g_GUI_Destroy(): Boolean;
487 procedure g_GUI_SaveMenuPos();
488 procedure g_GUI_LoadMenuPos();
493 GL
, GLExt
, g_textures
, g_sound
, SysUtils
,
494 g_game
, Math
, StrUtils
, g_player
, g_options
, MAPREADER
,
495 g_map
, MAPDEF
, g_weapons
;
498 Box
: Array [0..8] of DWORD
;
499 Saved_Windows
: SArray
;
501 procedure g_GUI_Init();
503 g_Texture_Get(BOX1
, Box
[0]);
504 g_Texture_Get(BOX2
, Box
[1]);
505 g_Texture_Get(BOX3
, Box
[2]);
506 g_Texture_Get(BOX4
, Box
[3]);
507 g_Texture_Get(BOX5
, Box
[4]);
508 g_Texture_Get(BOX6
, Box
[5]);
509 g_Texture_Get(BOX7
, Box
[6]);
510 g_Texture_Get(BOX8
, Box
[7]);
511 g_Texture_Get(BOX9
, Box
[8]);
514 function g_GUI_Destroy(): Boolean;
518 Result
:= (Length(g_GUIWindows
) > 0);
520 for i
:= 0 to High(g_GUIWindows
) do
521 g_GUIWindows
[i
].Free();
524 g_ActiveWindow
:= nil;
527 function g_GUI_AddWindow(Window
: TGUIWindow
): TGUIWindow
;
529 SetLength(g_GUIWindows
, Length(g_GUIWindows
)+1);
530 g_GUIWindows
[High(g_GUIWindows
)] := Window
;
535 function g_GUI_GetWindow(Name
: string): TGUIWindow
;
541 if g_GUIWindows
<> nil then
542 for i
:= 0 to High(g_GUIWindows
) do
543 if g_GUIWindows
[i
].FName
= Name
then
545 Result
:= g_GUIWindows
[i
];
549 Assert(Result
<> nil, 'GUI_Window "'+Name
+'" not found');
552 procedure g_GUI_ShowWindow(Name
: string);
556 if g_GUIWindows
= nil then
559 for i
:= 0 to High(g_GUIWindows
) do
560 if g_GUIWindows
[i
].FName
= Name
then
562 g_GUIWindows
[i
].FPrevWindow
:= g_ActiveWindow
;
563 g_ActiveWindow
:= g_GUIWindows
[i
];
565 if g_ActiveWindow
.MainWindow
then
566 g_ActiveWindow
.FPrevWindow
:= nil;
568 if g_ActiveWindow
.FDefControl
<> '' then
569 g_ActiveWindow
.SetActive(g_ActiveWindow
.GetControl(g_ActiveWindow
.FDefControl
))
571 g_ActiveWindow
.SetActive(nil);
573 if @g_ActiveWindow
.FOnShowEvent
<> nil then
574 g_ActiveWindow
.FOnShowEvent();
580 procedure g_GUI_HideWindow(PlaySound
: Boolean = True);
582 if g_ActiveWindow
<> nil then
584 if @g_ActiveWindow
.OnClose
<> nil then
585 g_ActiveWindow
.OnClose();
586 g_ActiveWindow
:= g_ActiveWindow
.FPrevWindow
;
588 g_Sound_PlayEx(WINDOW_CLOSESOUND
);
592 procedure g_GUI_SaveMenuPos();
597 SetLength(Saved_Windows
, 0);
598 win
:= g_ActiveWindow
;
602 len
:= Length(Saved_Windows
);
603 SetLength(Saved_Windows
, len
+ 1);
605 Saved_Windows
[len
] := win
.Name
;
607 if win
.MainWindow
then
610 win
:= win
.FPrevWindow
;
614 procedure g_GUI_LoadMenuPos();
616 i
, j
, k
, len
: Integer;
619 g_ActiveWindow
:= nil;
620 len
:= Length(Saved_Windows
);
625 // Îêíî ñ ãëàâíûì ìåíþ:
626 g_GUI_ShowWindow(Saved_Windows
[len
-1]);
628 // Íå ïåðåêëþ÷èëîñü (èëè íåêóäà äàëüøå):
629 if (len
= 1) or (g_ActiveWindow
= nil) then
632 // Èùåì êíîïêè â îñòàëüíûõ îêíàõ:
633 for k
:= len
-1 downto 1 do
637 for i
:= 0 to Length(g_ActiveWindow
.Childs
)-1 do
639 if g_ActiveWindow
.Childs
[i
] is TGUIMainMenu
then
640 begin // GUI_MainMenu
641 with TGUIMainMenu(g_ActiveWindow
.Childs
[i
]) do
642 for j
:= 0 to Length(FButtons
)-1 do
643 if FButtons
[j
].ShowWindow
= Saved_Windows
[k
-1] then
645 FButtons
[j
].Click(True);
651 if g_ActiveWindow
.Childs
[i
] is TGUIMenu
then
652 with TGUIMenu(g_ActiveWindow
.Childs
[i
]) do
653 for j
:= 0 to Length(FItems
)-1 do
654 if FItems
[j
].ControlType
= TGUITextButton
then
655 if TGUITextButton(FItems
[j
].Control
).ShowWindow
= Saved_Windows
[k
-1] then
657 TGUITextButton(FItems
[j
].Control
).Click(True);
668 (g_ActiveWindow
.Name
= Saved_Windows
[k
]) then
673 procedure DrawBox(X
, Y
: Integer; Width
, Height
: Word);
675 e_Draw(Box
[0], X
, Y
, 0, False, False);
676 e_DrawFill(Box
[1], X
+4, Y
, Width
*4, 1, 0, False, False);
677 e_Draw(Box
[2], X
+4+Width
*16, Y
, 0, False, False);
678 e_DrawFill(Box
[3], X
, Y
+4, 1, Height
*4, 0, False, False);
679 e_DrawFill(Box
[4], X
+4, Y
+4, Width
, Height
, 0, False, False);
680 e_DrawFill(Box
[5], X
+4+Width
*16, Y
+4, 1, Height
*4, 0, False, False);
681 e_Draw(Box
[6], X
, Y
+4+Height
*16, 0, False, False);
682 e_DrawFill(Box
[7], X
+4, Y
+4+Height
*16, Width
*4, 1, 0, False, False);
683 e_Draw(Box
[8], X
+4+Width
*16, Y
+4+Height
*16, 0, False, False);
686 procedure DrawScroll(X
, Y
: Integer; Height
: Word; Up
, Down
: Boolean);
690 if Height
< 3 then Exit
;
693 g_Texture_Get(BSCROLL_UPA
, ID
)
695 g_Texture_Get(BSCROLL_UPU
, ID
);
696 e_Draw(ID
, X
, Y
, 0, False, False);
699 g_Texture_Get(BSCROLL_DOWNA
, ID
)
701 g_Texture_Get(BSCROLL_DOWNU
, ID
);
702 e_Draw(ID
, X
, Y
+(Height
-1)*16, 0, False, False);
704 g_Texture_Get(BSCROLL_MIDDLE
, ID
);
705 e_DrawFill(ID
, X
, Y
+16, 1, Height
-2, 0, False, False);
710 constructor TGUIWindow
.Create(Name
: string);
713 FActiveControl
:= nil;
716 FOnCloseEvent
:= nil;
720 destructor TGUIWindow
.Destroy
;
727 for i
:= 0 to High(Childs
) do
731 function TGUIWindow
.AddChild(Child
: TGUIControl
): TGUIControl
;
733 Child
.FWindow
:= Self
;
735 SetLength(Childs
, Length(Childs
) + 1);
736 Childs
[High(Childs
)] := Child
;
741 procedure TGUIWindow
.Update
;
745 for i
:= 0 to High(Childs
) do
746 if Childs
[i
] <> nil then Childs
[i
].Update
;
749 procedure TGUIWindow
.Draw
;
754 if FBackTexture
<> '' then
755 if g_Texture_Get(FBackTexture
, ID
) then
756 e_DrawSize(ID
, 0, 0, 0, False, False, gScreenWidth
, gScreenHeight
)
758 e_Clear(GL_COLOR_BUFFER_BIT
, 0.5, 0.5, 0.5);
760 for i
:= 0 to High(Childs
) do
761 if Childs
[i
] <> nil then Childs
[i
].Draw
;
764 procedure TGUIWindow
.OnMessage(var Msg
: TMessage
);
766 if FActiveControl
<> nil then FActiveControl
.OnMessage(Msg
);
767 if @FOnKeyDown
<> nil then FOnKeyDown(Msg
.wParam
);
769 if Msg
.Msg
= WM_KEYDOWN
then
770 if Msg
.wParam
= IK_ESCAPE
then
777 procedure TGUIWindow
.SetActive(Control
: TGUIControl
);
779 FActiveControl
:= Control
;
782 function TGUIWindow
.GetControl(Name
: String): TGUIControl
;
788 if Childs
<> nil then
789 for i
:= 0 to High(Childs
) do
790 if Childs
[i
] <> nil then
791 if LowerCase(Childs
[i
].FName
) = LowerCase(Name
) then
797 Assert(Result
<> nil, 'Window Control "'+Name
+'" not Found!');
802 constructor TGUIControl
.Create();
810 procedure TGUIControl
.OnMessage(var Msg
: TMessage
);
816 procedure TGUIControl
.Update();
821 procedure TGUIControl
.Draw();
828 procedure TGUITextButton
.Click(Silent
: Boolean = False);
830 if (FSound
<> '') and (not Silent
) then
831 g_Sound_PlayEx(FSound
);
835 if FShowWindow
<> '' then
836 g_GUI_ShowWindow(FShowWindow
);
839 constructor TGUITextButton
.Create(Proc
: Pointer; FontID
: DWORD
; Text: string);
845 FFont
:= TFont
.Create(FontID
, FONT_CHAR
);
850 destructor TGUITextButton
.Destroy
;
856 procedure TGUITextButton
.Draw
;
858 FFont
.Draw(FX
, FY
, FText
, FColor
.R
, FColor
.G
, FColor
.B
)
861 function TGUITextButton
.GetHeight
: Integer;
865 FFont
.GetTextSize(FText
, w
, h
);
869 function TGUITextButton
.GetWidth
: Integer;
873 FFont
.GetTextSize(FText
, w
, h
);
877 procedure TGUITextButton
.OnMessage(var Msg
: TMessage
);
879 if not FEnabled
then Exit
;
886 IK_RETURN
, IK_KPRETURN
: Click();
891 procedure TGUITextButton
.Update
;
898 constructor TFont
.Create(FontID
: DWORD
; FontType
: TFontType
);
903 FFontType
:= FontType
;
906 destructor TFont
.Destroy
;
912 procedure TFont
.Draw(X
, Y
: Integer; Text: string; R
, G
, B
: Byte);
914 if FFontType
= FONT_CHAR
then e_CharFont_PrintEx(ID
, X
, Y
, Text, _RGB(R
, G
, B
), FScale
)
915 else e_TextureFontPrintEx(X
, Y
, Text, ID
, R
, G
, B
, FScale
);
918 procedure TFont
.GetTextSize(Text: string; var w
, h
: Word);
922 if FFontType
= FONT_CHAR
then e_CharFont_GetSize(ID
, Text, w
, h
)
925 e_TextureFontGetSize(ID
, cw
, ch
);
926 w
:= cw
*Length(Text);
930 w
:= Round(w
*FScale
);
931 h
:= Round(h
*FScale
);
936 function TGUIMainMenu
.AddButton(fProc
: Pointer; Caption
: string; ShowWindow
: string = ''): TGUITextButton
;
943 SetLength(FButtons
, Length(FButtons
)+1);
944 FButtons
[High(FButtons
)] := TGUITextButton
.Create(fProc
, FFontID
, Caption
);
945 FButtons
[High(FButtons
)].ShowWindow
:= ShowWindow
;
946 with FButtons
[High(FButtons
)] do
948 if (fProc
<> nil) or (ShowWindow
<> '') then FColor
:= MAINMENU_ITEMS_COLOR
949 else FColor
:= MAINMENU_UNACTIVEITEMS_COLOR
;
950 FSound
:= MAINMENU_CLICKSOUND
;
953 _x
:= gScreenWidth
div 2;
955 for a
:= 0 to High(FButtons
) do
956 if FButtons
[a
] <> nil then
957 _x
:= Min(_x
, (gScreenWidth
div 2)-(FButtons
[a
].GetWidth
div 2));
959 hh
:= FHeader
.GetHeight
;
961 h
:= hh
*(2+Length(FButtons
))+MAINMENU_SPACE
*(Length(FButtons
)-1);
962 h
:= (gScreenHeight
div 2)-(h
div 2);
972 for a
:= 0 to High(FButtons
) do
974 if FButtons
[a
] <> nil then
981 Inc(h
, hh
+MAINMENU_SPACE
);
984 Result
:= FButtons
[High(FButtons
)];
987 procedure TGUIMainMenu
.AddSpace
;
989 SetLength(FButtons
, Length(FButtons
)+1);
990 FButtons
[High(FButtons
)] := nil;
993 constructor TGUIMainMenu
.Create(FontID
: DWORD
; Header
: string);
999 FCounter
:= MAINMENU_MARKERDELAY
;
1001 g_Texture_Get(MAINMENU_MARKER1
, FMarkerID1
);
1002 g_Texture_Get(MAINMENU_MARKER2
, FMarkerID2
);
1004 FHeader
:= TGUILabel
.Create(Header
, FFontID
);
1007 FColor
:= MAINMENU_HEADER_COLOR
;
1008 FX
:= (gScreenWidth
div 2)-(GetWidth
div 2);
1009 FY
:= (gScreenHeight
div 2)-(GetHeight
div 2);
1013 destructor TGUIMainMenu
.Destroy
;
1017 if FButtons
<> nil then
1018 for a
:= 0 to High(FButtons
) do
1026 procedure TGUIMainMenu
.Draw
;
1034 if FButtons
<> nil then
1036 for a
:= 0 to High(FButtons
) do
1037 if FButtons
[a
] <> nil then FButtons
[a
].Draw
;
1039 if FIndex
<> -1 then
1040 e_Draw(FMarkerID1
, FButtons
[FIndex
].FX
-48, FButtons
[FIndex
].FY
, 0, True, False);
1044 procedure TGUIMainMenu
.EnableButton(Name
: string; e
: Boolean);
1048 if FButtons
= nil then Exit
;
1050 for a
:= 0 to High(FButtons
) do
1051 if (FButtons
[a
] <> nil) and (FButtons
[a
].Name
= Name
) then
1053 if e
then FButtons
[a
].FColor
:= MAINMENU_ITEMS_COLOR
1054 else FButtons
[a
].FColor
:= MAINMENU_UNACTIVEITEMS_COLOR
;
1055 FButtons
[a
].Enabled
:= e
;
1060 function TGUIMainMenu
.GetButton(Name
: string): TGUITextButton
;
1066 if FButtons
= nil then Exit
;
1068 for a
:= 0 to High(FButtons
) do
1069 if (FButtons
[a
] <> nil) and (FButtons
[a
].Name
= Name
) then
1071 Result
:= FButtons
[a
];
1076 procedure TGUIMainMenu
.OnMessage(var Msg
: TMessage
);
1081 if not FEnabled
then Exit
;
1085 if FButtons
= nil then Exit
;
1088 for a
:= 0 to High(FButtons
) do
1089 if FButtons
[a
] <> nil then
1095 if not ok
then Exit
;
1104 if FIndex
< 0 then FIndex
:= High(FButtons
);
1105 until FButtons
[FIndex
] <> nil;
1107 g_Sound_PlayEx(MENU_CHANGESOUND
);
1113 if FIndex
> High(FButtons
) then FIndex
:= 0;
1114 until FButtons
[FIndex
] <> nil;
1116 g_Sound_PlayEx(MENU_CHANGESOUND
);
1118 IK_RETURN
, IK_KPRETURN
: if (FIndex
<> -1) and FButtons
[FIndex
].FEnabled
then FButtons
[FIndex
].Click
;
1123 procedure TGUIMainMenu
.Update
;
1129 if FCounter
= 0 then
1132 FMarkerID1
:= FMarkerID2
;
1135 FCounter
:= MAINMENU_MARKERDELAY
;
1136 end else Dec(FCounter
);
1141 constructor TGUILabel
.Create(Text: string; FontID
: DWORD
);
1145 FFont
:= TFont
.Create(FontID
, FONT_CHAR
);
1149 FOnClickEvent
:= nil;
1152 procedure TGUILabel
.Draw
;
1154 FFont
.Draw(FX
, FY
, FText
, FColor
.R
, FColor
.G
, FColor
.B
);
1157 function TGUILabel
.GetHeight
: Integer;
1161 FFont
.GetTextSize(FText
, w
, h
);
1165 function TGUILabel
.GetWidth
: Integer;
1169 if FFixedLen
= 0 then
1170 FFont
.GetTextSize(FText
, w
, h
)
1172 w
:= e_CharFont_GetMaxWidth(FFont
.ID
)*FFixedLen
;
1176 procedure TGUILabel
.OnMessage(var Msg
: TMessage
);
1178 if not FEnabled
then Exit
;
1185 IK_RETURN
, IK_KPRETURN
: if @FOnClickEvent
<> nil then FOnClickEvent();
1192 function TGUIMenu
.AddButton(Proc
: Pointer; fText
: string; _ShowWindow
: string = ''): TGUITextButton
;
1199 Control
:= TGUITextButton
.Create(Proc
, FFontID
, fText
);
1200 with Control
as TGUITextButton
do
1202 ShowWindow
:= _ShowWindow
;
1203 FColor
:= MENU_ITEMSCTRL_COLOR
;
1207 ControlType
:= TGUITextButton
;
1209 Result
:= (Control
as TGUITextButton
);
1212 if FIndex
= -1 then FIndex
:= i
;
1217 procedure TGUIMenu
.AddLine(fText
: string);
1224 Text := TGUILabel
.Create(fText
, FFontID
);
1227 FColor
:= MENU_ITEMSTEXT_COLOR
;
1236 procedure TGUIMenu
.AddText(fText
: string; MaxWidth
: Word);
1241 l
:= GetLines(fText
, FFontID
, MaxWidth
);
1243 if l
= nil then Exit
;
1245 for a
:= 0 to High(l
) do
1250 Text := TGUILabel
.Create(l
[a
], FFontID
);
1253 FColor
:= MENU_ITEMSTEXT_COLOR
;
1263 procedure TGUIMenu
.AddSpace
;
1277 constructor TGUIMenu
.Create(HeaderFont
, ItemsFont
: DWORD
; Header
: string);
1283 FFontID
:= ItemsFont
;
1284 FCounter
:= MENU_MARKERDELAY
;
1287 FHeader
:= TGUILabel
.Create(Header
, HeaderFont
);
1290 FX
:= (gScreenWidth
div 2)-(GetWidth
div 2);
1292 FColor
:= MAINMENU_HEADER_COLOR
;
1296 destructor TGUIMenu
.Destroy
;
1300 if FItems
<> nil then
1301 for a
:= 0 to High(FItems
) do
1315 procedure TGUIMenu
.Draw
;
1321 if FHeader
<> nil then FHeader
.Draw
;
1323 if FItems
<> nil then
1324 for a
:= 0 to High(FItems
) do
1326 if FItems
[a
].Text <> nil then FItems
[a
].Text.Draw
;
1327 if FItems
[a
].Control
<> nil then FItems
[a
].Control
.Draw
;
1330 if (FIndex
<> -1) and (FCounter
> MENU_MARKERDELAY
div 2) then
1335 if FItems
[FIndex
].Text <> nil then
1337 x
:= FItems
[FIndex
].Text.FX
;
1338 y
:= FItems
[FIndex
].Text.FY
;
1340 else if FItems
[FIndex
].Control
<> nil then
1342 x
:= FItems
[FIndex
].Control
.FX
;
1343 y
:= FItems
[FIndex
].Control
.FY
;
1346 x
:= x
-e_CharFont_GetMaxWidth(FFontID
);
1348 e_CharFont_PrintEx(FFontID
, x
, y
, #16, _RGB(255, 0, 0));
1352 function TGUIMenu
.GetControl(Name
: String): TGUIControl
;
1358 if FItems
<> nil then
1359 for a
:= 0 to High(FItems
) do
1360 if FItems
[a
].Control
<> nil then
1361 if LowerCase(FItems
[a
].Control
.Name
) = LowerCase(Name
) then
1363 Result
:= FItems
[a
].Control
;
1367 Assert(Result
<> nil, 'GUI control "'+Name
+'" not found!');
1370 function TGUIMenu
.GetControlsText(Name
: String): TGUILabel
;
1376 if FItems
<> nil then
1377 for a
:= 0 to High(FItems
) do
1378 if FItems
[a
].Control
<> nil then
1379 if LowerCase(FItems
[a
].Control
.Name
) = LowerCase(Name
) then
1381 Result
:= FItems
[a
].Text;
1385 Assert(Result
<> nil, 'GUI control''s text "'+Name
+'" not found!');
1388 function TGUIMenu
.NewItem
: Integer;
1390 SetLength(FItems
, Length(FItems
)+1);
1391 Result
:= High(FItems
);
1394 procedure TGUIMenu
.OnMessage(var Msg
: TMessage
);
1399 if not FEnabled
then Exit
;
1403 if FItems
= nil then Exit
;
1406 for a
:= 0 to High(FItems
) do
1407 if FItems
[a
].Control
<> nil then
1413 if not ok
then Exit
;
1424 if c
> Length(FItems
) then
1431 if FIndex
< 0 then FIndex
:= High(FItems
);
1432 until (FItems
[FIndex
].Control
<> nil) and
1433 (FItems
[FIndex
].Control
.Enabled
);
1437 g_Sound_PlayEx(MENU_CHANGESOUND
);
1445 if c
> Length(FItems
) then
1452 if FIndex
> High(FItems
) then FIndex
:= 0;
1453 until (FItems
[FIndex
].Control
<> nil) and
1454 (FItems
[FIndex
].Control
.Enabled
);
1458 g_Sound_PlayEx(MENU_CHANGESOUND
);
1461 IK_LEFT
, IK_RIGHT
, IK_KPLEFT
, IK_KPRIGHT
:
1463 if FIndex
<> -1 then
1464 if FItems
[FIndex
].Control
<> nil then
1465 FItems
[FIndex
].Control
.OnMessage(Msg
);
1467 IK_RETURN
, IK_KPRETURN
:
1469 if FIndex
<> -1 then
1470 if FItems
[FIndex
].Control
<> nil then
1471 FItems
[FIndex
].Control
.OnMessage(Msg
);
1473 g_Sound_PlayEx(MENU_CLICKSOUND
);
1480 procedure TGUIMenu
.ReAlign();
1482 a
, tx
, cx
, w
, h
: Integer;
1484 if FItems
= nil then Exit
;
1486 if not FAlign
then tx
:= FLeft
else
1489 for a
:= 0 to High(FItems
) do
1492 if FItems
[a
].Text <> nil then w
:= FItems
[a
].Text.GetWidth
;
1493 if FItems
[a
].Control
<> nil then
1497 if FItems
[a
].ControlType
= TGUILabel
then
1498 w
:= w
+(FItems
[a
].Control
as TGUILabel
).GetWidth
1499 else if FItems
[a
].ControlType
= TGUITextButton
then
1500 w
:= w
+(FItems
[a
].Control
as TGUITextButton
).GetWidth
1501 else if FItems
[a
].ControlType
= TGUIScroll
then
1502 w
:= w
+(FItems
[a
].Control
as TGUIScroll
).GetWidth
1503 else if FItems
[a
].ControlType
= TGUISwitch
then
1504 w
:= w
+(FItems
[a
].Control
as TGUISwitch
).GetWidth
1505 else if FItems
[a
].ControlType
= TGUIEdit
then
1506 w
:= w
+(FItems
[a
].Control
as TGUIEdit
).GetWidth
1507 else if FItems
[a
].ControlType
= TGUIKeyRead
then
1508 w
:= w
+(FItems
[a
].Control
as TGUIKeyRead
).GetWidth
1509 else if (FItems
[a
].ControlType
= TGUIListBox
) then
1510 w
:= w
+(FItems
[a
].Control
as TGUIListBox
).GetWidth
1511 else if (FItems
[a
].ControlType
= TGUIFileListBox
) then
1512 w
:= w
+(FItems
[a
].Control
as TGUIFileListBox
).GetWidth
1513 else if FItems
[a
].ControlType
= TGUIMemo
then
1514 w
:= w
+(FItems
[a
].Control
as TGUIMemo
).GetWidth
;
1517 tx
:= Min(tx
, (gScreenWidth
div 2)-(w
div 2));
1522 for a
:= 0 to High(FItems
) do
1525 if (Text <> nil) and (Control
= nil) then Continue
;
1528 if Text <> nil then w
:= tx
+Text.GetWidth
;
1530 if w
> cx
then cx
:= w
;
1533 cx
:= cx
+MENU_HSPACE
;
1535 h
:= FHeader
.GetHeight
*2+MENU_VSPACE
*(Length(FItems
)-1);
1537 for a
:= 0 to High(FItems
) do
1540 if (ControlType
= TGUIListBox
) or (ControlType
= TGUIFileListBox
) then
1541 h
:= h
+(FItems
[a
].Control
as TGUIListBox
).GetHeight()
1543 h
:= h
+e_CharFont_GetMaxHeight(FFontID
);
1546 h
:= (gScreenHeight
div 2)-(h
div 2);
1550 FX
:= (gScreenWidth
div 2)-(GetWidth
div 2);
1553 Inc(h
, GetHeight
*2);
1556 for a
:= 0 to High(FItems
) do
1566 if Control
<> nil then
1579 if (ControlType
= TGUIListBox
) or (ControlType
= TGUIFileListBox
) then
1580 Inc(h
, (Control
as TGUIListBox
).GetHeight
+MENU_VSPACE
)
1581 else if ControlType
= TGUIMemo
then
1582 Inc(h
, (Control
as TGUIMemo
).GetHeight
+MENU_VSPACE
)
1584 Inc(h
, e_CharFont_GetMaxHeight(FFontID
)+MENU_VSPACE
);
1588 function TGUIMenu
.AddScroll(fText
: string): TGUIScroll
;
1595 Control
:= TGUIScroll
.Create();
1597 Text := TGUILabel
.Create(fText
, FFontID
);
1600 FColor
:= MENU_ITEMSTEXT_COLOR
;
1603 ControlType
:= TGUIScroll
;
1605 Result
:= (Control
as TGUIScroll
);
1608 if FIndex
= -1 then FIndex
:= i
;
1613 function TGUIMenu
.AddSwitch(fText
: string): TGUISwitch
;
1620 Control
:= TGUISwitch
.Create(FFontID
);
1621 (Control
as TGUISwitch
).FColor
:= MENU_ITEMSCTRL_COLOR
;
1623 Text := TGUILabel
.Create(fText
, FFontID
);
1626 FColor
:= MENU_ITEMSTEXT_COLOR
;
1629 ControlType
:= TGUISwitch
;
1631 Result
:= (Control
as TGUISwitch
);
1634 if FIndex
= -1 then FIndex
:= i
;
1639 function TGUIMenu
.AddEdit(fText
: string): TGUIEdit
;
1646 Control
:= TGUIEdit
.Create(FFontID
);
1647 with Control
as TGUIEdit
do
1649 FWindow
:= Self
.FWindow
;
1650 FColor
:= MENU_ITEMSCTRL_COLOR
;
1653 if fText
= '' then Text := nil else
1655 Text := TGUILabel
.Create(fText
, FFontID
);
1656 Text.FColor
:= MENU_ITEMSTEXT_COLOR
;
1659 ControlType
:= TGUIEdit
;
1661 Result
:= (Control
as TGUIEdit
);
1664 if FIndex
= -1 then FIndex
:= i
;
1669 procedure TGUIMenu
.Update
;
1675 if FCounter
= 0 then FCounter
:= MENU_MARKERDELAY
else Dec(FCounter
);
1677 if FItems
<> nil then
1678 for a
:= 0 to High(FItems
) do
1679 if FItems
[a
].Control
<> nil then
1680 (FItems
[a
].Control
as FItems
[a
].ControlType
).Update
;
1683 function TGUIMenu
.AddKeyRead(fText
: string): TGUIKeyRead
;
1690 Control
:= TGUIKeyRead
.Create(FFontID
);
1691 with Control
as TGUIKeyRead
do
1693 FWindow
:= Self
.FWindow
;
1694 FColor
:= MENU_ITEMSCTRL_COLOR
;
1697 Text := TGUILabel
.Create(fText
, FFontID
);
1700 FColor
:= MENU_ITEMSTEXT_COLOR
;
1703 ControlType
:= TGUIKeyRead
;
1705 Result
:= (Control
as TGUIKeyRead
);
1708 if FIndex
= -1 then FIndex
:= i
;
1713 function TGUIMenu
.AddList(fText
: string; Width
, Height
: Word): TGUIListBox
;
1720 Control
:= TGUIListBox
.Create(FFontID
, Width
, Height
);
1721 with Control
as TGUIListBox
do
1723 FWindow
:= Self
.FWindow
;
1724 FActiveColor
:= MENU_ITEMSCTRL_COLOR
;
1725 FUnActiveColor
:= MENU_ITEMSTEXT_COLOR
;
1728 Text := TGUILabel
.Create(fText
, FFontID
);
1731 FColor
:= MENU_ITEMSTEXT_COLOR
;
1734 ControlType
:= TGUIListBox
;
1736 Result
:= (Control
as TGUIListBox
);
1739 if FIndex
= -1 then FIndex
:= i
;
1744 function TGUIMenu
.AddFileList(fText
: string; Width
, Height
: Word): TGUIFileListBox
;
1751 Control
:= TGUIFileListBox
.Create(FFontID
, Width
, Height
);
1752 with Control
as TGUIFileListBox
do
1754 FWindow
:= Self
.FWindow
;
1755 FActiveColor
:= MENU_ITEMSCTRL_COLOR
;
1756 FUnActiveColor
:= MENU_ITEMSTEXT_COLOR
;
1759 if fText
= '' then Text := nil else
1761 Text := TGUILabel
.Create(fText
, FFontID
);
1762 Text.FColor
:= MENU_ITEMSTEXT_COLOR
;
1765 ControlType
:= TGUIFileListBox
;
1767 Result
:= (Control
as TGUIFileListBox
);
1770 if FIndex
= -1 then FIndex
:= i
;
1775 function TGUIMenu
.AddLabel(fText
: string): TGUILabel
;
1782 Control
:= TGUILabel
.Create('', FFontID
);
1783 with Control
as TGUILabel
do
1785 FWindow
:= Self
.FWindow
;
1786 FColor
:= MENU_ITEMSCTRL_COLOR
;
1789 Text := TGUILabel
.Create(fText
, FFontID
);
1792 FColor
:= MENU_ITEMSTEXT_COLOR
;
1795 ControlType
:= TGUILabel
;
1797 Result
:= (Control
as TGUILabel
);
1800 if FIndex
= -1 then FIndex
:= i
;
1805 function TGUIMenu
.AddMemo(fText
: string; Width
, Height
: Word): TGUIMemo
;
1812 Control
:= TGUIMemo
.Create(FFontID
, Width
, Height
);
1813 with Control
as TGUIMemo
do
1815 FWindow
:= Self
.FWindow
;
1816 FColor
:= MENU_ITEMSTEXT_COLOR
;
1819 if fText
= '' then Text := nil else
1821 Text := TGUILabel
.Create(fText
, FFontID
);
1822 Text.FColor
:= MENU_ITEMSTEXT_COLOR
;
1825 ControlType
:= TGUIMemo
;
1827 Result
:= (Control
as TGUIMemo
);
1830 if FIndex
= -1 then FIndex
:= i
;
1835 procedure TGUIMenu
.UpdateIndex();
1843 if (FIndex
< 0) or (FIndex
> High(FItems
)) then
1849 if FItems
[FIndex
].Control
.Enabled
then
1858 constructor TGUIScroll
.Create
;
1863 FOnChangeEvent
:= nil;
1865 g_Texture_Get(SCROLL_LEFT
, FLeftID
);
1866 g_Texture_Get(SCROLL_RIGHT
, FRightID
);
1867 g_Texture_Get(SCROLL_MIDDLE
, FMiddleID
);
1868 g_Texture_Get(SCROLL_MARKER
, FMarkerID
);
1871 procedure TGUIScroll
.Draw
;
1877 e_Draw(FLeftID
, FX
, FY
, 0, True, False);
1878 e_Draw(FRightID
, FX
+8+(FMax
+1)*8, FY
, 0, True, False);
1880 for a
:= 0 to FMax
do
1881 e_Draw(FMiddleID
, FX
+8+a
*8, FY
, 0, True, False);
1883 e_Draw(FMarkerID
, FX
+8+FValue
*8, FY
, 0, True, False);
1886 procedure TGUIScroll
.FSetValue(a
: Integer);
1888 if a
> FMax
then FValue
:= FMax
else FValue
:= a
;
1891 function TGUIScroll
.GetWidth
: Word;
1893 Result
:= 16+(FMax
+1)*8;
1896 procedure TGUIScroll
.OnMessage(var Msg
: TMessage
);
1898 if not FEnabled
then Exit
;
1910 g_Sound_PlayEx(SCROLL_SUBSOUND
);
1911 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
1913 IK_RIGHT
, IK_KPRIGHT
:
1914 if FValue
< FMax
then
1917 g_Sound_PlayEx(SCROLL_ADDSOUND
);
1918 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
1925 procedure TGUIScroll
.Update
;
1933 procedure TGUISwitch
.AddItem(Item
: string);
1935 SetLength(FItems
, Length(FItems
)+1);
1936 FItems
[High(FItems
)] := Item
;
1938 if FIndex
= -1 then FIndex
:= 0;
1941 constructor TGUISwitch
.Create(FontID
: DWORD
);
1947 FFont
:= TFont
.Create(FontID
, FONT_CHAR
);
1950 procedure TGUISwitch
.Draw
;
1954 FFont
.Draw(FX
, FY
, FItems
[FIndex
], FColor
.R
, FColor
.G
, FColor
.B
);
1957 function TGUISwitch
.GetText
: string;
1959 if FIndex
<> -1 then Result
:= FItems
[FIndex
]
1963 function TGUISwitch
.GetWidth
: Word;
1970 if FItems
= nil then Exit
;
1972 for a
:= 0 to High(FItems
) do
1974 FFont
.GetTextSize(FItems
[a
], w
, h
);
1975 if w
> Result
then Result
:= w
;
1979 procedure TGUISwitch
.OnMessage(var Msg
: TMessage
);
1981 if not FEnabled
then Exit
;
1985 if FItems
= nil then Exit
;
1990 IK_RETURN
, IK_RIGHT
, IK_KPRETURN
, IK_KPRIGHT
:
1992 if FIndex
< High(FItems
) then
1997 if @FOnChangeEvent
<> nil then
1998 FOnChangeEvent(Self
);
2006 FIndex
:= High(FItems
);
2008 if @FOnChangeEvent
<> nil then
2009 FOnChangeEvent(Self
);
2015 procedure TGUISwitch
.Update
;
2023 constructor TGUIEdit
.Create(FontID
: DWORD
);
2027 FFont
:= TFont
.Create(FontID
, FONT_CHAR
);
2032 g_Texture_Get(EDIT_LEFT
, FLeftID
);
2033 g_Texture_Get(EDIT_RIGHT
, FRightID
);
2034 g_Texture_Get(EDIT_MIDDLE
, FMiddleID
);
2037 procedure TGUIEdit
.Draw
;
2043 e_Draw(FLeftID
, FX
, FY
, 0, True, False);
2044 e_Draw(FRightID
, FX
+8+FWidth
*16, FY
, 0, True, False);
2046 for c
:= 0 to FWidth
-1 do
2047 e_Draw(FMiddleID
, FX
+8+c
*16, FY
, 0, True, False);
2049 FFont
.Draw(FX
+8, FY
, FText
, FColor
.R
, FColor
.G
, FColor
.B
);
2051 if FWindow
.FActiveControl
= Self
then
2053 FFont
.GetTextSize(Copy(FText
, 1, FCaretPos
), w
, h
);
2054 h
:= e_CharFont_GetMaxHeight(FFont
.ID
);
2055 e_DrawLine(2, FX
+8+w
, FY
+h
-3, FX
+8+w
+EDIT_CURSORLEN
, FY
+h
-3,
2056 EDIT_CURSORCOLOR
.R
, EDIT_CURSORCOLOR
.G
, EDIT_CURSORCOLOR
.B
);
2060 function TGUIEdit
.GetWidth
: Word;
2062 Result
:= 16+FWidth
*16;
2065 procedure TGUIEdit
.OnMessage(var Msg
: TMessage
);
2067 if not FEnabled
then Exit
;
2076 if (wParam
in [48..57]) and (Chr(wParam
) <> '`') then
2077 if Length(Text) < FMaxLength
then
2079 Insert(Chr(wParam
), FText
, FCaretPos
+ 1);
2085 if (wParam
in [32..255]) and (Chr(wParam
) <> '`') then
2086 if Length(Text) < FMaxLength
then
2088 Insert(Chr(wParam
), FText
, FCaretPos
+ 1);
2096 Delete(FText
, FCaretPos
, 1);
2097 if FCaretPos
> 0 then Dec(FCaretPos
);
2099 IK_DELETE
: Delete(FText
, FCaretPos
+ 1, 1);
2100 IK_END
, IK_KPEND
: FCaretPos
:= Length(FText
);
2101 IK_HOME
, IK_KPHOME
: FCaretPos
:= 0;
2102 IK_LEFT
, IK_KPLEFT
: if FCaretPos
> 0 then Dec(FCaretPos
);
2103 IK_RIGHT
, IK_KPRIGHT
: if FCaretPos
< Length(FText
) then Inc(FCaretPos
);
2104 IK_RETURN
, IK_KPRETURN
:
2107 if FActiveControl
<> Self
then
2110 if @FOnEnterEvent
<> nil then FOnEnterEvent(Self
);
2114 if FDefControl
<> '' then SetActive(GetControl(FDefControl
))
2115 else SetActive(nil);
2116 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2123 procedure TGUIEdit
.SetText(Text: string);
2125 if Length(Text) > FMaxLength
then SetLength(Text, FMaxLength
);
2127 FCaretPos
:= Length(FText
);
2130 procedure TGUIEdit
.Update
;
2137 constructor TGUIKeyRead
.Create(FontID
: DWORD
);
2141 FFont
:= TFont
.Create(FontID
, FONT_CHAR
);
2144 procedure TGUIKeyRead
.Draw
;
2148 FFont
.Draw(FX
, FY
, IfThen(FIsQuery
, KEYREAD_QUERY
, IfThen(FKey
<> 0, e_KeyNames
[FKey
], KEYREAD_CLEAR
)),
2149 FColor
.R
, FColor
.G
, FColor
.B
);
2152 function TGUIKeyRead
.GetWidth
: Word;
2159 for a
:= 0 to 255 do
2161 FFont
.GetTextSize(e_KeyNames
[a
], w
, h
);
2162 Result
:= Max(Result
, w
);
2165 FFont
.GetTextSize(KEYREAD_QUERY
, w
, h
);
2166 if w
> Result
then Result
:= w
;
2168 FFont
.GetTextSize(KEYREAD_CLEAR
, w
, h
);
2169 if w
> Result
then Result
:= w
;
2172 procedure TGUIKeyRead
.OnMessage(var Msg
: TMessage
);
2176 if not FEnabled
then
2187 if FDefControl
<> '' then
2188 SetActive(GetControl(FDefControl
))
2194 IK_RETURN
, IK_KPRETURN
:
2196 if not FIsQuery
then
2199 if FActiveControl
<> Self
then
2206 FKey
:= IK_ENTER
; // <Enter>
2210 if FDefControl
<> '' then
2211 SetActive(GetControl(FDefControl
))
2219 if FIsQuery
and (wParam
<> IK_ENTER
) and (wParam
<> IK_KPRETURN
) then // Not <Enter
2221 if e_KeyNames
[wParam
] <> '' then
2226 if FDefControl
<> '' then
2227 SetActive(GetControl(FDefControl
))
2236 constructor TGUIModelView
.Create
;
2243 destructor TGUIModelView
.Destroy
;
2250 procedure TGUIModelView
.Draw
;
2254 DrawBox(FX
, FY
, 4, 4);
2256 if FModel
<> nil then FModel
.Draw(FX
+4, FY
+4);
2259 procedure TGUIModelView
.NextAnim();
2261 if FModel
= nil then
2264 if FModel
.Animation
< A_PAIN
then
2265 FModel
.ChangeAnimation(FModel
.Animation
+1, True)
2267 FModel
.ChangeAnimation(A_STAND
, True);
2270 procedure TGUIModelView
.NextWeapon();
2272 if FModel
= nil then
2275 if FModel
.Weapon
< WEAPON_SUPERPULEMET
then
2276 FModel
.SetWeapon(FModel
.Weapon
+1)
2278 FModel
.SetWeapon(WEAPON_KASTET
);
2281 procedure TGUIModelView
.OnMessage(var Msg
: TMessage
);
2287 procedure TGUIModelView
.SetColor(Red
, Green
, Blue
: Byte);
2289 if FModel
<> nil then FModel
.SetColor(Red
, Green
, Blue
);
2292 procedure TGUIModelView
.SetModel(ModelName
: string);
2296 FModel
:= g_PlayerModel_Get(ModelName
);
2299 procedure TGUIModelView
.Update
;
2306 if FModel
<> nil then FModel
.Update
;
2311 constructor TGUIMapPreview
.Create();
2317 destructor TGUIMapPreview
.Destroy();
2323 procedure TGUIMapPreview
.Draw();
2330 DrawBox(FX
, FY
, MAPPREVIEW_WIDTH
, MAPPREVIEW_HEIGHT
);
2332 if (FMapSize
.X
<= 0) or (FMapSize
.Y
<= 0) then
2335 e_DrawFillQuad(FX
+4, FY
+4,
2336 FX
+4 + Trunc(FMapSize
.X
/ FScale
) - 1,
2337 FY
+4 + Trunc(FMapSize
.Y
/ FScale
) - 1,
2340 if FMapData
<> nil then
2341 for a
:= 0 to High(FMapData
) do
2344 if X1
> MAPPREVIEW_WIDTH
*16 then Continue
;
2345 if Y1
> MAPPREVIEW_HEIGHT
*16 then Continue
;
2347 if X2
< 0 then Continue
;
2348 if Y2
< 0 then Continue
;
2350 if X2
> MAPPREVIEW_WIDTH
*16 then X2
:= MAPPREVIEW_WIDTH
*16;
2351 if Y2
> MAPPREVIEW_HEIGHT
*16 then Y2
:= MAPPREVIEW_HEIGHT
*16;
2353 if X1
< 0 then X1
:= 0;
2354 if Y1
< 0 then Y1
:= 0;
2395 if ((X2
-X1
) > 0) and ((Y2
-Y1
) > 0) then
2396 e_DrawFillQuad(FX
+4 + X1
, FY
+4 + Y1
,
2397 FX
+4 + X2
- 1, FY
+4 + Y2
- 1, r
, g
, b
, 0);
2401 procedure TGUIMapPreview
.OnMessage(var Msg
: TMessage
);
2407 procedure TGUIMapPreview
.SetMap(Res
: string);
2410 MapReader
: TMapReader_1
;
2411 panels
: TPanelsRec1Array
;
2412 header
: TMapHeaderRec_1
;
2414 FileName
, SectionName
, ResName
: string;
2419 g_ProcessResourceStr(Res
, FileName
, SectionName
, ResName
);
2421 WAD
:= TWADEditor_1
.Create();
2422 if not WAD
.ReadFile(FileName
) then
2428 if not WAD
.GetResource('', ResName
, Data
, Len
) then
2436 MapReader
:= TMapReader_1
.Create();
2438 if not MapReader
.LoadMap(Data
) then
2451 panels
:= MapReader
.GetPanels();
2452 header
:= MapReader
.GetMapHeader();
2454 FMapSize
.X
:= header
.Width
div 16;
2455 FMapSize
.Y
:= header
.Height
div 16;
2457 rX
:= Ceil(header
.Width
/ (MAPPREVIEW_WIDTH
*256.0));
2458 rY
:= Ceil(header
.Height
/ (MAPPREVIEW_HEIGHT
*256.0));
2459 FScale
:= max(rX
, rY
);
2463 if panels
<> nil then
2464 for a
:= 0 to High(panels
) do
2465 if WordBool(panels
[a
].PanelType
and (PANEL_WALL
or PANEL_CLOSEDOOR
or
2466 PANEL_STEP
or PANEL_WATER
or
2467 PANEL_ACID1
or PANEL_ACID2
)) then
2469 SetLength(FMapData
, Length(FMapData
)+1);
2470 with FMapData
[High(FMapData
)] do
2472 X1
:= panels
[a
].X
div 16;
2473 Y1
:= panels
[a
].Y
div 16;
2475 X2
:= (panels
[a
].X
+ panels
[a
].Width
) div 16;
2476 Y2
:= (panels
[a
].Y
+ panels
[a
].Height
) div 16;
2478 X1
:= Trunc(X1
/FScale
+ 0.5);
2479 Y1
:= Trunc(Y1
/FScale
+ 0.5);
2480 X2
:= Trunc(X2
/FScale
+ 0.5);
2481 Y2
:= Trunc(Y2
/FScale
+ 0.5);
2483 if (X1
<> X2
) or (Y1
<> Y2
) then
2491 PanelType
:= panels
[a
].PanelType
;
2500 procedure TGUIMapPreview
.ClearMap();
2502 SetLength(FMapData
, 0);
2509 procedure TGUIMapPreview
.Update();
2515 function TGUIMapPreview
.GetScaleStr(): String;
2517 if FScale
> 0.0 then
2519 Result
:= FloatToStrF(FScale
*16.0, ffFixed
, 3, 3);
2520 while (Result
[Length(Result
)] = '0') do
2521 Delete(Result
, Length(Result
), 1);
2522 if (Result
[Length(Result
)] = ',') or (Result
[Length(Result
)] = '.') then
2523 Delete(Result
, Length(Result
), 1);
2524 Result
:= '1 : ' + Result
;
2532 procedure TGUIListBox
.AddItem(Item
: string);
2534 SetLength(FItems
, Length(FItems
)+1);
2535 FItems
[High(FItems
)] := Item
;
2537 if FSort
then g_Basic
.Sort(FItems
);
2540 procedure TGUIListBox
.Clear();
2548 constructor TGUIListBox
.Create(FontID
: DWORD
; Width
, Height
: Word);
2552 FFont
:= TFont
.Create(FontID
, FONT_CHAR
);
2557 FOnChangeEvent
:= nil;
2559 FDrawScroll
:= True;
2562 procedure TGUIListBox
.Draw
;
2570 if FDrawBack
then DrawBox(FX
, FY
, FWidth
+1, FHeight
);
2572 DrawScroll(FX
+4+FWidth
*16, FY
+4, FHeight
, (FStartLine
> 0) and (FItems
<> nil),
2573 (FStartLine
+FHeight
-1 < High(FItems
)) and (FItems
<> nil));
2575 if FItems
<> nil then
2576 for a
:= FStartLine
to Min(High(FItems
), FStartLine
+FHeight
-1) do
2580 FFont
.GetTextSize(s
, w2
, h2
);
2581 while (Length(s
) > 0) and (w2
> FWidth
*16) do
2583 SetLength(s
, Length(s
)-1);
2584 FFont
.GetTextSize(s
, w2
, h2
);
2588 FFont
.Draw(FX
+4, FY
+4+(a
-FStartLine
)*16, s
, FActiveColor
.R
, FActiveColor
.G
, FActiveColor
.B
)
2590 FFont
.Draw(FX
+4, FY
+4+(a
-FStartLine
)*16, s
, FUnActiveColor
.R
, FUnActiveColor
.G
, FUnActiveColor
.B
);
2594 function TGUIListBox
.GetHeight
: Word;
2596 Result
:= 8+FHeight
*16;
2599 function TGUIListBox
.GetWidth
: Word;
2601 Result
:= 8+(FWidth
+1)*16;
2604 procedure TGUIListBox
.OnMessage(var Msg
: TMessage
);
2608 if not FEnabled
then Exit
;
2612 if FItems
= nil then Exit
;
2625 FIndex
:= High(FItems
);
2626 FStartLine
:= Max(High(FItems
)-FHeight
+1, 0);
2628 IK_UP
, IK_LEFT
, IK_KPUP
, IK_KPLEFT
:
2632 if FIndex
< FStartLine
then Dec(FStartLine
);
2633 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2635 IK_DOWN
, IK_RIGHT
, IK_KPDOWN
, IK_KPRIGHT
:
2636 if FIndex
< High(FItems
) then
2639 if FIndex
> FStartLine
+FHeight
-1 then Inc(FStartLine
);
2640 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2642 IK_RETURN
, IK_KPRETURN
:
2645 if FActiveControl
<> Self
then SetActive(Self
)
2647 if FDefControl
<> '' then SetActive(GetControl(FDefControl
))
2648 else SetActive(nil);
2652 for a
:= 0 to High(FItems
) do
2653 if (Length(FItems
[a
]) > 0) and (LowerCase(FItems
[a
][1]) = LowerCase(Chr(wParam
))) then
2656 FStartLine
:= Min(Max(FIndex
-1, 0), Length(FItems
)-FHeight
);
2657 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2663 function TGUIListBox
.SelectedItem(): String;
2667 if (FIndex
< 0) or (FItems
= nil) or
2668 (FIndex
> High(FItems
)) then
2671 Result
:= FItems
[FIndex
];
2674 procedure TGUIListBox
.FSetItems(Items
: SArray
);
2676 if FItems
<> nil then
2684 if FSort
then g_Basic
.Sort(FItems
);
2687 procedure TGUIListBox
.SelectItem(Item
: String);
2691 if FItems
= nil then
2695 Item
:= LowerCase(Item
);
2697 for a
:= 0 to High(FItems
) do
2698 if LowerCase(FItems
[a
]) = Item
then
2704 if FIndex
< FHeight
then
2707 FStartLine
:= Min(FIndex
, Length(FItems
)-FHeight
);
2710 procedure TGUIListBox
.FSetIndex(aIndex
: Integer);
2712 if FItems
= nil then
2715 if (aIndex
< 0) or (aIndex
> High(FItems
)) then
2720 if FIndex
<= FHeight
then
2723 FStartLine
:= Min(FIndex
, Length(FItems
)-FHeight
);
2728 procedure TGUIFileListBox
.OnMessage(var Msg
: TMessage
);
2732 if not FEnabled
then
2735 if FItems
= nil then
2746 if @FOnChangeEvent
<> nil then
2747 FOnChangeEvent(Self
);
2752 FIndex
:= High(FItems
);
2753 FStartLine
:= Max(High(FItems
)-FHeight
+1, 0);
2754 if @FOnChangeEvent
<> nil then
2755 FOnChangeEvent(Self
);
2758 IK_PAGEUP
, IK_KPPAGEUP
:
2760 if FIndex
> FHeight
then
2761 FIndex
:= FIndex
-FHeight
2765 if FStartLine
> FHeight
then
2766 FStartLine
:= FStartLine
-FHeight
2771 IK_PAGEDN
, IK_KPPAGEDN
:
2773 if FIndex
< High(FItems
)-FHeight
then
2774 FIndex
:= FIndex
+FHeight
2776 FIndex
:= High(FItems
);
2778 if FStartLine
< High(FItems
)-FHeight
then
2779 FStartLine
:= FStartLine
+FHeight
2781 FStartLine
:= High(FItems
)-FHeight
+1;
2784 IK_UP
, IK_LEFT
, IK_KPUP
, IK_KPLEFT
:
2788 if FIndex
< FStartLine
then
2790 if @FOnChangeEvent
<> nil then
2791 FOnChangeEvent(Self
);
2794 IK_DOWN
, IK_RIGHT
, IK_KPDOWN
, IK_KPRIGHT
:
2795 if FIndex
< High(FItems
) then
2798 if FIndex
> FStartLine
+FHeight
-1 then
2800 if @FOnChangeEvent
<> nil then
2801 FOnChangeEvent(Self
);
2804 IK_RETURN
, IK_KPRETURN
:
2807 if FActiveControl
<> Self
then
2811 if FItems
[FIndex
][1] = #29 then // Ïàïêà
2813 OpenDir(FPath
+Copy(FItems
[FIndex
], 2, 255));
2818 if FDefControl
<> '' then
2819 SetActive(GetControl(FDefControl
))
2827 for a
:= 0 to High(FItems
) do
2828 if ( (Length(FItems
[a
]) > 0) and
2829 (LowerCase(FItems
[a
][1]) = LowerCase(Chr(wParam
))) ) or
2830 ( (Length(FItems
[a
]) > 1) and
2831 (FItems
[a
][1] = #29) and // Ïàïêà
2832 (LowerCase(FItems
[a
][2]) = LowerCase(Chr(wParam
))) ) then
2835 FStartLine
:= Min(Max(FIndex
-1, 0), Length(FItems
)-FHeight
);
2836 if @FOnChangeEvent
<> nil then
2837 FOnChangeEvent(Self
);
2843 procedure TGUIFileListBox
.OpenDir(path
: String);
2850 path
:= IncludeTrailingPathDelimiter(path
);
2851 path
:= ExpandFileName(path
);
2856 if FindFirst(path
+'*', faDirectory
, SR
) = 0 then
2858 if not LongBool(SR
.Attr
and faDirectory
) then
2860 if (SR
.Name
= '.') or
2861 ((SR
.Name
= '..') and (path
= ExpandFileName(FBasePath
))) then
2864 AddItem(#1 + SR
.Name
);
2865 until FindNext(SR
) <> 0;
2871 if FindFirst(path
+FFileMask
, faAnyFile
, SR
) = 0 then
2874 until FindNext(SR
) <> 0;
2878 for i
:= 0 to High(FItems
) do
2879 if FItems
[i
][1] = #1 then
2880 FItems
[i
][1] := #29;
2885 procedure TGUIFileListBox
.SetBase(path
: String);
2891 function TGUIFileListBox
.SelectedItem(): String;
2895 if (FIndex
= -1) or (FItems
= nil) or
2896 (FIndex
> High(FItems
)) or
2897 (FItems
[FIndex
][1] = '/') or
2898 (FItems
[FIndex
][1] = '\') then
2901 Result
:= FPath
+ FItems
[FIndex
];
2904 procedure TGUIFileListBox
.UpdateFileList();
2908 if (FIndex
= -1) or (FItems
= nil) or
2909 (FIndex
> High(FItems
)) or
2910 (FItems
[FIndex
][1] = '/') or
2911 (FItems
[FIndex
][1] = '\') then
2914 fn
:= FItems
[FIndex
];
2924 procedure TGUIMemo
.Clear
;
2930 constructor TGUIMemo
.Create(FontID
: DWORD
; Width
, Height
: Word);
2934 FFont
:= TFont
.Create(FontID
, FONT_CHAR
);
2939 FDrawScroll
:= True;
2942 procedure TGUIMemo
.Draw
;
2948 if FDrawBack
then DrawBox(FX
, FY
, FWidth
+1, FHeight
);
2950 DrawScroll(FX
+4+FWidth
*16, FY
+4, FHeight
, (FStartLine
> 0) and (FLines
<> nil),
2951 (FStartLine
+FHeight
-1 < High(FLines
)) and (FLines
<> nil));
2953 if FLines
<> nil then
2954 for a
:= FStartLine
to Min(High(FLines
), FStartLine
+FHeight
-1) do
2955 FFont
.Draw(FX
+4, FY
+4+(a
-FStartLine
)*16, FLines
[a
], FColor
.R
, FColor
.G
, FColor
.B
);
2958 function TGUIMemo
.GetHeight
: Word;
2960 Result
:= 8+FHeight
*16;
2963 function TGUIMemo
.GetWidth
: Word;
2965 Result
:= 8+(FWidth
+1)*16;
2968 procedure TGUIMemo
.OnMessage(var Msg
: TMessage
);
2970 if not FEnabled
then Exit
;
2974 if FLines
= nil then Exit
;
2980 IK_UP
, IK_LEFT
, IK_KPUP
, IK_KPLEFT
:
2981 if FStartLine
> 0 then
2983 IK_DOWN
, IK_RIGHT
, IK_KPDOWN
, IK_KPRIGHT
:
2984 if FStartLine
< Length(FLines
)-FHeight
then
2986 IK_RETURN
, IK_KPRETURN
:
2989 if FActiveControl
<> Self
then
2995 if FDefControl
<> '' then SetActive(GetControl(FDefControl
))
2996 else SetActive(nil);
3002 procedure TGUIMemo
.SetText(Text: string);
3005 FLines
:= GetLines(Text, FFont
.ID
, FWidth
*16);
3010 procedure TGUIimage
.ClearImage();
3012 if FImageRes
= '' then Exit
;
3014 g_Texture_Delete(FImageRes
);
3018 constructor TGUIimage
.Create();
3025 destructor TGUIimage
.Destroy();
3030 procedure TGUIimage
.Draw();
3036 if FImageRes
= '' then
3038 if g_Texture_Get(FDefaultRes
, ID
) then e_Draw(ID
, FX
, FY
, 0, True, False);
3041 if g_Texture_Get(FImageRes
, ID
) then e_Draw(ID
, FX
, FY
, 0, True, False);
3044 procedure TGUIimage
.OnMessage(var Msg
: TMessage
);
3049 procedure TGUIimage
.SetImage(Res
: string);
3053 if g_Texture_CreateWADEx(Res
, Res
) then FImageRes
:= Res
;
3056 procedure TGUIimage
.Update();