1 (* Copyright (C) DooM 2D:Forever Developers
3 * This program is free software: you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation, either version 3 of the License, or
6 * (at your option) any later version.
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
22 e_graphics
, e_input
, g_playermodel
, g_basic
, MAPSTRUCT
, wadreader
;
25 MAINMENU_HEADER_COLOR
: TRGB
= (R
:255; G
:255; B
:255);
26 MAINMENU_ITEMS_COLOR
: TRGB
= (R
:255; G
:255; B
:255);
27 MAINMENU_UNACTIVEITEMS_COLOR
: TRGB
= (R
:192; G
:192; B
:192);
28 MAINMENU_CLICKSOUND
= 'MENU_SELECT';
29 MAINMENU_CHANGESOUND
= 'MENU_CHANGE';
31 MAINMENU_MARKER1
= 'MAINMENU_MARKER1';
32 MAINMENU_MARKER2
= 'MAINMENU_MARKER2';
33 MAINMENU_MARKERDELAY
= 24;
34 WINDOW_CLOSESOUND
= 'MENU_CLOSE';
35 MENU_HEADERCOLOR
: TRGB
= (R
:255; G
:255; B
:255);
36 MENU_ITEMSTEXT_COLOR
: TRGB
= (R
:255; G
:255; B
:255);
37 MENU_UNACTIVEITEMS_COLOR
: TRGB
= (R
:128; G
:128; B
:128);
38 MENU_ITEMSCTRL_COLOR
: TRGB
= (R
:255; G
:0; B
:0);
41 MENU_CLICKSOUND
= 'MENU_SELECT';
42 MENU_CHANGESOUND
= 'MENU_CHANGE';
43 MENU_MARKERDELAY
= 24;
44 SCROLL_LEFT
= 'SCROLL_LEFT';
45 SCROLL_RIGHT
= 'SCROLL_RIGHT';
46 SCROLL_MIDDLE
= 'SCROLL_MIDDLE';
47 SCROLL_MARKER
= 'SCROLL_MARKER';
48 SCROLL_ADDSOUND
= 'SCROLL_ADD';
49 SCROLL_SUBSOUND
= 'SCROLL_SUB';
50 EDIT_LEFT
= 'EDIT_LEFT';
51 EDIT_RIGHT
= 'EDIT_RIGHT';
52 EDIT_MIDDLE
= 'EDIT_MIDDLE';
53 EDIT_CURSORCOLOR
: TRGB
= (R
:200; G
:0; B
:0);
55 KEYREAD_QUERY
= '<...>';
56 KEYREAD_CLEAR
= '???';
59 MAPPREVIEW_HEIGHT
= 8;
69 BSCROLL_UPA
= 'BSCROLL_UP_A';
70 BSCROLL_UPU
= 'BSCROLL_UP_U';
71 BSCROLL_DOWNA
= 'BSCROLL_DOWN_A';
72 BSCROLL_DOWNU
= 'BSCROLL_DOWN_U';
73 BSCROLL_MIDDLE
= 'BSCROLL_MIDDLE';
85 TFontType
= (FONT_TEXTURE
, FONT_CHAR
);
87 TFont
= class(TObject
)
93 constructor Create(FontID
: DWORD
; FontType
: TFontType
);
94 destructor Destroy
; override;
95 procedure Draw(X
, Y
: Integer; Text: string; R
, G
, B
: Byte);
96 procedure GetTextSize(Text: string; var w
, h
: Word);
97 property Scale
: Single read FScale write FScale
;
103 TOnKeyDownEvent
= procedure(Key
: Byte);
104 TOnKeyDownEventEx
= procedure(win
: TGUIWindow
; Key
: Byte);
105 TOnCloseEvent
= procedure;
106 TOnShowEvent
= procedure;
107 TOnClickEvent
= procedure;
108 TOnChangeEvent
= procedure(Sender
: TGUIControl
);
109 TOnEnterEvent
= procedure(Sender
: TGUIControl
);
115 FWindow
: TGUIWindow
;
120 procedure OnMessage(var Msg
: TMessage
); virtual;
121 procedure Update
; virtual;
122 procedure Draw
; virtual;
123 property X
: Integer read FX write FX
;
124 property Y
: Integer read FY write FY
;
125 property Enabled
: Boolean read FEnabled write FEnabled
;
126 property Name
: string read FName write FName
;
127 property UserData
: Pointer read FUserData write FUserData
;
132 FActiveControl
: TGUIControl
;
134 FPrevWindow
: TGUIWindow
;
136 FBackTexture
: string;
137 FMainWindow
: Boolean;
138 FOnKeyDown
: TOnKeyDownEvent
;
139 FOnKeyDownEx
: TOnKeyDownEventEx
;
140 FOnCloseEvent
: TOnCloseEvent
;
141 FOnShowEvent
: TOnShowEvent
;
144 Childs
: array of TGUIControl
;
145 constructor Create(Name
: string);
146 destructor Destroy
; override;
147 function AddChild(Child
: TGUIControl
): TGUIControl
;
148 procedure OnMessage(var Msg
: TMessage
);
151 procedure SetActive(Control
: TGUIControl
);
152 function GetControl(Name
: string): TGUIControl
;
153 property OnKeyDown
: TOnKeyDownEvent read FOnKeyDown write FOnKeyDown
;
154 property OnKeyDownEx
: TOnKeyDownEventEx read FOnKeyDownEx write FOnKeyDownEx
;
155 property OnClose
: TOnCloseEvent read FOnCloseEvent write FOnCloseEvent
;
156 property OnShow
: TOnShowEvent read FOnShowEvent write FOnShowEvent
;
157 property Name
: string read FName
;
158 property DefControl
: string read FDefControl write FDefControl
;
159 property BackTexture
: string read FBackTexture write FBackTexture
;
160 property MainWindow
: Boolean read FMainWindow write FMainWindow
;
161 property UserData
: Pointer read FUserData write FUserData
;
164 TGUITextButton
= class(TGUIControl
)
173 ProcEx
: procedure (sender
: TGUITextButton
);
174 constructor Create(Proc
: Pointer; FontID
: DWORD
; Text: string);
175 destructor Destroy(); override;
176 procedure OnMessage(var Msg
: TMessage
); override;
177 procedure Update(); override;
178 procedure Draw(); override;
179 function GetWidth(): Integer;
180 function GetHeight(): Integer;
181 procedure Click(Silent
: Boolean = False);
182 property Caption
: string read FText write FText
;
183 property Color
: TRGB read FColor write FColor
;
184 property Font
: TFont read FFont write FFont
;
185 property ShowWindow
: string read FShowWindow write FShowWindow
;
188 TGUILabel
= class(TGUIControl
)
194 FOnClickEvent
: TOnClickEvent
;
196 constructor Create(Text: string; FontID
: DWORD
);
197 procedure OnMessage(var Msg
: TMessage
); override;
198 procedure Draw
; override;
199 function GetWidth
: Integer;
200 function GetHeight
: Integer;
201 property OnClick
: TOnClickEvent read FOnClickEvent write FOnClickEvent
;
202 property FixedLength
: Word read FFixedLen write FFixedLen
;
203 property Text: string read FText write FText
;
204 property Color
: TRGB read FColor write FColor
;
205 property Font
: TFont read FFont write FFont
;
208 TGUIScroll
= class(TGUIControl
)
216 FOnChangeEvent
: TOnChangeEvent
;
217 procedure FSetValue(a
: Integer);
219 constructor Create();
220 procedure OnMessage(var Msg
: TMessage
); override;
221 procedure Update
; override;
222 procedure Draw
; override;
223 function GetWidth(): Word;
224 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
225 property Max
: Word read FMax write FMax
;
226 property Value
: Integer read FValue write FSetValue
;
229 TGUISwitch
= class(TGUIControl
)
232 FItems
: array of string;
235 FOnChangeEvent
: TOnChangeEvent
;
237 constructor Create(FontID
: DWORD
);
238 procedure OnMessage(var Msg
: TMessage
); override;
239 procedure AddItem(Item
: string);
240 procedure Update
; override;
241 procedure Draw
; override;
242 function GetWidth(): Word;
243 function GetText
: string;
244 property ItemIndex
: Integer read FIndex write FIndex
;
245 property Color
: TRGB read FColor write FColor
;
246 property Font
: TFont read FFont write FFont
;
247 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
250 TGUIEdit
= class(TGUIControl
)
258 FOnlyDigits
: Boolean;
262 FOnChangeEvent
: TOnChangeEvent
;
263 FOnEnterEvent
: TOnEnterEvent
;
264 procedure SetText(Text: string);
266 constructor Create(FontID
: DWORD
);
267 procedure OnMessage(var Msg
: TMessage
); override;
268 procedure Update
; override;
269 procedure Draw
; override;
270 function GetWidth(): Word;
271 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
272 property OnEnter
: TOnEnterEvent read FOnEnterEvent write FOnEnterEvent
;
273 property Width
: Word read FWidth write FWidth
;
274 property MaxLength
: Word read FMaxLength write FMaxLength
;
275 property OnlyDigits
: Boolean read FOnlyDigits write FOnlyDigits
;
276 property Text: string read FText write SetText
;
277 property Color
: TRGB read FColor write FColor
;
278 property Font
: TFont read FFont write FFont
;
281 TGUIKeyRead
= class(TGUIControl
)
288 constructor Create(FontID
: DWORD
);
289 procedure OnMessage(var Msg
: TMessage
); override;
290 procedure Draw
; override;
291 function GetWidth(): Word;
292 property Key
: Word read FKey write FKey
;
293 property Color
: TRGB read FColor write FColor
;
294 property Font
: TFont read FFont write FFont
;
297 TGUIModelView
= class(TGUIControl
)
299 FModel
: TPlayerModel
;
303 destructor Destroy
; override;
304 procedure OnMessage(var Msg
: TMessage
); override;
305 procedure SetModel(ModelName
: string);
306 procedure SetColor(Red
, Green
, Blue
: Byte);
307 procedure NextAnim();
308 procedure NextWeapon();
309 procedure Update
; override;
310 procedure Draw
; override;
311 property Model
: TPlayerModel read FModel
;
314 TPreviewPanel
= record
315 X1
, Y1
, X2
, Y2
: Integer;
319 TGUIMapPreview
= class(TGUIControl
)
321 FMapData
: array of TPreviewPanel
;
325 constructor Create();
326 destructor Destroy(); override;
327 procedure OnMessage(var Msg
: TMessage
); override;
328 procedure SetMap(Res
: string);
329 procedure ClearMap();
330 procedure Update(); override;
331 procedure Draw(); override;
332 function GetScaleStr
: String;
335 TGUIImage
= class(TGUIControl
)
340 constructor Create();
341 destructor Destroy(); override;
342 procedure OnMessage(var Msg
: TMessage
); override;
343 procedure SetImage(Res
: string);
344 procedure ClearImage();
345 procedure Update(); override;
346 procedure Draw(); override;
347 property DefaultRes
: string read FDefaultRes write FDefaultRes
;
350 TGUIListBox
= class(TGUIControl
)
354 FUnActiveColor
: TRGB
;
362 FDrawScroll
: Boolean;
363 FOnChangeEvent
: TOnChangeEvent
;
365 procedure FSetItems(Items
: SArray
);
366 procedure FSetIndex(aIndex
: Integer);
369 constructor Create(FontID
: DWORD
; Width
, Height
: Word);
370 procedure OnMessage(var Msg
: TMessage
); override;
371 procedure Draw(); override;
372 procedure AddItem(Item
: String);
373 procedure SelectItem(Item
: String);
375 function GetWidth(): Word;
376 function GetHeight(): Word;
377 function SelectedItem(): String;
379 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
380 property Sort
: Boolean read FSort write FSort
;
381 property ItemIndex
: Integer read FIndex write FSetIndex
;
382 property Items
: SArray read FItems write FSetItems
;
383 property DrawBack
: Boolean read FDrawBack write FDrawBack
;
384 property DrawScrollBar
: Boolean read FDrawScroll write FDrawScroll
;
385 property ActiveColor
: TRGB read FActiveColor write FActiveColor
;
386 property UnActiveColor
: TRGB read FUnActiveColor write FUnActiveColor
;
387 property Font
: TFont read FFont write FFont
;
390 TGUIFileListBox
= class (TGUIListBox
)
397 procedure OpenDir(path
: String);
400 procedure OnMessage(var Msg
: TMessage
); override;
401 procedure SetBase(path
: String);
402 function SelectedItem(): String;
403 procedure UpdateFileList();
405 property Dirs
: Boolean read FDirs write FDirs
;
406 property FileMask
: String read FFileMask write FFileMask
;
407 property Path
: String read FPath
;
410 TGUIMemo
= class(TGUIControl
)
419 FDrawScroll
: Boolean;
421 constructor Create(FontID
: DWORD
; Width
, Height
: Word);
422 procedure OnMessage(var Msg
: TMessage
); override;
423 procedure Draw
; override;
425 function GetWidth(): Word;
426 function GetHeight(): Word;
427 procedure SetText(Text: string);
428 property DrawBack
: Boolean read FDrawBack write FDrawBack
;
429 property DrawScrollBar
: Boolean read FDrawScroll write FDrawScroll
;
430 property Color
: TRGB read FColor write FColor
;
431 property Font
: TFont read FFont write FFont
;
434 TGUIMainMenu
= class(TGUIControl
)
436 FButtons
: array of TGUITextButton
;
444 constructor Create(FontID
: DWORD
; Header
: string);
445 destructor Destroy
; override;
446 procedure OnMessage(var Msg
: TMessage
); override;
447 function AddButton(fProc
: Pointer; Caption
: string; ShowWindow
: string = ''): TGUITextButton
;
448 function GetButton(Name
: string): TGUITextButton
;
449 procedure EnableButton(Name
: string; e
: Boolean);
450 procedure AddSpace();
451 procedure Update
; override;
452 procedure Draw
; override;
455 TControlType
= class of TGUIControl
;
457 PMenuItem
= ^TMenuItem
;
460 ControlType
: TControlType
;
461 Control
: TGUIControl
;
464 TGUIMenu
= class(TGUIControl
)
466 FItems
: array of TMenuItem
;
474 function NewItem(): Integer;
476 constructor Create(HeaderFont
, ItemsFont
: DWORD
; Header
: string);
477 destructor Destroy
; override;
478 procedure OnMessage(var Msg
: TMessage
); override;
479 procedure AddSpace();
480 procedure AddLine(fText
: string);
481 procedure AddText(fText
: string; MaxWidth
: Word);
482 function AddLabel(fText
: string): TGUILabel
;
483 function AddButton(Proc
: Pointer; fText
: string; _ShowWindow
: string = ''): TGUITextButton
;
484 function AddScroll(fText
: string): TGUIScroll
;
485 function AddSwitch(fText
: string): TGUISwitch
;
486 function AddEdit(fText
: string): TGUIEdit
;
487 function AddKeyRead(fText
: string): TGUIKeyRead
;
488 function AddList(fText
: string; Width
, Height
: Word): TGUIListBox
;
489 function AddFileList(fText
: string; Width
, Height
: Word): TGUIFileListBox
;
490 function AddMemo(fText
: string; Width
, Height
: Word): TGUIMemo
;
492 function GetControl(Name
: string): TGUIControl
;
493 function GetControlsText(Name
: string): TGUILabel
;
494 procedure Draw
; override;
495 procedure Update
; override;
496 procedure UpdateIndex();
497 property Align
: Boolean read FAlign write FAlign
;
498 property Left
: Integer read FLeft write FLeft
;
499 property YesNo
: Boolean read FYesNo write FYesNo
;
503 g_GUIWindows
: array of TGUIWindow
;
504 g_ActiveWindow
: TGUIWindow
= nil;
506 procedure g_GUI_Init();
507 function g_GUI_AddWindow(Window
: TGUIWindow
): TGUIWindow
;
508 function g_GUI_GetWindow(Name
: string): TGUIWindow
;
509 procedure g_GUI_ShowWindow(Name
: string);
510 procedure g_GUI_HideWindow(PlaySound
: Boolean = True);
511 function g_GUI_Destroy(): Boolean;
512 procedure g_GUI_SaveMenuPos();
513 procedure g_GUI_LoadMenuPos();
518 GL
, GLExt
, g_textures
, g_sound
, SysUtils
,
519 g_game
, Math
, StrUtils
, g_player
, g_options
, MAPREADER
,
520 g_map
, MAPDEF
, g_weapons
;
523 Box
: Array [0..8] of DWORD
;
524 Saved_Windows
: SArray
;
526 procedure g_GUI_Init();
528 g_Texture_Get(BOX1
, Box
[0]);
529 g_Texture_Get(BOX2
, Box
[1]);
530 g_Texture_Get(BOX3
, Box
[2]);
531 g_Texture_Get(BOX4
, Box
[3]);
532 g_Texture_Get(BOX5
, Box
[4]);
533 g_Texture_Get(BOX6
, Box
[5]);
534 g_Texture_Get(BOX7
, Box
[6]);
535 g_Texture_Get(BOX8
, Box
[7]);
536 g_Texture_Get(BOX9
, Box
[8]);
539 function g_GUI_Destroy(): Boolean;
543 Result
:= (Length(g_GUIWindows
) > 0);
545 for i
:= 0 to High(g_GUIWindows
) do
546 g_GUIWindows
[i
].Free();
549 g_ActiveWindow
:= nil;
552 function g_GUI_AddWindow(Window
: TGUIWindow
): TGUIWindow
;
554 SetLength(g_GUIWindows
, Length(g_GUIWindows
)+1);
555 g_GUIWindows
[High(g_GUIWindows
)] := Window
;
560 function g_GUI_GetWindow(Name
: string): TGUIWindow
;
566 if g_GUIWindows
<> nil then
567 for i
:= 0 to High(g_GUIWindows
) do
568 if g_GUIWindows
[i
].FName
= Name
then
570 Result
:= g_GUIWindows
[i
];
574 Assert(Result
<> nil, 'GUI_Window "'+Name
+'" not found');
577 procedure g_GUI_ShowWindow(Name
: string);
581 if g_GUIWindows
= nil then
584 for i
:= 0 to High(g_GUIWindows
) do
585 if g_GUIWindows
[i
].FName
= Name
then
587 g_GUIWindows
[i
].FPrevWindow
:= g_ActiveWindow
;
588 g_ActiveWindow
:= g_GUIWindows
[i
];
590 if g_ActiveWindow
.MainWindow
then
591 g_ActiveWindow
.FPrevWindow
:= nil;
593 if g_ActiveWindow
.FDefControl
<> '' then
594 g_ActiveWindow
.SetActive(g_ActiveWindow
.GetControl(g_ActiveWindow
.FDefControl
))
596 g_ActiveWindow
.SetActive(nil);
598 if @g_ActiveWindow
.FOnShowEvent
<> nil then
599 g_ActiveWindow
.FOnShowEvent();
605 procedure g_GUI_HideWindow(PlaySound
: Boolean = True);
607 if g_ActiveWindow
<> nil then
609 if @g_ActiveWindow
.OnClose
<> nil then
610 g_ActiveWindow
.OnClose();
611 g_ActiveWindow
:= g_ActiveWindow
.FPrevWindow
;
613 g_Sound_PlayEx(WINDOW_CLOSESOUND
);
617 procedure g_GUI_SaveMenuPos();
622 SetLength(Saved_Windows
, 0);
623 win
:= g_ActiveWindow
;
627 len
:= Length(Saved_Windows
);
628 SetLength(Saved_Windows
, len
+ 1);
630 Saved_Windows
[len
] := win
.Name
;
632 if win
.MainWindow
then
635 win
:= win
.FPrevWindow
;
639 procedure g_GUI_LoadMenuPos();
641 i
, j
, k
, len
: Integer;
644 g_ActiveWindow
:= nil;
645 len
:= Length(Saved_Windows
);
650 // Îêíî ñ ãëàâíûì ìåíþ:
651 g_GUI_ShowWindow(Saved_Windows
[len
-1]);
653 // Íå ïåðåêëþ÷èëîñü (èëè íåêóäà äàëüøå):
654 if (len
= 1) or (g_ActiveWindow
= nil) then
657 // Èùåì êíîïêè â îñòàëüíûõ îêíàõ:
658 for k
:= len
-1 downto 1 do
662 for i
:= 0 to Length(g_ActiveWindow
.Childs
)-1 do
664 if g_ActiveWindow
.Childs
[i
] is TGUIMainMenu
then
665 begin // GUI_MainMenu
666 with TGUIMainMenu(g_ActiveWindow
.Childs
[i
]) do
667 for j
:= 0 to Length(FButtons
)-1 do
668 if FButtons
[j
].ShowWindow
= Saved_Windows
[k
-1] then
670 FButtons
[j
].Click(True);
676 if g_ActiveWindow
.Childs
[i
] is TGUIMenu
then
677 with TGUIMenu(g_ActiveWindow
.Childs
[i
]) do
678 for j
:= 0 to Length(FItems
)-1 do
679 if FItems
[j
].ControlType
= TGUITextButton
then
680 if TGUITextButton(FItems
[j
].Control
).ShowWindow
= Saved_Windows
[k
-1] then
682 TGUITextButton(FItems
[j
].Control
).Click(True);
693 (g_ActiveWindow
.Name
= Saved_Windows
[k
]) then
698 procedure DrawBox(X
, Y
: Integer; Width
, Height
: Word);
700 e_Draw(Box
[0], X
, Y
, 0, False, False);
701 e_DrawFill(Box
[1], X
+4, Y
, Width
*4, 1, 0, False, False);
702 e_Draw(Box
[2], X
+4+Width
*16, Y
, 0, False, False);
703 e_DrawFill(Box
[3], X
, Y
+4, 1, Height
*4, 0, False, False);
704 e_DrawFill(Box
[4], X
+4, Y
+4, Width
, Height
, 0, False, False);
705 e_DrawFill(Box
[5], X
+4+Width
*16, Y
+4, 1, Height
*4, 0, False, False);
706 e_Draw(Box
[6], X
, Y
+4+Height
*16, 0, False, False);
707 e_DrawFill(Box
[7], X
+4, Y
+4+Height
*16, Width
*4, 1, 0, False, False);
708 e_Draw(Box
[8], X
+4+Width
*16, Y
+4+Height
*16, 0, False, False);
711 procedure DrawScroll(X
, Y
: Integer; Height
: Word; Up
, Down
: Boolean);
715 if Height
< 3 then Exit
;
718 g_Texture_Get(BSCROLL_UPA
, ID
)
720 g_Texture_Get(BSCROLL_UPU
, ID
);
721 e_Draw(ID
, X
, Y
, 0, False, False);
724 g_Texture_Get(BSCROLL_DOWNA
, ID
)
726 g_Texture_Get(BSCROLL_DOWNU
, ID
);
727 e_Draw(ID
, X
, Y
+(Height
-1)*16, 0, False, False);
729 g_Texture_Get(BSCROLL_MIDDLE
, ID
);
730 e_DrawFill(ID
, X
, Y
+16, 1, Height
-2, 0, False, False);
735 constructor TGUIWindow
.Create(Name
: string);
738 FActiveControl
:= nil;
742 FOnCloseEvent
:= nil;
746 destructor TGUIWindow
.Destroy
;
753 for i
:= 0 to High(Childs
) do
757 function TGUIWindow
.AddChild(Child
: TGUIControl
): TGUIControl
;
759 Child
.FWindow
:= Self
;
761 SetLength(Childs
, Length(Childs
) + 1);
762 Childs
[High(Childs
)] := Child
;
767 procedure TGUIWindow
.Update
;
771 for i
:= 0 to High(Childs
) do
772 if Childs
[i
] <> nil then Childs
[i
].Update
;
775 procedure TGUIWindow
.Draw
;
780 if FBackTexture
<> '' then
781 if g_Texture_Get(FBackTexture
, ID
) then
782 e_DrawSize(ID
, 0, 0, 0, False, False, gScreenWidth
, gScreenHeight
)
784 e_Clear(GL_COLOR_BUFFER_BIT
, 0.5, 0.5, 0.5);
786 for i
:= 0 to High(Childs
) do
787 if Childs
[i
] <> nil then Childs
[i
].Draw
;
790 procedure TGUIWindow
.OnMessage(var Msg
: TMessage
);
792 if FActiveControl
<> nil then FActiveControl
.OnMessage(Msg
);
793 if @FOnKeyDown
<> nil then FOnKeyDown(Msg
.wParam
);
794 if @FOnKeyDownEx
<> nil then FOnKeyDownEx(self
, Msg
.wParam
);
796 if Msg
.Msg
= WM_KEYDOWN
then
797 if Msg
.wParam
= IK_ESCAPE
then
804 procedure TGUIWindow
.SetActive(Control
: TGUIControl
);
806 FActiveControl
:= Control
;
809 function TGUIWindow
.GetControl(Name
: String): TGUIControl
;
815 if Childs
<> nil then
816 for i
:= 0 to High(Childs
) do
817 if Childs
[i
] <> nil then
818 if LowerCase(Childs
[i
].FName
) = LowerCase(Name
) then
824 Assert(Result
<> nil, 'Window Control "'+Name
+'" not Found!');
829 constructor TGUIControl
.Create();
837 procedure TGUIControl
.OnMessage(var Msg
: TMessage
);
843 procedure TGUIControl
.Update();
848 procedure TGUIControl
.Draw();
855 procedure TGUITextButton
.Click(Silent
: Boolean = False);
857 if (FSound
<> '') and (not Silent
) then g_Sound_PlayEx(FSound
);
859 if @Proc
<> nil then Proc();
860 if @ProcEx
<> nil then ProcEx(self
);
862 if FShowWindow
<> '' then g_GUI_ShowWindow(FShowWindow
);
865 constructor TGUITextButton
.Create(Proc
: Pointer; FontID
: DWORD
; Text: string);
872 FFont
:= TFont
.Create(FontID
, FONT_CHAR
);
877 destructor TGUITextButton
.Destroy
;
883 procedure TGUITextButton
.Draw
;
885 FFont
.Draw(FX
, FY
, FText
, FColor
.R
, FColor
.G
, FColor
.B
)
888 function TGUITextButton
.GetHeight
: Integer;
892 FFont
.GetTextSize(FText
, w
, h
);
896 function TGUITextButton
.GetWidth
: Integer;
900 FFont
.GetTextSize(FText
, w
, h
);
904 procedure TGUITextButton
.OnMessage(var Msg
: TMessage
);
906 if not FEnabled
then Exit
;
913 IK_RETURN
, IK_KPRETURN
: Click();
918 procedure TGUITextButton
.Update
;
925 constructor TFont
.Create(FontID
: DWORD
; FontType
: TFontType
);
930 FFontType
:= FontType
;
933 destructor TFont
.Destroy
;
939 procedure TFont
.Draw(X
, Y
: Integer; Text: string; R
, G
, B
: Byte);
941 if FFontType
= FONT_CHAR
then e_CharFont_PrintEx(ID
, X
, Y
, Text, _RGB(R
, G
, B
), FScale
)
942 else e_TextureFontPrintEx(X
, Y
, Text, ID
, R
, G
, B
, FScale
);
945 procedure TFont
.GetTextSize(Text: string; var w
, h
: Word);
949 if FFontType
= FONT_CHAR
then e_CharFont_GetSize(ID
, Text, w
, h
)
952 e_TextureFontGetSize(ID
, cw
, ch
);
953 w
:= cw
*Length(Text);
957 w
:= Round(w
*FScale
);
958 h
:= Round(h
*FScale
);
963 function TGUIMainMenu
.AddButton(fProc
: Pointer; Caption
: string; ShowWindow
: string = ''): TGUITextButton
;
970 SetLength(FButtons
, Length(FButtons
)+1);
971 FButtons
[High(FButtons
)] := TGUITextButton
.Create(fProc
, FFontID
, Caption
);
972 FButtons
[High(FButtons
)].ShowWindow
:= ShowWindow
;
973 with FButtons
[High(FButtons
)] do
975 if (fProc
<> nil) or (ShowWindow
<> '') then FColor
:= MAINMENU_ITEMS_COLOR
976 else FColor
:= MAINMENU_UNACTIVEITEMS_COLOR
;
977 FSound
:= MAINMENU_CLICKSOUND
;
980 _x
:= gScreenWidth
div 2;
982 for a
:= 0 to High(FButtons
) do
983 if FButtons
[a
] <> nil then
984 _x
:= Min(_x
, (gScreenWidth
div 2)-(FButtons
[a
].GetWidth
div 2));
986 hh
:= FHeader
.GetHeight
;
988 h
:= hh
*(2+Length(FButtons
))+MAINMENU_SPACE
*(Length(FButtons
)-1);
989 h
:= (gScreenHeight
div 2)-(h
div 2);
999 for a
:= 0 to High(FButtons
) do
1001 if FButtons
[a
] <> nil then
1008 Inc(h
, hh
+MAINMENU_SPACE
);
1011 Result
:= FButtons
[High(FButtons
)];
1014 procedure TGUIMainMenu
.AddSpace
;
1016 SetLength(FButtons
, Length(FButtons
)+1);
1017 FButtons
[High(FButtons
)] := nil;
1020 constructor TGUIMainMenu
.Create(FontID
: DWORD
; Header
: string);
1026 FCounter
:= MAINMENU_MARKERDELAY
;
1028 g_Texture_Get(MAINMENU_MARKER1
, FMarkerID1
);
1029 g_Texture_Get(MAINMENU_MARKER2
, FMarkerID2
);
1031 FHeader
:= TGUILabel
.Create(Header
, FFontID
);
1034 FColor
:= MAINMENU_HEADER_COLOR
;
1035 FX
:= (gScreenWidth
div 2)-(GetWidth
div 2);
1036 FY
:= (gScreenHeight
div 2)-(GetHeight
div 2);
1040 destructor TGUIMainMenu
.Destroy
;
1044 if FButtons
<> nil then
1045 for a
:= 0 to High(FButtons
) do
1053 procedure TGUIMainMenu
.Draw
;
1061 if FButtons
<> nil then
1063 for a
:= 0 to High(FButtons
) do
1064 if FButtons
[a
] <> nil then FButtons
[a
].Draw
;
1066 if FIndex
<> -1 then
1067 e_Draw(FMarkerID1
, FButtons
[FIndex
].FX
-48, FButtons
[FIndex
].FY
, 0, True, False);
1071 procedure TGUIMainMenu
.EnableButton(Name
: string; e
: Boolean);
1075 if FButtons
= nil then Exit
;
1077 for a
:= 0 to High(FButtons
) do
1078 if (FButtons
[a
] <> nil) and (FButtons
[a
].Name
= Name
) then
1080 if e
then FButtons
[a
].FColor
:= MAINMENU_ITEMS_COLOR
1081 else FButtons
[a
].FColor
:= MAINMENU_UNACTIVEITEMS_COLOR
;
1082 FButtons
[a
].Enabled
:= e
;
1087 function TGUIMainMenu
.GetButton(Name
: string): TGUITextButton
;
1093 if FButtons
= nil then Exit
;
1095 for a
:= 0 to High(FButtons
) do
1096 if (FButtons
[a
] <> nil) and (FButtons
[a
].Name
= Name
) then
1098 Result
:= FButtons
[a
];
1103 procedure TGUIMainMenu
.OnMessage(var Msg
: TMessage
);
1108 if not FEnabled
then Exit
;
1112 if FButtons
= nil then Exit
;
1115 for a
:= 0 to High(FButtons
) do
1116 if FButtons
[a
] <> nil then
1122 if not ok
then Exit
;
1131 if FIndex
< 0 then FIndex
:= High(FButtons
);
1132 until FButtons
[FIndex
] <> nil;
1134 g_Sound_PlayEx(MENU_CHANGESOUND
);
1140 if FIndex
> High(FButtons
) then FIndex
:= 0;
1141 until FButtons
[FIndex
] <> nil;
1143 g_Sound_PlayEx(MENU_CHANGESOUND
);
1145 IK_RETURN
, IK_KPRETURN
: if (FIndex
<> -1) and FButtons
[FIndex
].FEnabled
then FButtons
[FIndex
].Click
;
1150 procedure TGUIMainMenu
.Update
;
1156 if FCounter
= 0 then
1159 FMarkerID1
:= FMarkerID2
;
1162 FCounter
:= MAINMENU_MARKERDELAY
;
1163 end else Dec(FCounter
);
1168 constructor TGUILabel
.Create(Text: string; FontID
: DWORD
);
1172 FFont
:= TFont
.Create(FontID
, FONT_CHAR
);
1176 FOnClickEvent
:= nil;
1179 procedure TGUILabel
.Draw
;
1181 FFont
.Draw(FX
, FY
, FText
, FColor
.R
, FColor
.G
, FColor
.B
);
1184 function TGUILabel
.GetHeight
: Integer;
1188 FFont
.GetTextSize(FText
, w
, h
);
1192 function TGUILabel
.GetWidth
: Integer;
1196 if FFixedLen
= 0 then
1197 FFont
.GetTextSize(FText
, w
, h
)
1199 w
:= e_CharFont_GetMaxWidth(FFont
.ID
)*FFixedLen
;
1203 procedure TGUILabel
.OnMessage(var Msg
: TMessage
);
1205 if not FEnabled
then Exit
;
1212 IK_RETURN
, IK_KPRETURN
: if @FOnClickEvent
<> nil then FOnClickEvent();
1219 function TGUIMenu
.AddButton(Proc
: Pointer; fText
: string; _ShowWindow
: string = ''): TGUITextButton
;
1226 Control
:= TGUITextButton
.Create(Proc
, FFontID
, fText
);
1227 with Control
as TGUITextButton
do
1229 ShowWindow
:= _ShowWindow
;
1230 FColor
:= MENU_ITEMSCTRL_COLOR
;
1234 ControlType
:= TGUITextButton
;
1236 Result
:= (Control
as TGUITextButton
);
1239 if FIndex
= -1 then FIndex
:= i
;
1244 procedure TGUIMenu
.AddLine(fText
: string);
1251 Text := TGUILabel
.Create(fText
, FFontID
);
1254 FColor
:= MENU_ITEMSTEXT_COLOR
;
1263 procedure TGUIMenu
.AddText(fText
: string; MaxWidth
: Word);
1268 l
:= GetLines(fText
, FFontID
, MaxWidth
);
1270 if l
= nil then Exit
;
1272 for a
:= 0 to High(l
) do
1277 Text := TGUILabel
.Create(l
[a
], FFontID
);
1280 with Text do begin FColor
:= _RGB(255, 0, 0); end;
1284 with Text do begin FColor
:= MENU_ITEMSTEXT_COLOR
; end;
1294 procedure TGUIMenu
.AddSpace
;
1308 constructor TGUIMenu
.Create(HeaderFont
, ItemsFont
: DWORD
; Header
: string);
1314 FFontID
:= ItemsFont
;
1315 FCounter
:= MENU_MARKERDELAY
;
1319 FHeader
:= TGUILabel
.Create(Header
, HeaderFont
);
1322 FX
:= (gScreenWidth
div 2)-(GetWidth
div 2);
1324 FColor
:= MAINMENU_HEADER_COLOR
;
1328 destructor TGUIMenu
.Destroy
;
1332 if FItems
<> nil then
1333 for a
:= 0 to High(FItems
) do
1347 procedure TGUIMenu
.Draw
;
1353 if FHeader
<> nil then FHeader
.Draw
;
1355 if FItems
<> nil then
1356 for a
:= 0 to High(FItems
) do
1358 if FItems
[a
].Text <> nil then FItems
[a
].Text.Draw
;
1359 if FItems
[a
].Control
<> nil then FItems
[a
].Control
.Draw
;
1362 if (FIndex
<> -1) and (FCounter
> MENU_MARKERDELAY
div 2) then
1367 if FItems
[FIndex
].Text <> nil then
1369 x
:= FItems
[FIndex
].Text.FX
;
1370 y
:= FItems
[FIndex
].Text.FY
;
1372 else if FItems
[FIndex
].Control
<> nil then
1374 x
:= FItems
[FIndex
].Control
.FX
;
1375 y
:= FItems
[FIndex
].Control
.FY
;
1378 x
:= x
-e_CharFont_GetMaxWidth(FFontID
);
1380 e_CharFont_PrintEx(FFontID
, x
, y
, #16, _RGB(255, 0, 0));
1384 function TGUIMenu
.GetControl(Name
: String): TGUIControl
;
1390 if FItems
<> nil then
1391 for a
:= 0 to High(FItems
) do
1392 if FItems
[a
].Control
<> nil then
1393 if LowerCase(FItems
[a
].Control
.Name
) = LowerCase(Name
) then
1395 Result
:= FItems
[a
].Control
;
1399 Assert(Result
<> nil, 'GUI control "'+Name
+'" not found!');
1402 function TGUIMenu
.GetControlsText(Name
: String): TGUILabel
;
1408 if FItems
<> nil then
1409 for a
:= 0 to High(FItems
) do
1410 if FItems
[a
].Control
<> nil then
1411 if LowerCase(FItems
[a
].Control
.Name
) = LowerCase(Name
) then
1413 Result
:= FItems
[a
].Text;
1417 Assert(Result
<> nil, 'GUI control''s text "'+Name
+'" not found!');
1420 function TGUIMenu
.NewItem
: Integer;
1422 SetLength(FItems
, Length(FItems
)+1);
1423 Result
:= High(FItems
);
1426 procedure TGUIMenu
.OnMessage(var Msg
: TMessage
);
1431 if not FEnabled
then Exit
;
1435 if FItems
= nil then Exit
;
1438 for a
:= 0 to High(FItems
) do
1439 if FItems
[a
].Control
<> nil then
1445 if not ok
then Exit
;
1456 if c
> Length(FItems
) then
1463 if FIndex
< 0 then FIndex
:= High(FItems
);
1464 until (FItems
[FIndex
].Control
<> nil) and
1465 (FItems
[FIndex
].Control
.Enabled
);
1469 g_Sound_PlayEx(MENU_CHANGESOUND
);
1477 if c
> Length(FItems
) then
1484 if FIndex
> High(FItems
) then FIndex
:= 0;
1485 until (FItems
[FIndex
].Control
<> nil) and
1486 (FItems
[FIndex
].Control
.Enabled
);
1490 g_Sound_PlayEx(MENU_CHANGESOUND
);
1493 IK_LEFT
, IK_RIGHT
, IK_KPLEFT
, IK_KPRIGHT
:
1495 if FIndex
<> -1 then
1496 if FItems
[FIndex
].Control
<> nil then
1497 FItems
[FIndex
].Control
.OnMessage(Msg
);
1499 IK_RETURN
, IK_KPRETURN
:
1501 if FIndex
<> -1 then
1503 if FItems
[FIndex
].Control
<> nil then FItems
[FIndex
].Control
.OnMessage(Msg
);
1505 g_Sound_PlayEx(MENU_CLICKSOUND
);
1509 if FYesNo
and (length(FItems
) > 1) then
1511 Msg
.wParam
:= IK_RETURN
; // to register keypress
1512 FIndex
:= High(FItems
)-1;
1513 if FItems
[FIndex
].Control
<> nil then FItems
[FIndex
].Control
.OnMessage(Msg
);
1516 if FYesNo
and (length(FItems
) > 1) then
1518 Msg
.wParam
:= IK_RETURN
; // to register keypress
1519 FIndex
:= High(FItems
);
1520 if FItems
[FIndex
].Control
<> nil then FItems
[FIndex
].Control
.OnMessage(Msg
);
1527 procedure TGUIMenu
.ReAlign();
1529 a
, tx
, cx
, w
, h
: Integer;
1531 if FItems
= nil then Exit
;
1533 if not FAlign
then tx
:= FLeft
else
1536 for a
:= 0 to High(FItems
) do
1539 if FItems
[a
].Text <> nil then w
:= FItems
[a
].Text.GetWidth
;
1540 if FItems
[a
].Control
<> nil then
1544 if FItems
[a
].ControlType
= TGUILabel
then
1545 w
:= w
+(FItems
[a
].Control
as TGUILabel
).GetWidth
1546 else if FItems
[a
].ControlType
= TGUITextButton
then
1547 w
:= w
+(FItems
[a
].Control
as TGUITextButton
).GetWidth
1548 else if FItems
[a
].ControlType
= TGUIScroll
then
1549 w
:= w
+(FItems
[a
].Control
as TGUIScroll
).GetWidth
1550 else if FItems
[a
].ControlType
= TGUISwitch
then
1551 w
:= w
+(FItems
[a
].Control
as TGUISwitch
).GetWidth
1552 else if FItems
[a
].ControlType
= TGUIEdit
then
1553 w
:= w
+(FItems
[a
].Control
as TGUIEdit
).GetWidth
1554 else if FItems
[a
].ControlType
= TGUIKeyRead
then
1555 w
:= w
+(FItems
[a
].Control
as TGUIKeyRead
).GetWidth
1556 else if (FItems
[a
].ControlType
= TGUIListBox
) then
1557 w
:= w
+(FItems
[a
].Control
as TGUIListBox
).GetWidth
1558 else if (FItems
[a
].ControlType
= TGUIFileListBox
) then
1559 w
:= w
+(FItems
[a
].Control
as TGUIFileListBox
).GetWidth
1560 else if FItems
[a
].ControlType
= TGUIMemo
then
1561 w
:= w
+(FItems
[a
].Control
as TGUIMemo
).GetWidth
;
1564 tx
:= Min(tx
, (gScreenWidth
div 2)-(w
div 2));
1569 for a
:= 0 to High(FItems
) do
1573 if (Text <> nil) and (Control
= nil) then Continue
;
1575 if Text <> nil then w
:= tx
+Text.GetWidth
;
1576 if w
> cx
then cx
:= w
;
1580 cx
:= cx
+MENU_HSPACE
;
1582 h
:= FHeader
.GetHeight
*2+MENU_VSPACE
*(Length(FItems
)-1);
1584 for a
:= 0 to High(FItems
) do
1588 if (ControlType
= TGUIListBox
) or (ControlType
= TGUIFileListBox
) then
1589 h
:= h
+(FItems
[a
].Control
as TGUIListBox
).GetHeight()
1591 h
:= h
+e_CharFont_GetMaxHeight(FFontID
);
1595 h
:= (gScreenHeight
div 2)-(h
div 2);
1599 FX
:= (gScreenWidth
div 2)-(GetWidth
div 2);
1602 Inc(h
, GetHeight
*2);
1605 for a
:= 0 to High(FItems
) do
1615 if Control
<> nil then
1628 if (ControlType
= TGUIListBox
) or (ControlType
= TGUIFileListBox
) then
1629 Inc(h
, (Control
as TGUIListBox
).GetHeight
+MENU_VSPACE
)
1630 else if ControlType
= TGUIMemo
then
1631 Inc(h
, (Control
as TGUIMemo
).GetHeight
+MENU_VSPACE
)
1633 Inc(h
, e_CharFont_GetMaxHeight(FFontID
)+MENU_VSPACE
);
1636 // another ugly hack
1637 if FYesNo
and (length(FItems
) > 1) then
1640 for a
:= High(FItems
)-1 to High(FItems
) do
1642 if (FItems
[a
].Control
<> nil) and (FItems
[a
].ControlType
= TGUITextButton
) then
1644 cx
:= (FItems
[a
].Control
as TGUITextButton
).GetWidth
;
1645 if cx
> w
then w
:= cx
;
1650 for a
:= High(FItems
)-1 to High(FItems
) do
1652 if (FItems
[a
].Control
<> nil) and (FItems
[a
].ControlType
= TGUITextButton
) then
1654 FItems
[a
].Control
.FX
:= (gScreenWidth
-w
) div 2;
1661 function TGUIMenu
.AddScroll(fText
: string): TGUIScroll
;
1668 Control
:= TGUIScroll
.Create();
1670 Text := TGUILabel
.Create(fText
, FFontID
);
1673 FColor
:= MENU_ITEMSTEXT_COLOR
;
1676 ControlType
:= TGUIScroll
;
1678 Result
:= (Control
as TGUIScroll
);
1681 if FIndex
= -1 then FIndex
:= i
;
1686 function TGUIMenu
.AddSwitch(fText
: string): TGUISwitch
;
1693 Control
:= TGUISwitch
.Create(FFontID
);
1694 (Control
as TGUISwitch
).FColor
:= MENU_ITEMSCTRL_COLOR
;
1696 Text := TGUILabel
.Create(fText
, FFontID
);
1699 FColor
:= MENU_ITEMSTEXT_COLOR
;
1702 ControlType
:= TGUISwitch
;
1704 Result
:= (Control
as TGUISwitch
);
1707 if FIndex
= -1 then FIndex
:= i
;
1712 function TGUIMenu
.AddEdit(fText
: string): TGUIEdit
;
1719 Control
:= TGUIEdit
.Create(FFontID
);
1720 with Control
as TGUIEdit
do
1722 FWindow
:= Self
.FWindow
;
1723 FColor
:= MENU_ITEMSCTRL_COLOR
;
1726 if fText
= '' then Text := nil else
1728 Text := TGUILabel
.Create(fText
, FFontID
);
1729 Text.FColor
:= MENU_ITEMSTEXT_COLOR
;
1732 ControlType
:= TGUIEdit
;
1734 Result
:= (Control
as TGUIEdit
);
1737 if FIndex
= -1 then FIndex
:= i
;
1742 procedure TGUIMenu
.Update
;
1748 if FCounter
= 0 then FCounter
:= MENU_MARKERDELAY
else Dec(FCounter
);
1750 if FItems
<> nil then
1751 for a
:= 0 to High(FItems
) do
1752 if FItems
[a
].Control
<> nil then
1753 (FItems
[a
].Control
as FItems
[a
].ControlType
).Update
;
1756 function TGUIMenu
.AddKeyRead(fText
: string): TGUIKeyRead
;
1763 Control
:= TGUIKeyRead
.Create(FFontID
);
1764 with Control
as TGUIKeyRead
do
1766 FWindow
:= Self
.FWindow
;
1767 FColor
:= MENU_ITEMSCTRL_COLOR
;
1770 Text := TGUILabel
.Create(fText
, FFontID
);
1773 FColor
:= MENU_ITEMSTEXT_COLOR
;
1776 ControlType
:= TGUIKeyRead
;
1778 Result
:= (Control
as TGUIKeyRead
);
1781 if FIndex
= -1 then FIndex
:= i
;
1786 function TGUIMenu
.AddList(fText
: string; Width
, Height
: Word): TGUIListBox
;
1793 Control
:= TGUIListBox
.Create(FFontID
, Width
, Height
);
1794 with Control
as TGUIListBox
do
1796 FWindow
:= Self
.FWindow
;
1797 FActiveColor
:= MENU_ITEMSCTRL_COLOR
;
1798 FUnActiveColor
:= MENU_ITEMSTEXT_COLOR
;
1801 Text := TGUILabel
.Create(fText
, FFontID
);
1804 FColor
:= MENU_ITEMSTEXT_COLOR
;
1807 ControlType
:= TGUIListBox
;
1809 Result
:= (Control
as TGUIListBox
);
1812 if FIndex
= -1 then FIndex
:= i
;
1817 function TGUIMenu
.AddFileList(fText
: string; Width
, Height
: Word): TGUIFileListBox
;
1824 Control
:= TGUIFileListBox
.Create(FFontID
, Width
, Height
);
1825 with Control
as TGUIFileListBox
do
1827 FWindow
:= Self
.FWindow
;
1828 FActiveColor
:= MENU_ITEMSCTRL_COLOR
;
1829 FUnActiveColor
:= MENU_ITEMSTEXT_COLOR
;
1832 if fText
= '' then Text := nil else
1834 Text := TGUILabel
.Create(fText
, FFontID
);
1835 Text.FColor
:= MENU_ITEMSTEXT_COLOR
;
1838 ControlType
:= TGUIFileListBox
;
1840 Result
:= (Control
as TGUIFileListBox
);
1843 if FIndex
= -1 then FIndex
:= i
;
1848 function TGUIMenu
.AddLabel(fText
: string): TGUILabel
;
1855 Control
:= TGUILabel
.Create('', FFontID
);
1856 with Control
as TGUILabel
do
1858 FWindow
:= Self
.FWindow
;
1859 FColor
:= MENU_ITEMSCTRL_COLOR
;
1862 Text := TGUILabel
.Create(fText
, FFontID
);
1865 FColor
:= MENU_ITEMSTEXT_COLOR
;
1868 ControlType
:= TGUILabel
;
1870 Result
:= (Control
as TGUILabel
);
1873 if FIndex
= -1 then FIndex
:= i
;
1878 function TGUIMenu
.AddMemo(fText
: string; Width
, Height
: Word): TGUIMemo
;
1885 Control
:= TGUIMemo
.Create(FFontID
, Width
, Height
);
1886 with Control
as TGUIMemo
do
1888 FWindow
:= Self
.FWindow
;
1889 FColor
:= MENU_ITEMSTEXT_COLOR
;
1892 if fText
= '' then Text := nil else
1894 Text := TGUILabel
.Create(fText
, FFontID
);
1895 Text.FColor
:= MENU_ITEMSTEXT_COLOR
;
1898 ControlType
:= TGUIMemo
;
1900 Result
:= (Control
as TGUIMemo
);
1903 if FIndex
= -1 then FIndex
:= i
;
1908 procedure TGUIMenu
.UpdateIndex();
1916 if (FIndex
< 0) or (FIndex
> High(FItems
)) then
1922 if FItems
[FIndex
].Control
.Enabled
then
1931 constructor TGUIScroll
.Create
;
1936 FOnChangeEvent
:= nil;
1938 g_Texture_Get(SCROLL_LEFT
, FLeftID
);
1939 g_Texture_Get(SCROLL_RIGHT
, FRightID
);
1940 g_Texture_Get(SCROLL_MIDDLE
, FMiddleID
);
1941 g_Texture_Get(SCROLL_MARKER
, FMarkerID
);
1944 procedure TGUIScroll
.Draw
;
1950 e_Draw(FLeftID
, FX
, FY
, 0, True, False);
1951 e_Draw(FRightID
, FX
+8+(FMax
+1)*8, FY
, 0, True, False);
1953 for a
:= 0 to FMax
do
1954 e_Draw(FMiddleID
, FX
+8+a
*8, FY
, 0, True, False);
1956 e_Draw(FMarkerID
, FX
+8+FValue
*8, FY
, 0, True, False);
1959 procedure TGUIScroll
.FSetValue(a
: Integer);
1961 if a
> FMax
then FValue
:= FMax
else FValue
:= a
;
1964 function TGUIScroll
.GetWidth
: Word;
1966 Result
:= 16+(FMax
+1)*8;
1969 procedure TGUIScroll
.OnMessage(var Msg
: TMessage
);
1971 if not FEnabled
then Exit
;
1983 g_Sound_PlayEx(SCROLL_SUBSOUND
);
1984 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
1986 IK_RIGHT
, IK_KPRIGHT
:
1987 if FValue
< FMax
then
1990 g_Sound_PlayEx(SCROLL_ADDSOUND
);
1991 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
1998 procedure TGUIScroll
.Update
;
2006 procedure TGUISwitch
.AddItem(Item
: string);
2008 SetLength(FItems
, Length(FItems
)+1);
2009 FItems
[High(FItems
)] := Item
;
2011 if FIndex
= -1 then FIndex
:= 0;
2014 constructor TGUISwitch
.Create(FontID
: DWORD
);
2020 FFont
:= TFont
.Create(FontID
, FONT_CHAR
);
2023 procedure TGUISwitch
.Draw
;
2027 FFont
.Draw(FX
, FY
, FItems
[FIndex
], FColor
.R
, FColor
.G
, FColor
.B
);
2030 function TGUISwitch
.GetText
: string;
2032 if FIndex
<> -1 then Result
:= FItems
[FIndex
]
2036 function TGUISwitch
.GetWidth
: Word;
2043 if FItems
= nil then Exit
;
2045 for a
:= 0 to High(FItems
) do
2047 FFont
.GetTextSize(FItems
[a
], w
, h
);
2048 if w
> Result
then Result
:= w
;
2052 procedure TGUISwitch
.OnMessage(var Msg
: TMessage
);
2054 if not FEnabled
then Exit
;
2058 if FItems
= nil then Exit
;
2063 IK_RETURN
, IK_RIGHT
, IK_KPRETURN
, IK_KPRIGHT
:
2065 if FIndex
< High(FItems
) then
2070 if @FOnChangeEvent
<> nil then
2071 FOnChangeEvent(Self
);
2079 FIndex
:= High(FItems
);
2081 if @FOnChangeEvent
<> nil then
2082 FOnChangeEvent(Self
);
2088 procedure TGUISwitch
.Update
;
2096 constructor TGUIEdit
.Create(FontID
: DWORD
);
2100 FFont
:= TFont
.Create(FontID
, FONT_CHAR
);
2105 g_Texture_Get(EDIT_LEFT
, FLeftID
);
2106 g_Texture_Get(EDIT_RIGHT
, FRightID
);
2107 g_Texture_Get(EDIT_MIDDLE
, FMiddleID
);
2110 procedure TGUIEdit
.Draw
;
2116 e_Draw(FLeftID
, FX
, FY
, 0, True, False);
2117 e_Draw(FRightID
, FX
+8+FWidth
*16, FY
, 0, True, False);
2119 for c
:= 0 to FWidth
-1 do
2120 e_Draw(FMiddleID
, FX
+8+c
*16, FY
, 0, True, False);
2122 FFont
.Draw(FX
+8, FY
, FText
, FColor
.R
, FColor
.G
, FColor
.B
);
2124 if FWindow
.FActiveControl
= Self
then
2126 FFont
.GetTextSize(Copy(FText
, 1, FCaretPos
), w
, h
);
2127 h
:= e_CharFont_GetMaxHeight(FFont
.ID
);
2128 e_DrawLine(2, FX
+8+w
, FY
+h
-3, FX
+8+w
+EDIT_CURSORLEN
, FY
+h
-3,
2129 EDIT_CURSORCOLOR
.R
, EDIT_CURSORCOLOR
.G
, EDIT_CURSORCOLOR
.B
);
2133 function TGUIEdit
.GetWidth
: Word;
2135 Result
:= 16+FWidth
*16;
2138 procedure TGUIEdit
.OnMessage(var Msg
: TMessage
);
2140 if not FEnabled
then Exit
;
2149 if (wParam
in [48..57]) and (Chr(wParam
) <> '`') then
2150 if Length(Text) < FMaxLength
then
2152 Insert(Chr(wParam
), FText
, FCaretPos
+ 1);
2158 if (wParam
in [32..255]) and (Chr(wParam
) <> '`') then
2159 if Length(Text) < FMaxLength
then
2161 Insert(Chr(wParam
), FText
, FCaretPos
+ 1);
2169 Delete(FText
, FCaretPos
, 1);
2170 if FCaretPos
> 0 then Dec(FCaretPos
);
2172 IK_DELETE
: Delete(FText
, FCaretPos
+ 1, 1);
2173 IK_END
, IK_KPEND
: FCaretPos
:= Length(FText
);
2174 IK_HOME
, IK_KPHOME
: FCaretPos
:= 0;
2175 IK_LEFT
, IK_KPLEFT
: if FCaretPos
> 0 then Dec(FCaretPos
);
2176 IK_RIGHT
, IK_KPRIGHT
: if FCaretPos
< Length(FText
) then Inc(FCaretPos
);
2177 IK_RETURN
, IK_KPRETURN
:
2180 if FActiveControl
<> Self
then
2183 if @FOnEnterEvent
<> nil then FOnEnterEvent(Self
);
2187 if FDefControl
<> '' then SetActive(GetControl(FDefControl
))
2188 else SetActive(nil);
2189 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2196 procedure TGUIEdit
.SetText(Text: string);
2198 if Length(Text) > FMaxLength
then SetLength(Text, FMaxLength
);
2200 FCaretPos
:= Length(FText
);
2203 procedure TGUIEdit
.Update
;
2210 constructor TGUIKeyRead
.Create(FontID
: DWORD
);
2214 FFont
:= TFont
.Create(FontID
, FONT_CHAR
);
2217 procedure TGUIKeyRead
.Draw
;
2221 FFont
.Draw(FX
, FY
, IfThen(FIsQuery
, KEYREAD_QUERY
, IfThen(FKey
<> 0, e_KeyNames
[FKey
], KEYREAD_CLEAR
)),
2222 FColor
.R
, FColor
.G
, FColor
.B
);
2225 function TGUIKeyRead
.GetWidth
: Word;
2232 for a
:= 0 to 255 do
2234 FFont
.GetTextSize(e_KeyNames
[a
], w
, h
);
2235 Result
:= Max(Result
, w
);
2238 FFont
.GetTextSize(KEYREAD_QUERY
, w
, h
);
2239 if w
> Result
then Result
:= w
;
2241 FFont
.GetTextSize(KEYREAD_CLEAR
, w
, h
);
2242 if w
> Result
then Result
:= w
;
2245 procedure TGUIKeyRead
.OnMessage(var Msg
: TMessage
);
2249 if not FEnabled
then
2260 if FDefControl
<> '' then
2261 SetActive(GetControl(FDefControl
))
2267 IK_RETURN
, IK_KPRETURN
:
2269 if not FIsQuery
then
2272 if FActiveControl
<> Self
then
2279 FKey
:= IK_ENTER
; // <Enter>
2283 if FDefControl
<> '' then
2284 SetActive(GetControl(FDefControl
))
2292 if FIsQuery
and (wParam
<> IK_ENTER
) and (wParam
<> IK_KPRETURN
) then // Not <Enter
2294 if e_KeyNames
[wParam
] <> '' then
2299 if FDefControl
<> '' then
2300 SetActive(GetControl(FDefControl
))
2309 constructor TGUIModelView
.Create
;
2316 destructor TGUIModelView
.Destroy
;
2323 procedure TGUIModelView
.Draw
;
2327 DrawBox(FX
, FY
, 4, 4);
2329 if FModel
<> nil then FModel
.Draw(FX
+4, FY
+4);
2332 procedure TGUIModelView
.NextAnim();
2334 if FModel
= nil then
2337 if FModel
.Animation
< A_PAIN
then
2338 FModel
.ChangeAnimation(FModel
.Animation
+1, True)
2340 FModel
.ChangeAnimation(A_STAND
, True);
2343 procedure TGUIModelView
.NextWeapon();
2345 if FModel
= nil then
2348 if FModel
.Weapon
< WEAPON_SUPERPULEMET
then
2349 FModel
.SetWeapon(FModel
.Weapon
+1)
2351 FModel
.SetWeapon(WEAPON_KASTET
);
2354 procedure TGUIModelView
.OnMessage(var Msg
: TMessage
);
2360 procedure TGUIModelView
.SetColor(Red
, Green
, Blue
: Byte);
2362 if FModel
<> nil then FModel
.SetColor(Red
, Green
, Blue
);
2365 procedure TGUIModelView
.SetModel(ModelName
: string);
2369 FModel
:= g_PlayerModel_Get(ModelName
);
2372 procedure TGUIModelView
.Update
;
2379 if FModel
<> nil then FModel
.Update
;
2384 constructor TGUIMapPreview
.Create();
2390 destructor TGUIMapPreview
.Destroy();
2396 procedure TGUIMapPreview
.Draw();
2403 DrawBox(FX
, FY
, MAPPREVIEW_WIDTH
, MAPPREVIEW_HEIGHT
);
2405 if (FMapSize
.X
<= 0) or (FMapSize
.Y
<= 0) then
2408 e_DrawFillQuad(FX
+4, FY
+4,
2409 FX
+4 + Trunc(FMapSize
.X
/ FScale
) - 1,
2410 FY
+4 + Trunc(FMapSize
.Y
/ FScale
) - 1,
2413 if FMapData
<> nil then
2414 for a
:= 0 to High(FMapData
) do
2417 if X1
> MAPPREVIEW_WIDTH
*16 then Continue
;
2418 if Y1
> MAPPREVIEW_HEIGHT
*16 then Continue
;
2420 if X2
< 0 then Continue
;
2421 if Y2
< 0 then Continue
;
2423 if X2
> MAPPREVIEW_WIDTH
*16 then X2
:= MAPPREVIEW_WIDTH
*16;
2424 if Y2
> MAPPREVIEW_HEIGHT
*16 then Y2
:= MAPPREVIEW_HEIGHT
*16;
2426 if X1
< 0 then X1
:= 0;
2427 if Y1
< 0 then Y1
:= 0;
2468 if ((X2
-X1
) > 0) and ((Y2
-Y1
) > 0) then
2469 e_DrawFillQuad(FX
+4 + X1
, FY
+4 + Y1
,
2470 FX
+4 + X2
- 1, FY
+4 + Y2
- 1, r
, g
, b
, 0);
2474 procedure TGUIMapPreview
.OnMessage(var Msg
: TMessage
);
2480 procedure TGUIMapPreview
.SetMap(Res
: string);
2483 MapReader
: TMapReader_1
;
2484 panels
: TPanelsRec1Array
;
2485 header
: TMapHeaderRec_1
;
2492 FileName
:= g_ExtractWadName(Res
);
2494 WAD
:= TWADFile
.Create();
2495 if not WAD
.ReadFile(FileName
) then
2501 //k8: ignores path again
2502 if not WAD
.GetMapResource(g_ExtractFileName(Res
), Data
, Len
) then
2510 MapReader
:= TMapReader_1
.Create();
2512 if not MapReader
.LoadMap(Data
) then
2525 panels
:= MapReader
.GetPanels();
2526 header
:= MapReader
.GetMapHeader();
2528 FMapSize
.X
:= header
.Width
div 16;
2529 FMapSize
.Y
:= header
.Height
div 16;
2531 rX
:= Ceil(header
.Width
/ (MAPPREVIEW_WIDTH
*256.0));
2532 rY
:= Ceil(header
.Height
/ (MAPPREVIEW_HEIGHT
*256.0));
2533 FScale
:= max(rX
, rY
);
2537 if panels
<> nil then
2538 for a
:= 0 to High(panels
) do
2539 if WordBool(panels
[a
].PanelType
and (PANEL_WALL
or PANEL_CLOSEDOOR
or
2540 PANEL_STEP
or PANEL_WATER
or
2541 PANEL_ACID1
or PANEL_ACID2
)) then
2543 SetLength(FMapData
, Length(FMapData
)+1);
2544 with FMapData
[High(FMapData
)] do
2546 X1
:= panels
[a
].X
div 16;
2547 Y1
:= panels
[a
].Y
div 16;
2549 X2
:= (panels
[a
].X
+ panels
[a
].Width
) div 16;
2550 Y2
:= (panels
[a
].Y
+ panels
[a
].Height
) div 16;
2552 X1
:= Trunc(X1
/FScale
+ 0.5);
2553 Y1
:= Trunc(Y1
/FScale
+ 0.5);
2554 X2
:= Trunc(X2
/FScale
+ 0.5);
2555 Y2
:= Trunc(Y2
/FScale
+ 0.5);
2557 if (X1
<> X2
) or (Y1
<> Y2
) then
2565 PanelType
:= panels
[a
].PanelType
;
2574 procedure TGUIMapPreview
.ClearMap();
2576 SetLength(FMapData
, 0);
2583 procedure TGUIMapPreview
.Update();
2589 function TGUIMapPreview
.GetScaleStr(): String;
2591 if FScale
> 0.0 then
2593 Result
:= FloatToStrF(FScale
*16.0, ffFixed
, 3, 3);
2594 while (Result
[Length(Result
)] = '0') do
2595 Delete(Result
, Length(Result
), 1);
2596 if (Result
[Length(Result
)] = ',') or (Result
[Length(Result
)] = '.') then
2597 Delete(Result
, Length(Result
), 1);
2598 Result
:= '1 : ' + Result
;
2606 procedure TGUIListBox
.AddItem(Item
: string);
2608 SetLength(FItems
, Length(FItems
)+1);
2609 FItems
[High(FItems
)] := Item
;
2611 if FSort
then g_Basic
.Sort(FItems
);
2614 procedure TGUIListBox
.Clear();
2622 constructor TGUIListBox
.Create(FontID
: DWORD
; Width
, Height
: Word);
2626 FFont
:= TFont
.Create(FontID
, FONT_CHAR
);
2631 FOnChangeEvent
:= nil;
2633 FDrawScroll
:= True;
2636 procedure TGUIListBox
.Draw
;
2644 if FDrawBack
then DrawBox(FX
, FY
, FWidth
+1, FHeight
);
2646 DrawScroll(FX
+4+FWidth
*16, FY
+4, FHeight
, (FStartLine
> 0) and (FItems
<> nil),
2647 (FStartLine
+FHeight
-1 < High(FItems
)) and (FItems
<> nil));
2649 if FItems
<> nil then
2650 for a
:= FStartLine
to Min(High(FItems
), FStartLine
+FHeight
-1) do
2654 FFont
.GetTextSize(s
, w2
, h2
);
2655 while (Length(s
) > 0) and (w2
> FWidth
*16) do
2657 SetLength(s
, Length(s
)-1);
2658 FFont
.GetTextSize(s
, w2
, h2
);
2662 FFont
.Draw(FX
+4, FY
+4+(a
-FStartLine
)*16, s
, FActiveColor
.R
, FActiveColor
.G
, FActiveColor
.B
)
2664 FFont
.Draw(FX
+4, FY
+4+(a
-FStartLine
)*16, s
, FUnActiveColor
.R
, FUnActiveColor
.G
, FUnActiveColor
.B
);
2668 function TGUIListBox
.GetHeight
: Word;
2670 Result
:= 8+FHeight
*16;
2673 function TGUIListBox
.GetWidth
: Word;
2675 Result
:= 8+(FWidth
+1)*16;
2678 procedure TGUIListBox
.OnMessage(var Msg
: TMessage
);
2682 if not FEnabled
then Exit
;
2686 if FItems
= nil then Exit
;
2699 FIndex
:= High(FItems
);
2700 FStartLine
:= Max(High(FItems
)-FHeight
+1, 0);
2702 IK_UP
, IK_LEFT
, IK_KPUP
, IK_KPLEFT
:
2706 if FIndex
< FStartLine
then Dec(FStartLine
);
2707 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2709 IK_DOWN
, IK_RIGHT
, IK_KPDOWN
, IK_KPRIGHT
:
2710 if FIndex
< High(FItems
) then
2713 if FIndex
> FStartLine
+FHeight
-1 then Inc(FStartLine
);
2714 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2716 IK_RETURN
, IK_KPRETURN
:
2719 if FActiveControl
<> Self
then SetActive(Self
)
2721 if FDefControl
<> '' then SetActive(GetControl(FDefControl
))
2722 else SetActive(nil);
2726 for a
:= 0 to High(FItems
) do
2727 if (Length(FItems
[a
]) > 0) and (LowerCase(FItems
[a
][1]) = LowerCase(Chr(wParam
))) then
2730 FStartLine
:= Min(Max(FIndex
-1, 0), Length(FItems
)-FHeight
);
2731 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2737 function TGUIListBox
.SelectedItem(): String;
2741 if (FIndex
< 0) or (FItems
= nil) or
2742 (FIndex
> High(FItems
)) then
2745 Result
:= FItems
[FIndex
];
2748 procedure TGUIListBox
.FSetItems(Items
: SArray
);
2750 if FItems
<> nil then
2758 if FSort
then g_Basic
.Sort(FItems
);
2761 procedure TGUIListBox
.SelectItem(Item
: String);
2765 if FItems
= nil then
2769 Item
:= LowerCase(Item
);
2771 for a
:= 0 to High(FItems
) do
2772 if LowerCase(FItems
[a
]) = Item
then
2778 if FIndex
< FHeight
then
2781 FStartLine
:= Min(FIndex
, Length(FItems
)-FHeight
);
2784 procedure TGUIListBox
.FSetIndex(aIndex
: Integer);
2786 if FItems
= nil then
2789 if (aIndex
< 0) or (aIndex
> High(FItems
)) then
2794 if FIndex
<= FHeight
then
2797 FStartLine
:= Min(FIndex
, Length(FItems
)-FHeight
);
2802 procedure TGUIFileListBox
.OnMessage(var Msg
: TMessage
);
2806 if not FEnabled
then
2809 if FItems
= nil then
2820 if @FOnChangeEvent
<> nil then
2821 FOnChangeEvent(Self
);
2826 FIndex
:= High(FItems
);
2827 FStartLine
:= Max(High(FItems
)-FHeight
+1, 0);
2828 if @FOnChangeEvent
<> nil then
2829 FOnChangeEvent(Self
);
2832 IK_PAGEUP
, IK_KPPAGEUP
:
2834 if FIndex
> FHeight
then
2835 FIndex
:= FIndex
-FHeight
2839 if FStartLine
> FHeight
then
2840 FStartLine
:= FStartLine
-FHeight
2845 IK_PAGEDN
, IK_KPPAGEDN
:
2847 if FIndex
< High(FItems
)-FHeight
then
2848 FIndex
:= FIndex
+FHeight
2850 FIndex
:= High(FItems
);
2852 if FStartLine
< High(FItems
)-FHeight
then
2853 FStartLine
:= FStartLine
+FHeight
2855 FStartLine
:= High(FItems
)-FHeight
+1;
2858 IK_UP
, IK_LEFT
, IK_KPUP
, IK_KPLEFT
:
2862 if FIndex
< FStartLine
then
2864 if @FOnChangeEvent
<> nil then
2865 FOnChangeEvent(Self
);
2868 IK_DOWN
, IK_RIGHT
, IK_KPDOWN
, IK_KPRIGHT
:
2869 if FIndex
< High(FItems
) then
2872 if FIndex
> FStartLine
+FHeight
-1 then
2874 if @FOnChangeEvent
<> nil then
2875 FOnChangeEvent(Self
);
2878 IK_RETURN
, IK_KPRETURN
:
2881 if FActiveControl
<> Self
then
2885 if FItems
[FIndex
][1] = #29 then // Ïàïêà
2887 OpenDir(FPath
+Copy(FItems
[FIndex
], 2, 255));
2892 if FDefControl
<> '' then
2893 SetActive(GetControl(FDefControl
))
2901 for a
:= 0 to High(FItems
) do
2902 if ( (Length(FItems
[a
]) > 0) and
2903 (LowerCase(FItems
[a
][1]) = LowerCase(Chr(wParam
))) ) or
2904 ( (Length(FItems
[a
]) > 1) and
2905 (FItems
[a
][1] = #29) and // Ïàïêà
2906 (LowerCase(FItems
[a
][2]) = LowerCase(Chr(wParam
))) ) then
2909 FStartLine
:= Min(Max(FIndex
-1, 0), Length(FItems
)-FHeight
);
2910 if @FOnChangeEvent
<> nil then
2911 FOnChangeEvent(Self
);
2917 procedure TGUIFileListBox
.OpenDir(path
: String);
2925 path
:= IncludeTrailingPathDelimiter(path
);
2926 path
:= ExpandFileName(path
);
2931 if FindFirst(path
+'*', faDirectory
, SR
) = 0 then
2933 if not LongBool(SR
.Attr
and faDirectory
) then
2935 if (SR
.Name
= '.') or
2936 ((SR
.Name
= '..') and (path
= ExpandFileName(FBasePath
))) then
2939 AddItem(#1 + SR
.Name
);
2940 until FindNext(SR
) <> 0;
2950 if i
= 0 then i
:= length(sm
)+1;
2951 sc
:= Copy(sm
, 1, i
-1);
2953 if FindFirst(path
+sc
, faAnyFile
, SR
) = 0 then repeat AddItem(SR
.Name
); until FindNext(SR
) <> 0;
2957 for i
:= 0 to High(FItems
) do
2958 if FItems
[i
][1] = #1 then
2959 FItems
[i
][1] := #29;
2964 procedure TGUIFileListBox
.SetBase(path
: String);
2970 function TGUIFileListBox
.SelectedItem(): String;
2974 if (FIndex
= -1) or (FItems
= nil) or
2975 (FIndex
> High(FItems
)) or
2976 (FItems
[FIndex
][1] = '/') or
2977 (FItems
[FIndex
][1] = '\') then
2980 Result
:= FPath
+ FItems
[FIndex
];
2983 procedure TGUIFileListBox
.UpdateFileList();
2987 if (FIndex
= -1) or (FItems
= nil) or
2988 (FIndex
> High(FItems
)) or
2989 (FItems
[FIndex
][1] = '/') or
2990 (FItems
[FIndex
][1] = '\') then
2993 fn
:= FItems
[FIndex
];
3003 procedure TGUIMemo
.Clear
;
3009 constructor TGUIMemo
.Create(FontID
: DWORD
; Width
, Height
: Word);
3013 FFont
:= TFont
.Create(FontID
, FONT_CHAR
);
3018 FDrawScroll
:= True;
3021 procedure TGUIMemo
.Draw
;
3027 if FDrawBack
then DrawBox(FX
, FY
, FWidth
+1, FHeight
);
3029 DrawScroll(FX
+4+FWidth
*16, FY
+4, FHeight
, (FStartLine
> 0) and (FLines
<> nil),
3030 (FStartLine
+FHeight
-1 < High(FLines
)) and (FLines
<> nil));
3032 if FLines
<> nil then
3033 for a
:= FStartLine
to Min(High(FLines
), FStartLine
+FHeight
-1) do
3034 FFont
.Draw(FX
+4, FY
+4+(a
-FStartLine
)*16, FLines
[a
], FColor
.R
, FColor
.G
, FColor
.B
);
3037 function TGUIMemo
.GetHeight
: Word;
3039 Result
:= 8+FHeight
*16;
3042 function TGUIMemo
.GetWidth
: Word;
3044 Result
:= 8+(FWidth
+1)*16;
3047 procedure TGUIMemo
.OnMessage(var Msg
: TMessage
);
3049 if not FEnabled
then Exit
;
3053 if FLines
= nil then Exit
;
3059 IK_UP
, IK_LEFT
, IK_KPUP
, IK_KPLEFT
:
3060 if FStartLine
> 0 then
3062 IK_DOWN
, IK_RIGHT
, IK_KPDOWN
, IK_KPRIGHT
:
3063 if FStartLine
< Length(FLines
)-FHeight
then
3065 IK_RETURN
, IK_KPRETURN
:
3068 if FActiveControl
<> Self
then
3074 if FDefControl
<> '' then SetActive(GetControl(FDefControl
))
3075 else SetActive(nil);
3081 procedure TGUIMemo
.SetText(Text: string);
3084 FLines
:= GetLines(Text, FFont
.ID
, FWidth
*16);
3089 procedure TGUIimage
.ClearImage();
3091 if FImageRes
= '' then Exit
;
3093 g_Texture_Delete(FImageRes
);
3097 constructor TGUIimage
.Create();
3104 destructor TGUIimage
.Destroy();
3109 procedure TGUIimage
.Draw();
3115 if FImageRes
= '' then
3117 if g_Texture_Get(FDefaultRes
, ID
) then e_Draw(ID
, FX
, FY
, 0, True, False);
3120 if g_Texture_Get(FImageRes
, ID
) then e_Draw(ID
, FX
, FY
, 0, True, False);
3123 procedure TGUIimage
.OnMessage(var Msg
: TMessage
);
3128 procedure TGUIimage
.SetImage(Res
: string);
3132 if g_Texture_CreateWADEx(Res
, Res
) then FImageRes
:= Res
;
3135 procedure TGUIimage
.Update();