6 e_graphics
, e_input
, g_playermodel
, g_basic
, MAPSTRUCT
, wadreader
;
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
);
104 procedure OnMessage(var Msg
: TMessage
); virtual;
105 procedure Update
; virtual;
106 procedure Draw
; virtual;
107 property X
: Integer read FX write FX
;
108 property Y
: Integer read FY write FY
;
109 property Enabled
: Boolean read FEnabled write FEnabled
;
110 property Name
: string read FName write FName
;
111 property UserData
: Pointer read FUserData write FUserData
;
116 FActiveControl
: TGUIControl
;
118 FPrevWindow
: TGUIWindow
;
120 FBackTexture
: string;
121 FMainWindow
: Boolean;
122 FOnKeyDown
: TOnKeyDownEvent
;
123 FOnKeyDownEx
: TOnKeyDownEventEx
;
124 FOnCloseEvent
: TOnCloseEvent
;
125 FOnShowEvent
: TOnShowEvent
;
128 Childs
: array of TGUIControl
;
129 constructor Create(Name
: string);
130 destructor Destroy
; override;
131 function AddChild(Child
: TGUIControl
): TGUIControl
;
132 procedure OnMessage(var Msg
: TMessage
);
135 procedure SetActive(Control
: TGUIControl
);
136 function GetControl(Name
: string): TGUIControl
;
137 property OnKeyDown
: TOnKeyDownEvent read FOnKeyDown write FOnKeyDown
;
138 property OnKeyDownEx
: TOnKeyDownEventEx read FOnKeyDownEx write FOnKeyDownEx
;
139 property OnClose
: TOnCloseEvent read FOnCloseEvent write FOnCloseEvent
;
140 property OnShow
: TOnShowEvent read FOnShowEvent write FOnShowEvent
;
141 property Name
: string read FName
;
142 property DefControl
: string read FDefControl write FDefControl
;
143 property BackTexture
: string read FBackTexture write FBackTexture
;
144 property MainWindow
: Boolean read FMainWindow write FMainWindow
;
145 property UserData
: Pointer read FUserData write FUserData
;
148 TGUITextButton
= class(TGUIControl
)
157 ProcEx
: procedure (sender
: TGUITextButton
);
158 constructor Create(Proc
: Pointer; FontID
: DWORD
; Text: string);
159 destructor Destroy(); override;
160 procedure OnMessage(var Msg
: TMessage
); override;
161 procedure Update(); override;
162 procedure Draw(); override;
163 function GetWidth(): Integer;
164 function GetHeight(): Integer;
165 procedure Click(Silent
: Boolean = False);
166 property Caption
: string read FText write FText
;
167 property Color
: TRGB read FColor write FColor
;
168 property Font
: TFont read FFont write FFont
;
169 property ShowWindow
: string read FShowWindow write FShowWindow
;
172 TGUILabel
= class(TGUIControl
)
178 FOnClickEvent
: TOnClickEvent
;
180 constructor Create(Text: string; FontID
: DWORD
);
181 procedure OnMessage(var Msg
: TMessage
); override;
182 procedure Draw
; override;
183 function GetWidth
: Integer;
184 function GetHeight
: Integer;
185 property OnClick
: TOnClickEvent read FOnClickEvent write FOnClickEvent
;
186 property FixedLength
: Word read FFixedLen write FFixedLen
;
187 property Text: string read FText write FText
;
188 property Color
: TRGB read FColor write FColor
;
189 property Font
: TFont read FFont write FFont
;
192 TGUIScroll
= class(TGUIControl
)
200 FOnChangeEvent
: TOnChangeEvent
;
201 procedure FSetValue(a
: Integer);
203 constructor Create();
204 procedure OnMessage(var Msg
: TMessage
); override;
205 procedure Update
; override;
206 procedure Draw
; override;
207 function GetWidth(): Word;
208 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
209 property Max
: Word read FMax write FMax
;
210 property Value
: Integer read FValue write FSetValue
;
213 TGUISwitch
= class(TGUIControl
)
216 FItems
: array of string;
219 FOnChangeEvent
: TOnChangeEvent
;
221 constructor Create(FontID
: DWORD
);
222 procedure OnMessage(var Msg
: TMessage
); override;
223 procedure AddItem(Item
: string);
224 procedure Update
; override;
225 procedure Draw
; override;
226 function GetWidth(): Word;
227 function GetText
: string;
228 property ItemIndex
: Integer read FIndex write FIndex
;
229 property Color
: TRGB read FColor write FColor
;
230 property Font
: TFont read FFont write FFont
;
231 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
234 TGUIEdit
= class(TGUIControl
)
242 FOnlyDigits
: Boolean;
246 FOnChangeEvent
: TOnChangeEvent
;
247 FOnEnterEvent
: TOnEnterEvent
;
248 procedure SetText(Text: string);
250 constructor Create(FontID
: DWORD
);
251 procedure OnMessage(var Msg
: TMessage
); override;
252 procedure Update
; override;
253 procedure Draw
; override;
254 function GetWidth(): Word;
255 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
256 property OnEnter
: TOnEnterEvent read FOnEnterEvent write FOnEnterEvent
;
257 property Width
: Word read FWidth write FWidth
;
258 property MaxLength
: Word read FMaxLength write FMaxLength
;
259 property OnlyDigits
: Boolean read FOnlyDigits write FOnlyDigits
;
260 property Text: string read FText write SetText
;
261 property Color
: TRGB read FColor write FColor
;
262 property Font
: TFont read FFont write FFont
;
265 TGUIKeyRead
= class(TGUIControl
)
272 constructor Create(FontID
: DWORD
);
273 procedure OnMessage(var Msg
: TMessage
); override;
274 procedure Draw
; override;
275 function GetWidth(): Word;
276 property Key
: Word read FKey write FKey
;
277 property Color
: TRGB read FColor write FColor
;
278 property Font
: TFont read FFont write FFont
;
281 TGUIModelView
= class(TGUIControl
)
283 FModel
: TPlayerModel
;
287 destructor Destroy
; override;
288 procedure OnMessage(var Msg
: TMessage
); override;
289 procedure SetModel(ModelName
: string);
290 procedure SetColor(Red
, Green
, Blue
: Byte);
291 procedure NextAnim();
292 procedure NextWeapon();
293 procedure Update
; override;
294 procedure Draw
; override;
295 property Model
: TPlayerModel read FModel
;
298 TPreviewPanel
= record
299 X1
, Y1
, X2
, Y2
: Integer;
303 TGUIMapPreview
= class(TGUIControl
)
305 FMapData
: array of TPreviewPanel
;
309 constructor Create();
310 destructor Destroy(); override;
311 procedure OnMessage(var Msg
: TMessage
); override;
312 procedure SetMap(Res
: string);
313 procedure ClearMap();
314 procedure Update(); override;
315 procedure Draw(); override;
316 function GetScaleStr
: String;
319 TGUIImage
= class(TGUIControl
)
324 constructor Create();
325 destructor Destroy(); override;
326 procedure OnMessage(var Msg
: TMessage
); override;
327 procedure SetImage(Res
: string);
328 procedure ClearImage();
329 procedure Update(); override;
330 procedure Draw(); override;
331 property DefaultRes
: string read FDefaultRes write FDefaultRes
;
334 TGUIListBox
= class(TGUIControl
)
338 FUnActiveColor
: TRGB
;
346 FDrawScroll
: Boolean;
347 FOnChangeEvent
: TOnChangeEvent
;
349 procedure FSetItems(Items
: SArray
);
350 procedure FSetIndex(aIndex
: Integer);
353 constructor Create(FontID
: DWORD
; Width
, Height
: Word);
354 procedure OnMessage(var Msg
: TMessage
); override;
355 procedure Draw(); override;
356 procedure AddItem(Item
: String);
357 procedure SelectItem(Item
: String);
359 function GetWidth(): Word;
360 function GetHeight(): Word;
361 function SelectedItem(): String;
363 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
364 property Sort
: Boolean read FSort write FSort
;
365 property ItemIndex
: Integer read FIndex write FSetIndex
;
366 property Items
: SArray read FItems write FSetItems
;
367 property DrawBack
: Boolean read FDrawBack write FDrawBack
;
368 property DrawScrollBar
: Boolean read FDrawScroll write FDrawScroll
;
369 property ActiveColor
: TRGB read FActiveColor write FActiveColor
;
370 property UnActiveColor
: TRGB read FUnActiveColor write FUnActiveColor
;
371 property Font
: TFont read FFont write FFont
;
374 TGUIFileListBox
= class (TGUIListBox
)
381 procedure OpenDir(path
: String);
384 procedure OnMessage(var Msg
: TMessage
); override;
385 procedure SetBase(path
: String);
386 function SelectedItem(): String;
387 procedure UpdateFileList();
389 property Dirs
: Boolean read FDirs write FDirs
;
390 property FileMask
: String read FFileMask write FFileMask
;
391 property Path
: String read FPath
;
394 TGUIMemo
= class(TGUIControl
)
403 FDrawScroll
: Boolean;
405 constructor Create(FontID
: DWORD
; Width
, Height
: Word);
406 procedure OnMessage(var Msg
: TMessage
); override;
407 procedure Draw
; override;
409 function GetWidth(): Word;
410 function GetHeight(): Word;
411 procedure SetText(Text: string);
412 property DrawBack
: Boolean read FDrawBack write FDrawBack
;
413 property DrawScrollBar
: Boolean read FDrawScroll write FDrawScroll
;
414 property Color
: TRGB read FColor write FColor
;
415 property Font
: TFont read FFont write FFont
;
418 TGUIMainMenu
= class(TGUIControl
)
420 FButtons
: array of TGUITextButton
;
428 constructor Create(FontID
: DWORD
; Header
: string);
429 destructor Destroy
; override;
430 procedure OnMessage(var Msg
: TMessage
); override;
431 function AddButton(fProc
: Pointer; Caption
: string; ShowWindow
: string = ''): TGUITextButton
;
432 function GetButton(Name
: string): TGUITextButton
;
433 procedure EnableButton(Name
: string; e
: Boolean);
434 procedure AddSpace();
435 procedure Update
; override;
436 procedure Draw
; override;
439 TControlType
= class of TGUIControl
;
441 PMenuItem
= ^TMenuItem
;
444 ControlType
: TControlType
;
445 Control
: TGUIControl
;
448 TGUIMenu
= class(TGUIControl
)
450 FItems
: array of TMenuItem
;
458 function NewItem(): Integer;
460 constructor Create(HeaderFont
, ItemsFont
: DWORD
; Header
: string);
461 destructor Destroy
; override;
462 procedure OnMessage(var Msg
: TMessage
); override;
463 procedure AddSpace();
464 procedure AddLine(fText
: string);
465 procedure AddText(fText
: string; MaxWidth
: Word);
466 function AddLabel(fText
: string): TGUILabel
;
467 function AddButton(Proc
: Pointer; fText
: string; _ShowWindow
: string = ''): TGUITextButton
;
468 function AddScroll(fText
: string): TGUIScroll
;
469 function AddSwitch(fText
: string): TGUISwitch
;
470 function AddEdit(fText
: string): TGUIEdit
;
471 function AddKeyRead(fText
: string): TGUIKeyRead
;
472 function AddList(fText
: string; Width
, Height
: Word): TGUIListBox
;
473 function AddFileList(fText
: string; Width
, Height
: Word): TGUIFileListBox
;
474 function AddMemo(fText
: string; Width
, Height
: Word): TGUIMemo
;
476 function GetControl(Name
: string): TGUIControl
;
477 function GetControlsText(Name
: string): TGUILabel
;
478 procedure Draw
; override;
479 procedure Update
; override;
480 procedure UpdateIndex();
481 property Align
: Boolean read FAlign write FAlign
;
482 property Left
: Integer read FLeft write FLeft
;
483 property YesNo
: Boolean read FYesNo write FYesNo
;
487 g_GUIWindows
: array of TGUIWindow
;
488 g_ActiveWindow
: TGUIWindow
= nil;
490 procedure g_GUI_Init();
491 function g_GUI_AddWindow(Window
: TGUIWindow
): TGUIWindow
;
492 function g_GUI_GetWindow(Name
: string): TGUIWindow
;
493 procedure g_GUI_ShowWindow(Name
: string);
494 procedure g_GUI_HideWindow(PlaySound
: Boolean = True);
495 function g_GUI_Destroy(): Boolean;
496 procedure g_GUI_SaveMenuPos();
497 procedure g_GUI_LoadMenuPos();
502 GL
, GLExt
, g_textures
, g_sound
, SysUtils
,
503 g_game
, Math
, StrUtils
, g_player
, g_options
, MAPREADER
,
504 g_map
, MAPDEF
, g_weapons
;
507 Box
: Array [0..8] of DWORD
;
508 Saved_Windows
: SArray
;
510 procedure g_GUI_Init();
512 g_Texture_Get(BOX1
, Box
[0]);
513 g_Texture_Get(BOX2
, Box
[1]);
514 g_Texture_Get(BOX3
, Box
[2]);
515 g_Texture_Get(BOX4
, Box
[3]);
516 g_Texture_Get(BOX5
, Box
[4]);
517 g_Texture_Get(BOX6
, Box
[5]);
518 g_Texture_Get(BOX7
, Box
[6]);
519 g_Texture_Get(BOX8
, Box
[7]);
520 g_Texture_Get(BOX9
, Box
[8]);
523 function g_GUI_Destroy(): Boolean;
527 Result
:= (Length(g_GUIWindows
) > 0);
529 for i
:= 0 to High(g_GUIWindows
) do
530 g_GUIWindows
[i
].Free();
533 g_ActiveWindow
:= nil;
536 function g_GUI_AddWindow(Window
: TGUIWindow
): TGUIWindow
;
538 SetLength(g_GUIWindows
, Length(g_GUIWindows
)+1);
539 g_GUIWindows
[High(g_GUIWindows
)] := Window
;
544 function g_GUI_GetWindow(Name
: string): TGUIWindow
;
550 if g_GUIWindows
<> nil then
551 for i
:= 0 to High(g_GUIWindows
) do
552 if g_GUIWindows
[i
].FName
= Name
then
554 Result
:= g_GUIWindows
[i
];
558 Assert(Result
<> nil, 'GUI_Window "'+Name
+'" not found');
561 procedure g_GUI_ShowWindow(Name
: string);
565 if g_GUIWindows
= nil then
568 for i
:= 0 to High(g_GUIWindows
) do
569 if g_GUIWindows
[i
].FName
= Name
then
571 g_GUIWindows
[i
].FPrevWindow
:= g_ActiveWindow
;
572 g_ActiveWindow
:= g_GUIWindows
[i
];
574 if g_ActiveWindow
.MainWindow
then
575 g_ActiveWindow
.FPrevWindow
:= nil;
577 if g_ActiveWindow
.FDefControl
<> '' then
578 g_ActiveWindow
.SetActive(g_ActiveWindow
.GetControl(g_ActiveWindow
.FDefControl
))
580 g_ActiveWindow
.SetActive(nil);
582 if @g_ActiveWindow
.FOnShowEvent
<> nil then
583 g_ActiveWindow
.FOnShowEvent();
589 procedure g_GUI_HideWindow(PlaySound
: Boolean = True);
591 if g_ActiveWindow
<> nil then
593 if @g_ActiveWindow
.OnClose
<> nil then
594 g_ActiveWindow
.OnClose();
595 g_ActiveWindow
:= g_ActiveWindow
.FPrevWindow
;
597 g_Sound_PlayEx(WINDOW_CLOSESOUND
);
601 procedure g_GUI_SaveMenuPos();
606 SetLength(Saved_Windows
, 0);
607 win
:= g_ActiveWindow
;
611 len
:= Length(Saved_Windows
);
612 SetLength(Saved_Windows
, len
+ 1);
614 Saved_Windows
[len
] := win
.Name
;
616 if win
.MainWindow
then
619 win
:= win
.FPrevWindow
;
623 procedure g_GUI_LoadMenuPos();
625 i
, j
, k
, len
: Integer;
628 g_ActiveWindow
:= nil;
629 len
:= Length(Saved_Windows
);
634 // Îêíî ñ ãëàâíûì ìåíþ:
635 g_GUI_ShowWindow(Saved_Windows
[len
-1]);
637 // Íå ïåðåêëþ÷èëîñü (èëè íåêóäà äàëüøå):
638 if (len
= 1) or (g_ActiveWindow
= nil) then
641 // Èùåì êíîïêè â îñòàëüíûõ îêíàõ:
642 for k
:= len
-1 downto 1 do
646 for i
:= 0 to Length(g_ActiveWindow
.Childs
)-1 do
648 if g_ActiveWindow
.Childs
[i
] is TGUIMainMenu
then
649 begin // GUI_MainMenu
650 with TGUIMainMenu(g_ActiveWindow
.Childs
[i
]) do
651 for j
:= 0 to Length(FButtons
)-1 do
652 if FButtons
[j
].ShowWindow
= Saved_Windows
[k
-1] then
654 FButtons
[j
].Click(True);
660 if g_ActiveWindow
.Childs
[i
] is TGUIMenu
then
661 with TGUIMenu(g_ActiveWindow
.Childs
[i
]) do
662 for j
:= 0 to Length(FItems
)-1 do
663 if FItems
[j
].ControlType
= TGUITextButton
then
664 if TGUITextButton(FItems
[j
].Control
).ShowWindow
= Saved_Windows
[k
-1] then
666 TGUITextButton(FItems
[j
].Control
).Click(True);
677 (g_ActiveWindow
.Name
= Saved_Windows
[k
]) then
682 procedure DrawBox(X
, Y
: Integer; Width
, Height
: Word);
684 e_Draw(Box
[0], X
, Y
, 0, False, False);
685 e_DrawFill(Box
[1], X
+4, Y
, Width
*4, 1, 0, False, False);
686 e_Draw(Box
[2], X
+4+Width
*16, Y
, 0, False, False);
687 e_DrawFill(Box
[3], X
, Y
+4, 1, Height
*4, 0, False, False);
688 e_DrawFill(Box
[4], X
+4, Y
+4, Width
, Height
, 0, False, False);
689 e_DrawFill(Box
[5], X
+4+Width
*16, Y
+4, 1, Height
*4, 0, False, False);
690 e_Draw(Box
[6], X
, Y
+4+Height
*16, 0, False, False);
691 e_DrawFill(Box
[7], X
+4, Y
+4+Height
*16, Width
*4, 1, 0, False, False);
692 e_Draw(Box
[8], X
+4+Width
*16, Y
+4+Height
*16, 0, False, False);
695 procedure DrawScroll(X
, Y
: Integer; Height
: Word; Up
, Down
: Boolean);
699 if Height
< 3 then Exit
;
702 g_Texture_Get(BSCROLL_UPA
, ID
)
704 g_Texture_Get(BSCROLL_UPU
, ID
);
705 e_Draw(ID
, X
, Y
, 0, False, False);
708 g_Texture_Get(BSCROLL_DOWNA
, ID
)
710 g_Texture_Get(BSCROLL_DOWNU
, ID
);
711 e_Draw(ID
, X
, Y
+(Height
-1)*16, 0, False, False);
713 g_Texture_Get(BSCROLL_MIDDLE
, ID
);
714 e_DrawFill(ID
, X
, Y
+16, 1, Height
-2, 0, False, False);
719 constructor TGUIWindow
.Create(Name
: string);
722 FActiveControl
:= nil;
726 FOnCloseEvent
:= nil;
730 destructor TGUIWindow
.Destroy
;
737 for i
:= 0 to High(Childs
) do
741 function TGUIWindow
.AddChild(Child
: TGUIControl
): TGUIControl
;
743 Child
.FWindow
:= Self
;
745 SetLength(Childs
, Length(Childs
) + 1);
746 Childs
[High(Childs
)] := Child
;
751 procedure TGUIWindow
.Update
;
755 for i
:= 0 to High(Childs
) do
756 if Childs
[i
] <> nil then Childs
[i
].Update
;
759 procedure TGUIWindow
.Draw
;
764 if FBackTexture
<> '' then
765 if g_Texture_Get(FBackTexture
, ID
) then
766 e_DrawSize(ID
, 0, 0, 0, False, False, gScreenWidth
, gScreenHeight
)
768 e_Clear(GL_COLOR_BUFFER_BIT
, 0.5, 0.5, 0.5);
770 for i
:= 0 to High(Childs
) do
771 if Childs
[i
] <> nil then Childs
[i
].Draw
;
774 procedure TGUIWindow
.OnMessage(var Msg
: TMessage
);
776 if FActiveControl
<> nil then FActiveControl
.OnMessage(Msg
);
777 if @FOnKeyDown
<> nil then FOnKeyDown(Msg
.wParam
);
778 if @FOnKeyDownEx
<> nil then FOnKeyDownEx(self
, Msg
.wParam
);
780 if Msg
.Msg
= WM_KEYDOWN
then
781 if Msg
.wParam
= IK_ESCAPE
then
788 procedure TGUIWindow
.SetActive(Control
: TGUIControl
);
790 FActiveControl
:= Control
;
793 function TGUIWindow
.GetControl(Name
: String): TGUIControl
;
799 if Childs
<> nil then
800 for i
:= 0 to High(Childs
) do
801 if Childs
[i
] <> nil then
802 if LowerCase(Childs
[i
].FName
) = LowerCase(Name
) then
808 Assert(Result
<> nil, 'Window Control "'+Name
+'" not Found!');
813 constructor TGUIControl
.Create();
821 procedure TGUIControl
.OnMessage(var Msg
: TMessage
);
827 procedure TGUIControl
.Update();
832 procedure TGUIControl
.Draw();
839 procedure TGUITextButton
.Click(Silent
: Boolean = False);
841 if (FSound
<> '') and (not Silent
) then g_Sound_PlayEx(FSound
);
843 if @Proc
<> nil then Proc();
844 if @ProcEx
<> nil then ProcEx(self
);
846 if FShowWindow
<> '' then g_GUI_ShowWindow(FShowWindow
);
849 constructor TGUITextButton
.Create(Proc
: Pointer; FontID
: DWORD
; Text: string);
856 FFont
:= TFont
.Create(FontID
, FONT_CHAR
);
861 destructor TGUITextButton
.Destroy
;
867 procedure TGUITextButton
.Draw
;
869 FFont
.Draw(FX
, FY
, FText
, FColor
.R
, FColor
.G
, FColor
.B
)
872 function TGUITextButton
.GetHeight
: Integer;
876 FFont
.GetTextSize(FText
, w
, h
);
880 function TGUITextButton
.GetWidth
: Integer;
884 FFont
.GetTextSize(FText
, w
, h
);
888 procedure TGUITextButton
.OnMessage(var Msg
: TMessage
);
890 if not FEnabled
then Exit
;
897 IK_RETURN
, IK_KPRETURN
: Click();
902 procedure TGUITextButton
.Update
;
909 constructor TFont
.Create(FontID
: DWORD
; FontType
: TFontType
);
914 FFontType
:= FontType
;
917 destructor TFont
.Destroy
;
923 procedure TFont
.Draw(X
, Y
: Integer; Text: string; R
, G
, B
: Byte);
925 if FFontType
= FONT_CHAR
then e_CharFont_PrintEx(ID
, X
, Y
, Text, _RGB(R
, G
, B
), FScale
)
926 else e_TextureFontPrintEx(X
, Y
, Text, ID
, R
, G
, B
, FScale
);
929 procedure TFont
.GetTextSize(Text: string; var w
, h
: Word);
933 if FFontType
= FONT_CHAR
then e_CharFont_GetSize(ID
, Text, w
, h
)
936 e_TextureFontGetSize(ID
, cw
, ch
);
937 w
:= cw
*Length(Text);
941 w
:= Round(w
*FScale
);
942 h
:= Round(h
*FScale
);
947 function TGUIMainMenu
.AddButton(fProc
: Pointer; Caption
: string; ShowWindow
: string = ''): TGUITextButton
;
954 SetLength(FButtons
, Length(FButtons
)+1);
955 FButtons
[High(FButtons
)] := TGUITextButton
.Create(fProc
, FFontID
, Caption
);
956 FButtons
[High(FButtons
)].ShowWindow
:= ShowWindow
;
957 with FButtons
[High(FButtons
)] do
959 if (fProc
<> nil) or (ShowWindow
<> '') then FColor
:= MAINMENU_ITEMS_COLOR
960 else FColor
:= MAINMENU_UNACTIVEITEMS_COLOR
;
961 FSound
:= MAINMENU_CLICKSOUND
;
964 _x
:= gScreenWidth
div 2;
966 for a
:= 0 to High(FButtons
) do
967 if FButtons
[a
] <> nil then
968 _x
:= Min(_x
, (gScreenWidth
div 2)-(FButtons
[a
].GetWidth
div 2));
970 hh
:= FHeader
.GetHeight
;
972 h
:= hh
*(2+Length(FButtons
))+MAINMENU_SPACE
*(Length(FButtons
)-1);
973 h
:= (gScreenHeight
div 2)-(h
div 2);
983 for a
:= 0 to High(FButtons
) do
985 if FButtons
[a
] <> nil then
992 Inc(h
, hh
+MAINMENU_SPACE
);
995 Result
:= FButtons
[High(FButtons
)];
998 procedure TGUIMainMenu
.AddSpace
;
1000 SetLength(FButtons
, Length(FButtons
)+1);
1001 FButtons
[High(FButtons
)] := nil;
1004 constructor TGUIMainMenu
.Create(FontID
: DWORD
; Header
: string);
1010 FCounter
:= MAINMENU_MARKERDELAY
;
1012 g_Texture_Get(MAINMENU_MARKER1
, FMarkerID1
);
1013 g_Texture_Get(MAINMENU_MARKER2
, FMarkerID2
);
1015 FHeader
:= TGUILabel
.Create(Header
, FFontID
);
1018 FColor
:= MAINMENU_HEADER_COLOR
;
1019 FX
:= (gScreenWidth
div 2)-(GetWidth
div 2);
1020 FY
:= (gScreenHeight
div 2)-(GetHeight
div 2);
1024 destructor TGUIMainMenu
.Destroy
;
1028 if FButtons
<> nil then
1029 for a
:= 0 to High(FButtons
) do
1037 procedure TGUIMainMenu
.Draw
;
1045 if FButtons
<> nil then
1047 for a
:= 0 to High(FButtons
) do
1048 if FButtons
[a
] <> nil then FButtons
[a
].Draw
;
1050 if FIndex
<> -1 then
1051 e_Draw(FMarkerID1
, FButtons
[FIndex
].FX
-48, FButtons
[FIndex
].FY
, 0, True, False);
1055 procedure TGUIMainMenu
.EnableButton(Name
: string; e
: Boolean);
1059 if FButtons
= nil then Exit
;
1061 for a
:= 0 to High(FButtons
) do
1062 if (FButtons
[a
] <> nil) and (FButtons
[a
].Name
= Name
) then
1064 if e
then FButtons
[a
].FColor
:= MAINMENU_ITEMS_COLOR
1065 else FButtons
[a
].FColor
:= MAINMENU_UNACTIVEITEMS_COLOR
;
1066 FButtons
[a
].Enabled
:= e
;
1071 function TGUIMainMenu
.GetButton(Name
: string): TGUITextButton
;
1077 if FButtons
= nil then Exit
;
1079 for a
:= 0 to High(FButtons
) do
1080 if (FButtons
[a
] <> nil) and (FButtons
[a
].Name
= Name
) then
1082 Result
:= FButtons
[a
];
1087 procedure TGUIMainMenu
.OnMessage(var Msg
: TMessage
);
1092 if not FEnabled
then Exit
;
1096 if FButtons
= nil then Exit
;
1099 for a
:= 0 to High(FButtons
) do
1100 if FButtons
[a
] <> nil then
1106 if not ok
then Exit
;
1115 if FIndex
< 0 then FIndex
:= High(FButtons
);
1116 until FButtons
[FIndex
] <> nil;
1118 g_Sound_PlayEx(MENU_CHANGESOUND
);
1124 if FIndex
> High(FButtons
) then FIndex
:= 0;
1125 until FButtons
[FIndex
] <> nil;
1127 g_Sound_PlayEx(MENU_CHANGESOUND
);
1129 IK_RETURN
, IK_KPRETURN
: if (FIndex
<> -1) and FButtons
[FIndex
].FEnabled
then FButtons
[FIndex
].Click
;
1134 procedure TGUIMainMenu
.Update
;
1140 if FCounter
= 0 then
1143 FMarkerID1
:= FMarkerID2
;
1146 FCounter
:= MAINMENU_MARKERDELAY
;
1147 end else Dec(FCounter
);
1152 constructor TGUILabel
.Create(Text: string; FontID
: DWORD
);
1156 FFont
:= TFont
.Create(FontID
, FONT_CHAR
);
1160 FOnClickEvent
:= nil;
1163 procedure TGUILabel
.Draw
;
1165 FFont
.Draw(FX
, FY
, FText
, FColor
.R
, FColor
.G
, FColor
.B
);
1168 function TGUILabel
.GetHeight
: Integer;
1172 FFont
.GetTextSize(FText
, w
, h
);
1176 function TGUILabel
.GetWidth
: Integer;
1180 if FFixedLen
= 0 then
1181 FFont
.GetTextSize(FText
, w
, h
)
1183 w
:= e_CharFont_GetMaxWidth(FFont
.ID
)*FFixedLen
;
1187 procedure TGUILabel
.OnMessage(var Msg
: TMessage
);
1189 if not FEnabled
then Exit
;
1196 IK_RETURN
, IK_KPRETURN
: if @FOnClickEvent
<> nil then FOnClickEvent();
1203 function TGUIMenu
.AddButton(Proc
: Pointer; fText
: string; _ShowWindow
: string = ''): TGUITextButton
;
1210 Control
:= TGUITextButton
.Create(Proc
, FFontID
, fText
);
1211 with Control
as TGUITextButton
do
1213 ShowWindow
:= _ShowWindow
;
1214 FColor
:= MENU_ITEMSCTRL_COLOR
;
1218 ControlType
:= TGUITextButton
;
1220 Result
:= (Control
as TGUITextButton
);
1223 if FIndex
= -1 then FIndex
:= i
;
1228 procedure TGUIMenu
.AddLine(fText
: string);
1235 Text := TGUILabel
.Create(fText
, FFontID
);
1238 FColor
:= MENU_ITEMSTEXT_COLOR
;
1247 procedure TGUIMenu
.AddText(fText
: string; MaxWidth
: Word);
1252 l
:= GetLines(fText
, FFontID
, MaxWidth
);
1254 if l
= nil then Exit
;
1256 for a
:= 0 to High(l
) do
1261 Text := TGUILabel
.Create(l
[a
], FFontID
);
1264 with Text do begin FColor
:= _RGB(255, 0, 0); end;
1268 with Text do begin FColor
:= MENU_ITEMSTEXT_COLOR
; end;
1278 procedure TGUIMenu
.AddSpace
;
1292 constructor TGUIMenu
.Create(HeaderFont
, ItemsFont
: DWORD
; Header
: string);
1298 FFontID
:= ItemsFont
;
1299 FCounter
:= MENU_MARKERDELAY
;
1303 FHeader
:= TGUILabel
.Create(Header
, HeaderFont
);
1306 FX
:= (gScreenWidth
div 2)-(GetWidth
div 2);
1308 FColor
:= MAINMENU_HEADER_COLOR
;
1312 destructor TGUIMenu
.Destroy
;
1316 if FItems
<> nil then
1317 for a
:= 0 to High(FItems
) do
1331 procedure TGUIMenu
.Draw
;
1337 if FHeader
<> nil then FHeader
.Draw
;
1339 if FItems
<> nil then
1340 for a
:= 0 to High(FItems
) do
1342 if FItems
[a
].Text <> nil then FItems
[a
].Text.Draw
;
1343 if FItems
[a
].Control
<> nil then FItems
[a
].Control
.Draw
;
1346 if (FIndex
<> -1) and (FCounter
> MENU_MARKERDELAY
div 2) then
1351 if FItems
[FIndex
].Text <> nil then
1353 x
:= FItems
[FIndex
].Text.FX
;
1354 y
:= FItems
[FIndex
].Text.FY
;
1356 else if FItems
[FIndex
].Control
<> nil then
1358 x
:= FItems
[FIndex
].Control
.FX
;
1359 y
:= FItems
[FIndex
].Control
.FY
;
1362 x
:= x
-e_CharFont_GetMaxWidth(FFontID
);
1364 e_CharFont_PrintEx(FFontID
, x
, y
, #16, _RGB(255, 0, 0));
1368 function TGUIMenu
.GetControl(Name
: String): TGUIControl
;
1374 if FItems
<> nil then
1375 for a
:= 0 to High(FItems
) do
1376 if FItems
[a
].Control
<> nil then
1377 if LowerCase(FItems
[a
].Control
.Name
) = LowerCase(Name
) then
1379 Result
:= FItems
[a
].Control
;
1383 Assert(Result
<> nil, 'GUI control "'+Name
+'" not found!');
1386 function TGUIMenu
.GetControlsText(Name
: String): TGUILabel
;
1392 if FItems
<> nil then
1393 for a
:= 0 to High(FItems
) do
1394 if FItems
[a
].Control
<> nil then
1395 if LowerCase(FItems
[a
].Control
.Name
) = LowerCase(Name
) then
1397 Result
:= FItems
[a
].Text;
1401 Assert(Result
<> nil, 'GUI control''s text "'+Name
+'" not found!');
1404 function TGUIMenu
.NewItem
: Integer;
1406 SetLength(FItems
, Length(FItems
)+1);
1407 Result
:= High(FItems
);
1410 procedure TGUIMenu
.OnMessage(var Msg
: TMessage
);
1415 if not FEnabled
then Exit
;
1419 if FItems
= nil then Exit
;
1422 for a
:= 0 to High(FItems
) do
1423 if FItems
[a
].Control
<> nil then
1429 if not ok
then Exit
;
1440 if c
> Length(FItems
) then
1447 if FIndex
< 0 then FIndex
:= High(FItems
);
1448 until (FItems
[FIndex
].Control
<> nil) and
1449 (FItems
[FIndex
].Control
.Enabled
);
1453 g_Sound_PlayEx(MENU_CHANGESOUND
);
1461 if c
> Length(FItems
) then
1468 if FIndex
> High(FItems
) then FIndex
:= 0;
1469 until (FItems
[FIndex
].Control
<> nil) and
1470 (FItems
[FIndex
].Control
.Enabled
);
1474 g_Sound_PlayEx(MENU_CHANGESOUND
);
1477 IK_LEFT
, IK_RIGHT
, IK_KPLEFT
, IK_KPRIGHT
:
1479 if FIndex
<> -1 then
1480 if FItems
[FIndex
].Control
<> nil then
1481 FItems
[FIndex
].Control
.OnMessage(Msg
);
1483 IK_RETURN
, IK_KPRETURN
:
1485 if FIndex
<> -1 then
1487 if FItems
[FIndex
].Control
<> nil then FItems
[FIndex
].Control
.OnMessage(Msg
);
1489 g_Sound_PlayEx(MENU_CLICKSOUND
);
1493 if FYesNo
and (length(FItems
) > 1) then
1495 Msg
.wParam
:= IK_RETURN
; // to register keypress
1496 FIndex
:= High(FItems
)-1;
1497 if FItems
[FIndex
].Control
<> nil then FItems
[FIndex
].Control
.OnMessage(Msg
);
1500 if FYesNo
and (length(FItems
) > 1) then
1502 Msg
.wParam
:= IK_RETURN
; // to register keypress
1503 FIndex
:= High(FItems
);
1504 if FItems
[FIndex
].Control
<> nil then FItems
[FIndex
].Control
.OnMessage(Msg
);
1511 procedure TGUIMenu
.ReAlign();
1513 a
, tx
, cx
, w
, h
: Integer;
1515 if FItems
= nil then Exit
;
1517 if not FAlign
then tx
:= FLeft
else
1520 for a
:= 0 to High(FItems
) do
1523 if FItems
[a
].Text <> nil then w
:= FItems
[a
].Text.GetWidth
;
1524 if FItems
[a
].Control
<> nil then
1528 if FItems
[a
].ControlType
= TGUILabel
then
1529 w
:= w
+(FItems
[a
].Control
as TGUILabel
).GetWidth
1530 else if FItems
[a
].ControlType
= TGUITextButton
then
1531 w
:= w
+(FItems
[a
].Control
as TGUITextButton
).GetWidth
1532 else if FItems
[a
].ControlType
= TGUIScroll
then
1533 w
:= w
+(FItems
[a
].Control
as TGUIScroll
).GetWidth
1534 else if FItems
[a
].ControlType
= TGUISwitch
then
1535 w
:= w
+(FItems
[a
].Control
as TGUISwitch
).GetWidth
1536 else if FItems
[a
].ControlType
= TGUIEdit
then
1537 w
:= w
+(FItems
[a
].Control
as TGUIEdit
).GetWidth
1538 else if FItems
[a
].ControlType
= TGUIKeyRead
then
1539 w
:= w
+(FItems
[a
].Control
as TGUIKeyRead
).GetWidth
1540 else if (FItems
[a
].ControlType
= TGUIListBox
) then
1541 w
:= w
+(FItems
[a
].Control
as TGUIListBox
).GetWidth
1542 else if (FItems
[a
].ControlType
= TGUIFileListBox
) then
1543 w
:= w
+(FItems
[a
].Control
as TGUIFileListBox
).GetWidth
1544 else if FItems
[a
].ControlType
= TGUIMemo
then
1545 w
:= w
+(FItems
[a
].Control
as TGUIMemo
).GetWidth
;
1548 tx
:= Min(tx
, (gScreenWidth
div 2)-(w
div 2));
1553 for a
:= 0 to High(FItems
) do
1557 if (Text <> nil) and (Control
= nil) then Continue
;
1559 if Text <> nil then w
:= tx
+Text.GetWidth
;
1560 if w
> cx
then cx
:= w
;
1564 cx
:= cx
+MENU_HSPACE
;
1566 h
:= FHeader
.GetHeight
*2+MENU_VSPACE
*(Length(FItems
)-1);
1568 for a
:= 0 to High(FItems
) do
1572 if (ControlType
= TGUIListBox
) or (ControlType
= TGUIFileListBox
) then
1573 h
:= h
+(FItems
[a
].Control
as TGUIListBox
).GetHeight()
1575 h
:= h
+e_CharFont_GetMaxHeight(FFontID
);
1579 h
:= (gScreenHeight
div 2)-(h
div 2);
1583 FX
:= (gScreenWidth
div 2)-(GetWidth
div 2);
1586 Inc(h
, GetHeight
*2);
1589 for a
:= 0 to High(FItems
) do
1599 if Control
<> nil then
1612 if (ControlType
= TGUIListBox
) or (ControlType
= TGUIFileListBox
) then
1613 Inc(h
, (Control
as TGUIListBox
).GetHeight
+MENU_VSPACE
)
1614 else if ControlType
= TGUIMemo
then
1615 Inc(h
, (Control
as TGUIMemo
).GetHeight
+MENU_VSPACE
)
1617 Inc(h
, e_CharFont_GetMaxHeight(FFontID
)+MENU_VSPACE
);
1620 // another ugly hack
1621 if FYesNo
and (length(FItems
) > 1) then
1624 for a
:= High(FItems
)-1 to High(FItems
) do
1626 if (FItems
[a
].Control
<> nil) and (FItems
[a
].ControlType
= TGUITextButton
) then
1628 cx
:= (FItems
[a
].Control
as TGUITextButton
).GetWidth
;
1629 if cx
> w
then w
:= cx
;
1634 for a
:= High(FItems
)-1 to High(FItems
) do
1636 if (FItems
[a
].Control
<> nil) and (FItems
[a
].ControlType
= TGUITextButton
) then
1638 FItems
[a
].Control
.FX
:= (gScreenWidth
-w
) div 2;
1645 function TGUIMenu
.AddScroll(fText
: string): TGUIScroll
;
1652 Control
:= TGUIScroll
.Create();
1654 Text := TGUILabel
.Create(fText
, FFontID
);
1657 FColor
:= MENU_ITEMSTEXT_COLOR
;
1660 ControlType
:= TGUIScroll
;
1662 Result
:= (Control
as TGUIScroll
);
1665 if FIndex
= -1 then FIndex
:= i
;
1670 function TGUIMenu
.AddSwitch(fText
: string): TGUISwitch
;
1677 Control
:= TGUISwitch
.Create(FFontID
);
1678 (Control
as TGUISwitch
).FColor
:= MENU_ITEMSCTRL_COLOR
;
1680 Text := TGUILabel
.Create(fText
, FFontID
);
1683 FColor
:= MENU_ITEMSTEXT_COLOR
;
1686 ControlType
:= TGUISwitch
;
1688 Result
:= (Control
as TGUISwitch
);
1691 if FIndex
= -1 then FIndex
:= i
;
1696 function TGUIMenu
.AddEdit(fText
: string): TGUIEdit
;
1703 Control
:= TGUIEdit
.Create(FFontID
);
1704 with Control
as TGUIEdit
do
1706 FWindow
:= Self
.FWindow
;
1707 FColor
:= MENU_ITEMSCTRL_COLOR
;
1710 if fText
= '' then Text := nil else
1712 Text := TGUILabel
.Create(fText
, FFontID
);
1713 Text.FColor
:= MENU_ITEMSTEXT_COLOR
;
1716 ControlType
:= TGUIEdit
;
1718 Result
:= (Control
as TGUIEdit
);
1721 if FIndex
= -1 then FIndex
:= i
;
1726 procedure TGUIMenu
.Update
;
1732 if FCounter
= 0 then FCounter
:= MENU_MARKERDELAY
else Dec(FCounter
);
1734 if FItems
<> nil then
1735 for a
:= 0 to High(FItems
) do
1736 if FItems
[a
].Control
<> nil then
1737 (FItems
[a
].Control
as FItems
[a
].ControlType
).Update
;
1740 function TGUIMenu
.AddKeyRead(fText
: string): TGUIKeyRead
;
1747 Control
:= TGUIKeyRead
.Create(FFontID
);
1748 with Control
as TGUIKeyRead
do
1750 FWindow
:= Self
.FWindow
;
1751 FColor
:= MENU_ITEMSCTRL_COLOR
;
1754 Text := TGUILabel
.Create(fText
, FFontID
);
1757 FColor
:= MENU_ITEMSTEXT_COLOR
;
1760 ControlType
:= TGUIKeyRead
;
1762 Result
:= (Control
as TGUIKeyRead
);
1765 if FIndex
= -1 then FIndex
:= i
;
1770 function TGUIMenu
.AddList(fText
: string; Width
, Height
: Word): TGUIListBox
;
1777 Control
:= TGUIListBox
.Create(FFontID
, Width
, Height
);
1778 with Control
as TGUIListBox
do
1780 FWindow
:= Self
.FWindow
;
1781 FActiveColor
:= MENU_ITEMSCTRL_COLOR
;
1782 FUnActiveColor
:= MENU_ITEMSTEXT_COLOR
;
1785 Text := TGUILabel
.Create(fText
, FFontID
);
1788 FColor
:= MENU_ITEMSTEXT_COLOR
;
1791 ControlType
:= TGUIListBox
;
1793 Result
:= (Control
as TGUIListBox
);
1796 if FIndex
= -1 then FIndex
:= i
;
1801 function TGUIMenu
.AddFileList(fText
: string; Width
, Height
: Word): TGUIFileListBox
;
1808 Control
:= TGUIFileListBox
.Create(FFontID
, Width
, Height
);
1809 with Control
as TGUIFileListBox
do
1811 FWindow
:= Self
.FWindow
;
1812 FActiveColor
:= MENU_ITEMSCTRL_COLOR
;
1813 FUnActiveColor
:= MENU_ITEMSTEXT_COLOR
;
1816 if fText
= '' then Text := nil else
1818 Text := TGUILabel
.Create(fText
, FFontID
);
1819 Text.FColor
:= MENU_ITEMSTEXT_COLOR
;
1822 ControlType
:= TGUIFileListBox
;
1824 Result
:= (Control
as TGUIFileListBox
);
1827 if FIndex
= -1 then FIndex
:= i
;
1832 function TGUIMenu
.AddLabel(fText
: string): TGUILabel
;
1839 Control
:= TGUILabel
.Create('', FFontID
);
1840 with Control
as TGUILabel
do
1842 FWindow
:= Self
.FWindow
;
1843 FColor
:= MENU_ITEMSCTRL_COLOR
;
1846 Text := TGUILabel
.Create(fText
, FFontID
);
1849 FColor
:= MENU_ITEMSTEXT_COLOR
;
1852 ControlType
:= TGUILabel
;
1854 Result
:= (Control
as TGUILabel
);
1857 if FIndex
= -1 then FIndex
:= i
;
1862 function TGUIMenu
.AddMemo(fText
: string; Width
, Height
: Word): TGUIMemo
;
1869 Control
:= TGUIMemo
.Create(FFontID
, Width
, Height
);
1870 with Control
as TGUIMemo
do
1872 FWindow
:= Self
.FWindow
;
1873 FColor
:= MENU_ITEMSTEXT_COLOR
;
1876 if fText
= '' then Text := nil else
1878 Text := TGUILabel
.Create(fText
, FFontID
);
1879 Text.FColor
:= MENU_ITEMSTEXT_COLOR
;
1882 ControlType
:= TGUIMemo
;
1884 Result
:= (Control
as TGUIMemo
);
1887 if FIndex
= -1 then FIndex
:= i
;
1892 procedure TGUIMenu
.UpdateIndex();
1900 if (FIndex
< 0) or (FIndex
> High(FItems
)) then
1906 if FItems
[FIndex
].Control
.Enabled
then
1915 constructor TGUIScroll
.Create
;
1920 FOnChangeEvent
:= nil;
1922 g_Texture_Get(SCROLL_LEFT
, FLeftID
);
1923 g_Texture_Get(SCROLL_RIGHT
, FRightID
);
1924 g_Texture_Get(SCROLL_MIDDLE
, FMiddleID
);
1925 g_Texture_Get(SCROLL_MARKER
, FMarkerID
);
1928 procedure TGUIScroll
.Draw
;
1934 e_Draw(FLeftID
, FX
, FY
, 0, True, False);
1935 e_Draw(FRightID
, FX
+8+(FMax
+1)*8, FY
, 0, True, False);
1937 for a
:= 0 to FMax
do
1938 e_Draw(FMiddleID
, FX
+8+a
*8, FY
, 0, True, False);
1940 e_Draw(FMarkerID
, FX
+8+FValue
*8, FY
, 0, True, False);
1943 procedure TGUIScroll
.FSetValue(a
: Integer);
1945 if a
> FMax
then FValue
:= FMax
else FValue
:= a
;
1948 function TGUIScroll
.GetWidth
: Word;
1950 Result
:= 16+(FMax
+1)*8;
1953 procedure TGUIScroll
.OnMessage(var Msg
: TMessage
);
1955 if not FEnabled
then Exit
;
1967 g_Sound_PlayEx(SCROLL_SUBSOUND
);
1968 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
1970 IK_RIGHT
, IK_KPRIGHT
:
1971 if FValue
< FMax
then
1974 g_Sound_PlayEx(SCROLL_ADDSOUND
);
1975 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
1982 procedure TGUIScroll
.Update
;
1990 procedure TGUISwitch
.AddItem(Item
: string);
1992 SetLength(FItems
, Length(FItems
)+1);
1993 FItems
[High(FItems
)] := Item
;
1995 if FIndex
= -1 then FIndex
:= 0;
1998 constructor TGUISwitch
.Create(FontID
: DWORD
);
2004 FFont
:= TFont
.Create(FontID
, FONT_CHAR
);
2007 procedure TGUISwitch
.Draw
;
2011 FFont
.Draw(FX
, FY
, FItems
[FIndex
], FColor
.R
, FColor
.G
, FColor
.B
);
2014 function TGUISwitch
.GetText
: string;
2016 if FIndex
<> -1 then Result
:= FItems
[FIndex
]
2020 function TGUISwitch
.GetWidth
: Word;
2027 if FItems
= nil then Exit
;
2029 for a
:= 0 to High(FItems
) do
2031 FFont
.GetTextSize(FItems
[a
], w
, h
);
2032 if w
> Result
then Result
:= w
;
2036 procedure TGUISwitch
.OnMessage(var Msg
: TMessage
);
2038 if not FEnabled
then Exit
;
2042 if FItems
= nil then Exit
;
2047 IK_RETURN
, IK_RIGHT
, IK_KPRETURN
, IK_KPRIGHT
:
2049 if FIndex
< High(FItems
) then
2054 if @FOnChangeEvent
<> nil then
2055 FOnChangeEvent(Self
);
2063 FIndex
:= High(FItems
);
2065 if @FOnChangeEvent
<> nil then
2066 FOnChangeEvent(Self
);
2072 procedure TGUISwitch
.Update
;
2080 constructor TGUIEdit
.Create(FontID
: DWORD
);
2084 FFont
:= TFont
.Create(FontID
, FONT_CHAR
);
2089 g_Texture_Get(EDIT_LEFT
, FLeftID
);
2090 g_Texture_Get(EDIT_RIGHT
, FRightID
);
2091 g_Texture_Get(EDIT_MIDDLE
, FMiddleID
);
2094 procedure TGUIEdit
.Draw
;
2100 e_Draw(FLeftID
, FX
, FY
, 0, True, False);
2101 e_Draw(FRightID
, FX
+8+FWidth
*16, FY
, 0, True, False);
2103 for c
:= 0 to FWidth
-1 do
2104 e_Draw(FMiddleID
, FX
+8+c
*16, FY
, 0, True, False);
2106 FFont
.Draw(FX
+8, FY
, FText
, FColor
.R
, FColor
.G
, FColor
.B
);
2108 if FWindow
.FActiveControl
= Self
then
2110 FFont
.GetTextSize(Copy(FText
, 1, FCaretPos
), w
, h
);
2111 h
:= e_CharFont_GetMaxHeight(FFont
.ID
);
2112 e_DrawLine(2, FX
+8+w
, FY
+h
-3, FX
+8+w
+EDIT_CURSORLEN
, FY
+h
-3,
2113 EDIT_CURSORCOLOR
.R
, EDIT_CURSORCOLOR
.G
, EDIT_CURSORCOLOR
.B
);
2117 function TGUIEdit
.GetWidth
: Word;
2119 Result
:= 16+FWidth
*16;
2122 procedure TGUIEdit
.OnMessage(var Msg
: TMessage
);
2124 if not FEnabled
then Exit
;
2133 if (wParam
in [48..57]) and (Chr(wParam
) <> '`') then
2134 if Length(Text) < FMaxLength
then
2136 Insert(Chr(wParam
), FText
, FCaretPos
+ 1);
2142 if (wParam
in [32..255]) and (Chr(wParam
) <> '`') then
2143 if Length(Text) < FMaxLength
then
2145 Insert(Chr(wParam
), FText
, FCaretPos
+ 1);
2153 Delete(FText
, FCaretPos
, 1);
2154 if FCaretPos
> 0 then Dec(FCaretPos
);
2156 IK_DELETE
: Delete(FText
, FCaretPos
+ 1, 1);
2157 IK_END
, IK_KPEND
: FCaretPos
:= Length(FText
);
2158 IK_HOME
, IK_KPHOME
: FCaretPos
:= 0;
2159 IK_LEFT
, IK_KPLEFT
: if FCaretPos
> 0 then Dec(FCaretPos
);
2160 IK_RIGHT
, IK_KPRIGHT
: if FCaretPos
< Length(FText
) then Inc(FCaretPos
);
2161 IK_RETURN
, IK_KPRETURN
:
2164 if FActiveControl
<> Self
then
2167 if @FOnEnterEvent
<> nil then FOnEnterEvent(Self
);
2171 if FDefControl
<> '' then SetActive(GetControl(FDefControl
))
2172 else SetActive(nil);
2173 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2180 procedure TGUIEdit
.SetText(Text: string);
2182 if Length(Text) > FMaxLength
then SetLength(Text, FMaxLength
);
2184 FCaretPos
:= Length(FText
);
2187 procedure TGUIEdit
.Update
;
2194 constructor TGUIKeyRead
.Create(FontID
: DWORD
);
2198 FFont
:= TFont
.Create(FontID
, FONT_CHAR
);
2201 procedure TGUIKeyRead
.Draw
;
2205 FFont
.Draw(FX
, FY
, IfThen(FIsQuery
, KEYREAD_QUERY
, IfThen(FKey
<> 0, e_KeyNames
[FKey
], KEYREAD_CLEAR
)),
2206 FColor
.R
, FColor
.G
, FColor
.B
);
2209 function TGUIKeyRead
.GetWidth
: Word;
2216 for a
:= 0 to 255 do
2218 FFont
.GetTextSize(e_KeyNames
[a
], w
, h
);
2219 Result
:= Max(Result
, w
);
2222 FFont
.GetTextSize(KEYREAD_QUERY
, w
, h
);
2223 if w
> Result
then Result
:= w
;
2225 FFont
.GetTextSize(KEYREAD_CLEAR
, w
, h
);
2226 if w
> Result
then Result
:= w
;
2229 procedure TGUIKeyRead
.OnMessage(var Msg
: TMessage
);
2233 if not FEnabled
then
2244 if FDefControl
<> '' then
2245 SetActive(GetControl(FDefControl
))
2251 IK_RETURN
, IK_KPRETURN
:
2253 if not FIsQuery
then
2256 if FActiveControl
<> Self
then
2263 FKey
:= IK_ENTER
; // <Enter>
2267 if FDefControl
<> '' then
2268 SetActive(GetControl(FDefControl
))
2276 if FIsQuery
and (wParam
<> IK_ENTER
) and (wParam
<> IK_KPRETURN
) then // Not <Enter
2278 if e_KeyNames
[wParam
] <> '' then
2283 if FDefControl
<> '' then
2284 SetActive(GetControl(FDefControl
))
2293 constructor TGUIModelView
.Create
;
2300 destructor TGUIModelView
.Destroy
;
2307 procedure TGUIModelView
.Draw
;
2311 DrawBox(FX
, FY
, 4, 4);
2313 if FModel
<> nil then FModel
.Draw(FX
+4, FY
+4);
2316 procedure TGUIModelView
.NextAnim();
2318 if FModel
= nil then
2321 if FModel
.Animation
< A_PAIN
then
2322 FModel
.ChangeAnimation(FModel
.Animation
+1, True)
2324 FModel
.ChangeAnimation(A_STAND
, True);
2327 procedure TGUIModelView
.NextWeapon();
2329 if FModel
= nil then
2332 if FModel
.Weapon
< WEAPON_SUPERPULEMET
then
2333 FModel
.SetWeapon(FModel
.Weapon
+1)
2335 FModel
.SetWeapon(WEAPON_KASTET
);
2338 procedure TGUIModelView
.OnMessage(var Msg
: TMessage
);
2344 procedure TGUIModelView
.SetColor(Red
, Green
, Blue
: Byte);
2346 if FModel
<> nil then FModel
.SetColor(Red
, Green
, Blue
);
2349 procedure TGUIModelView
.SetModel(ModelName
: string);
2353 FModel
:= g_PlayerModel_Get(ModelName
);
2356 procedure TGUIModelView
.Update
;
2363 if FModel
<> nil then FModel
.Update
;
2368 constructor TGUIMapPreview
.Create();
2374 destructor TGUIMapPreview
.Destroy();
2380 procedure TGUIMapPreview
.Draw();
2387 DrawBox(FX
, FY
, MAPPREVIEW_WIDTH
, MAPPREVIEW_HEIGHT
);
2389 if (FMapSize
.X
<= 0) or (FMapSize
.Y
<= 0) then
2392 e_DrawFillQuad(FX
+4, FY
+4,
2393 FX
+4 + Trunc(FMapSize
.X
/ FScale
) - 1,
2394 FY
+4 + Trunc(FMapSize
.Y
/ FScale
) - 1,
2397 if FMapData
<> nil then
2398 for a
:= 0 to High(FMapData
) do
2401 if X1
> MAPPREVIEW_WIDTH
*16 then Continue
;
2402 if Y1
> MAPPREVIEW_HEIGHT
*16 then Continue
;
2404 if X2
< 0 then Continue
;
2405 if Y2
< 0 then Continue
;
2407 if X2
> MAPPREVIEW_WIDTH
*16 then X2
:= MAPPREVIEW_WIDTH
*16;
2408 if Y2
> MAPPREVIEW_HEIGHT
*16 then Y2
:= MAPPREVIEW_HEIGHT
*16;
2410 if X1
< 0 then X1
:= 0;
2411 if Y1
< 0 then Y1
:= 0;
2452 if ((X2
-X1
) > 0) and ((Y2
-Y1
) > 0) then
2453 e_DrawFillQuad(FX
+4 + X1
, FY
+4 + Y1
,
2454 FX
+4 + X2
- 1, FY
+4 + Y2
- 1, r
, g
, b
, 0);
2458 procedure TGUIMapPreview
.OnMessage(var Msg
: TMessage
);
2464 procedure TGUIMapPreview
.SetMap(Res
: string);
2467 MapReader
: TMapReader_1
;
2468 panels
: TPanelsRec1Array
;
2469 header
: TMapHeaderRec_1
;
2471 FileName
, SectionName
, ResName
: string;
2476 g_ProcessResourceStr(Res
, FileName
, SectionName
, ResName
);
2478 WAD
:= TWADFile
.Create();
2479 if not WAD
.ReadFile(FileName
) then
2485 if not WAD
.GetResource('', ResName
, Data
, Len
) then
2493 MapReader
:= TMapReader_1
.Create();
2495 if not MapReader
.LoadMap(Data
) then
2508 panels
:= MapReader
.GetPanels();
2509 header
:= MapReader
.GetMapHeader();
2511 FMapSize
.X
:= header
.Width
div 16;
2512 FMapSize
.Y
:= header
.Height
div 16;
2514 rX
:= Ceil(header
.Width
/ (MAPPREVIEW_WIDTH
*256.0));
2515 rY
:= Ceil(header
.Height
/ (MAPPREVIEW_HEIGHT
*256.0));
2516 FScale
:= max(rX
, rY
);
2520 if panels
<> nil then
2521 for a
:= 0 to High(panels
) do
2522 if WordBool(panels
[a
].PanelType
and (PANEL_WALL
or PANEL_CLOSEDOOR
or
2523 PANEL_STEP
or PANEL_WATER
or
2524 PANEL_ACID1
or PANEL_ACID2
)) then
2526 SetLength(FMapData
, Length(FMapData
)+1);
2527 with FMapData
[High(FMapData
)] do
2529 X1
:= panels
[a
].X
div 16;
2530 Y1
:= panels
[a
].Y
div 16;
2532 X2
:= (panels
[a
].X
+ panels
[a
].Width
) div 16;
2533 Y2
:= (panels
[a
].Y
+ panels
[a
].Height
) div 16;
2535 X1
:= Trunc(X1
/FScale
+ 0.5);
2536 Y1
:= Trunc(Y1
/FScale
+ 0.5);
2537 X2
:= Trunc(X2
/FScale
+ 0.5);
2538 Y2
:= Trunc(Y2
/FScale
+ 0.5);
2540 if (X1
<> X2
) or (Y1
<> Y2
) then
2548 PanelType
:= panels
[a
].PanelType
;
2557 procedure TGUIMapPreview
.ClearMap();
2559 SetLength(FMapData
, 0);
2566 procedure TGUIMapPreview
.Update();
2572 function TGUIMapPreview
.GetScaleStr(): String;
2574 if FScale
> 0.0 then
2576 Result
:= FloatToStrF(FScale
*16.0, ffFixed
, 3, 3);
2577 while (Result
[Length(Result
)] = '0') do
2578 Delete(Result
, Length(Result
), 1);
2579 if (Result
[Length(Result
)] = ',') or (Result
[Length(Result
)] = '.') then
2580 Delete(Result
, Length(Result
), 1);
2581 Result
:= '1 : ' + Result
;
2589 procedure TGUIListBox
.AddItem(Item
: string);
2591 SetLength(FItems
, Length(FItems
)+1);
2592 FItems
[High(FItems
)] := Item
;
2594 if FSort
then g_Basic
.Sort(FItems
);
2597 procedure TGUIListBox
.Clear();
2605 constructor TGUIListBox
.Create(FontID
: DWORD
; Width
, Height
: Word);
2609 FFont
:= TFont
.Create(FontID
, FONT_CHAR
);
2614 FOnChangeEvent
:= nil;
2616 FDrawScroll
:= True;
2619 procedure TGUIListBox
.Draw
;
2627 if FDrawBack
then DrawBox(FX
, FY
, FWidth
+1, FHeight
);
2629 DrawScroll(FX
+4+FWidth
*16, FY
+4, FHeight
, (FStartLine
> 0) and (FItems
<> nil),
2630 (FStartLine
+FHeight
-1 < High(FItems
)) and (FItems
<> nil));
2632 if FItems
<> nil then
2633 for a
:= FStartLine
to Min(High(FItems
), FStartLine
+FHeight
-1) do
2637 FFont
.GetTextSize(s
, w2
, h2
);
2638 while (Length(s
) > 0) and (w2
> FWidth
*16) do
2640 SetLength(s
, Length(s
)-1);
2641 FFont
.GetTextSize(s
, w2
, h2
);
2645 FFont
.Draw(FX
+4, FY
+4+(a
-FStartLine
)*16, s
, FActiveColor
.R
, FActiveColor
.G
, FActiveColor
.B
)
2647 FFont
.Draw(FX
+4, FY
+4+(a
-FStartLine
)*16, s
, FUnActiveColor
.R
, FUnActiveColor
.G
, FUnActiveColor
.B
);
2651 function TGUIListBox
.GetHeight
: Word;
2653 Result
:= 8+FHeight
*16;
2656 function TGUIListBox
.GetWidth
: Word;
2658 Result
:= 8+(FWidth
+1)*16;
2661 procedure TGUIListBox
.OnMessage(var Msg
: TMessage
);
2665 if not FEnabled
then Exit
;
2669 if FItems
= nil then Exit
;
2682 FIndex
:= High(FItems
);
2683 FStartLine
:= Max(High(FItems
)-FHeight
+1, 0);
2685 IK_UP
, IK_LEFT
, IK_KPUP
, IK_KPLEFT
:
2689 if FIndex
< FStartLine
then Dec(FStartLine
);
2690 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2692 IK_DOWN
, IK_RIGHT
, IK_KPDOWN
, IK_KPRIGHT
:
2693 if FIndex
< High(FItems
) then
2696 if FIndex
> FStartLine
+FHeight
-1 then Inc(FStartLine
);
2697 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2699 IK_RETURN
, IK_KPRETURN
:
2702 if FActiveControl
<> Self
then SetActive(Self
)
2704 if FDefControl
<> '' then SetActive(GetControl(FDefControl
))
2705 else SetActive(nil);
2709 for a
:= 0 to High(FItems
) do
2710 if (Length(FItems
[a
]) > 0) and (LowerCase(FItems
[a
][1]) = LowerCase(Chr(wParam
))) then
2713 FStartLine
:= Min(Max(FIndex
-1, 0), Length(FItems
)-FHeight
);
2714 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2720 function TGUIListBox
.SelectedItem(): String;
2724 if (FIndex
< 0) or (FItems
= nil) or
2725 (FIndex
> High(FItems
)) then
2728 Result
:= FItems
[FIndex
];
2731 procedure TGUIListBox
.FSetItems(Items
: SArray
);
2733 if FItems
<> nil then
2741 if FSort
then g_Basic
.Sort(FItems
);
2744 procedure TGUIListBox
.SelectItem(Item
: String);
2748 if FItems
= nil then
2752 Item
:= LowerCase(Item
);
2754 for a
:= 0 to High(FItems
) do
2755 if LowerCase(FItems
[a
]) = Item
then
2761 if FIndex
< FHeight
then
2764 FStartLine
:= Min(FIndex
, Length(FItems
)-FHeight
);
2767 procedure TGUIListBox
.FSetIndex(aIndex
: Integer);
2769 if FItems
= nil then
2772 if (aIndex
< 0) or (aIndex
> High(FItems
)) then
2777 if FIndex
<= FHeight
then
2780 FStartLine
:= Min(FIndex
, Length(FItems
)-FHeight
);
2785 procedure TGUIFileListBox
.OnMessage(var Msg
: TMessage
);
2789 if not FEnabled
then
2792 if FItems
= nil then
2803 if @FOnChangeEvent
<> nil then
2804 FOnChangeEvent(Self
);
2809 FIndex
:= High(FItems
);
2810 FStartLine
:= Max(High(FItems
)-FHeight
+1, 0);
2811 if @FOnChangeEvent
<> nil then
2812 FOnChangeEvent(Self
);
2815 IK_PAGEUP
, IK_KPPAGEUP
:
2817 if FIndex
> FHeight
then
2818 FIndex
:= FIndex
-FHeight
2822 if FStartLine
> FHeight
then
2823 FStartLine
:= FStartLine
-FHeight
2828 IK_PAGEDN
, IK_KPPAGEDN
:
2830 if FIndex
< High(FItems
)-FHeight
then
2831 FIndex
:= FIndex
+FHeight
2833 FIndex
:= High(FItems
);
2835 if FStartLine
< High(FItems
)-FHeight
then
2836 FStartLine
:= FStartLine
+FHeight
2838 FStartLine
:= High(FItems
)-FHeight
+1;
2841 IK_UP
, IK_LEFT
, IK_KPUP
, IK_KPLEFT
:
2845 if FIndex
< FStartLine
then
2847 if @FOnChangeEvent
<> nil then
2848 FOnChangeEvent(Self
);
2851 IK_DOWN
, IK_RIGHT
, IK_KPDOWN
, IK_KPRIGHT
:
2852 if FIndex
< High(FItems
) then
2855 if FIndex
> FStartLine
+FHeight
-1 then
2857 if @FOnChangeEvent
<> nil then
2858 FOnChangeEvent(Self
);
2861 IK_RETURN
, IK_KPRETURN
:
2864 if FActiveControl
<> Self
then
2868 if FItems
[FIndex
][1] = #29 then // Ïàïêà
2870 OpenDir(FPath
+Copy(FItems
[FIndex
], 2, 255));
2875 if FDefControl
<> '' then
2876 SetActive(GetControl(FDefControl
))
2884 for a
:= 0 to High(FItems
) do
2885 if ( (Length(FItems
[a
]) > 0) and
2886 (LowerCase(FItems
[a
][1]) = LowerCase(Chr(wParam
))) ) or
2887 ( (Length(FItems
[a
]) > 1) and
2888 (FItems
[a
][1] = #29) and // Ïàïêà
2889 (LowerCase(FItems
[a
][2]) = LowerCase(Chr(wParam
))) ) then
2892 FStartLine
:= Min(Max(FIndex
-1, 0), Length(FItems
)-FHeight
);
2893 if @FOnChangeEvent
<> nil then
2894 FOnChangeEvent(Self
);
2900 procedure TGUIFileListBox
.OpenDir(path
: String);
2908 path
:= IncludeTrailingPathDelimiter(path
);
2909 path
:= ExpandFileName(path
);
2914 if FindFirst(path
+'*', faDirectory
, SR
) = 0 then
2916 if not LongBool(SR
.Attr
and faDirectory
) then
2918 if (SR
.Name
= '.') or
2919 ((SR
.Name
= '..') and (path
= ExpandFileName(FBasePath
))) then
2922 AddItem(#1 + SR
.Name
);
2923 until FindNext(SR
) <> 0;
2933 if i
= 0 then i
:= length(sm
)+1;
2934 sc
:= Copy(sm
, 1, i
-1);
2936 if FindFirst(path
+sc
, faAnyFile
, SR
) = 0 then repeat AddItem(SR
.Name
); until FindNext(SR
) <> 0;
2940 for i
:= 0 to High(FItems
) do
2941 if FItems
[i
][1] = #1 then
2942 FItems
[i
][1] := #29;
2947 procedure TGUIFileListBox
.SetBase(path
: String);
2953 function TGUIFileListBox
.SelectedItem(): String;
2957 if (FIndex
= -1) or (FItems
= nil) or
2958 (FIndex
> High(FItems
)) or
2959 (FItems
[FIndex
][1] = '/') or
2960 (FItems
[FIndex
][1] = '\') then
2963 Result
:= FPath
+ FItems
[FIndex
];
2966 procedure TGUIFileListBox
.UpdateFileList();
2970 if (FIndex
= -1) or (FItems
= nil) or
2971 (FIndex
> High(FItems
)) or
2972 (FItems
[FIndex
][1] = '/') or
2973 (FItems
[FIndex
][1] = '\') then
2976 fn
:= FItems
[FIndex
];
2986 procedure TGUIMemo
.Clear
;
2992 constructor TGUIMemo
.Create(FontID
: DWORD
; Width
, Height
: Word);
2996 FFont
:= TFont
.Create(FontID
, FONT_CHAR
);
3001 FDrawScroll
:= True;
3004 procedure TGUIMemo
.Draw
;
3010 if FDrawBack
then DrawBox(FX
, FY
, FWidth
+1, FHeight
);
3012 DrawScroll(FX
+4+FWidth
*16, FY
+4, FHeight
, (FStartLine
> 0) and (FLines
<> nil),
3013 (FStartLine
+FHeight
-1 < High(FLines
)) and (FLines
<> nil));
3015 if FLines
<> nil then
3016 for a
:= FStartLine
to Min(High(FLines
), FStartLine
+FHeight
-1) do
3017 FFont
.Draw(FX
+4, FY
+4+(a
-FStartLine
)*16, FLines
[a
], FColor
.R
, FColor
.G
, FColor
.B
);
3020 function TGUIMemo
.GetHeight
: Word;
3022 Result
:= 8+FHeight
*16;
3025 function TGUIMemo
.GetWidth
: Word;
3027 Result
:= 8+(FWidth
+1)*16;
3030 procedure TGUIMemo
.OnMessage(var Msg
: TMessage
);
3032 if not FEnabled
then Exit
;
3036 if FLines
= nil then Exit
;
3042 IK_UP
, IK_LEFT
, IK_KPUP
, IK_KPLEFT
:
3043 if FStartLine
> 0 then
3045 IK_DOWN
, IK_RIGHT
, IK_KPDOWN
, IK_KPRIGHT
:
3046 if FStartLine
< Length(FLines
)-FHeight
then
3048 IK_RETURN
, IK_KPRETURN
:
3051 if FActiveControl
<> Self
then
3057 if FDefControl
<> '' then SetActive(GetControl(FDefControl
))
3058 else SetActive(nil);
3064 procedure TGUIMemo
.SetText(Text: string);
3067 FLines
:= GetLines(Text, FFont
.ID
, FWidth
*16);
3072 procedure TGUIimage
.ClearImage();
3074 if FImageRes
= '' then Exit
;
3076 g_Texture_Delete(FImageRes
);
3080 constructor TGUIimage
.Create();
3087 destructor TGUIimage
.Destroy();
3092 procedure TGUIimage
.Draw();
3098 if FImageRes
= '' then
3100 if g_Texture_Get(FDefaultRes
, ID
) then e_Draw(ID
, FX
, FY
, 0, True, False);
3103 if g_Texture_Get(FImageRes
, ID
) then e_Draw(ID
, FX
, FY
, 0, True, False);
3106 procedure TGUIimage
.OnMessage(var Msg
: TMessage
);
3111 procedure TGUIimage
.SetImage(Res
: string);
3115 if g_Texture_CreateWADEx(Res
, Res
) then FImageRes
:= Res
;
3118 procedure TGUIimage
.Update();