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/>.
16 {$INCLUDE ../shared/a_modes.inc}
22 {$IFDEF USE_MEMPOOL}mempool
,{$ENDIF}
23 e_graphics
, e_input
, e_log
, g_playermodel
, g_basic
, g_touch
, MAPDEF
, utils
;
26 MAINMENU_HEADER_COLOR
: TRGB
= (R
:255; G
:255; B
:255);
27 MAINMENU_ITEMS_COLOR
: TRGB
= (R
:255; G
:255; B
:255);
28 MAINMENU_UNACTIVEITEMS_COLOR
: TRGB
= (R
:192; G
:192; B
:192);
29 MAINMENU_CLICKSOUND
= 'MENU_SELECT';
30 MAINMENU_CHANGESOUND
= 'MENU_CHANGE';
32 MAINMENU_MARKER1
= 'MAINMENU_MARKER1';
33 MAINMENU_MARKER2
= 'MAINMENU_MARKER2';
34 MAINMENU_MARKERDELAY
= 24;
35 WINDOW_CLOSESOUND
= 'MENU_CLOSE';
36 MENU_HEADERCOLOR
: TRGB
= (R
:255; G
:255; B
:255);
37 MENU_ITEMSTEXT_COLOR
: TRGB
= (R
:255; G
:255; B
:255);
38 MENU_UNACTIVEITEMS_COLOR
: TRGB
= (R
:128; G
:128; B
:128);
39 MENU_ITEMSCTRL_COLOR
: TRGB
= (R
:255; G
:0; B
:0);
42 MENU_CLICKSOUND
= 'MENU_SELECT';
43 MENU_CHANGESOUND
= 'MENU_CHANGE';
44 MENU_MARKERDELAY
= 24;
45 SCROLL_LEFT
= 'SCROLL_LEFT';
46 SCROLL_RIGHT
= 'SCROLL_RIGHT';
47 SCROLL_MIDDLE
= 'SCROLL_MIDDLE';
48 SCROLL_MARKER
= 'SCROLL_MARKER';
49 SCROLL_ADDSOUND
= 'SCROLL_ADD';
50 SCROLL_SUBSOUND
= 'SCROLL_SUB';
51 EDIT_LEFT
= 'EDIT_LEFT';
52 EDIT_RIGHT
= 'EDIT_RIGHT';
53 EDIT_MIDDLE
= 'EDIT_MIDDLE';
54 EDIT_CURSORCOLOR
: TRGB
= (R
:200; G
:0; B
:0);
56 KEYREAD_QUERY
= '<...>';
57 KEYREAD_CLEAR
= '???';
60 MAPPREVIEW_HEIGHT
= 8;
70 BSCROLL_UPA
= 'BSCROLL_UP_A';
71 BSCROLL_UPU
= 'BSCROLL_UP_U';
72 BSCROLL_DOWNA
= 'BSCROLL_DOWN_A';
73 BSCROLL_DOWNU
= 'BSCROLL_DOWN_U';
74 BSCROLL_MIDDLE
= 'BSCROLL_MIDDLE';
86 TFontType
= (Texture
, Character
);
88 TFont
= class{$IFDEF USE_MEMPOOL}(TPoolObject
){$ENDIF}
94 constructor Create(FontID
: DWORD
; FontType
: TFontType
);
95 destructor Destroy
; override;
96 procedure Draw(X
, Y
: Integer; Text: string; R
, G
, B
: Byte);
97 procedure GetTextSize(Text: string; var w
, h
: Word);
98 property Scale
: Single read FScale write FScale
;
104 TOnKeyDownEvent
= procedure(Key
: Byte);
105 TOnKeyDownEventEx
= procedure(win
: TGUIWindow
; Key
: Byte);
106 TOnCloseEvent
= procedure;
107 TOnShowEvent
= procedure;
108 TOnClickEvent
= procedure;
109 TOnChangeEvent
= procedure(Sender
: TGUIControl
);
110 TOnEnterEvent
= procedure(Sender
: TGUIControl
);
112 TGUIControl
= class{$IFDEF USE_MEMPOOL}(TPoolObject
){$ENDIF}
116 FWindow
: TGUIWindow
;
119 FRightAlign
: Boolean; //HACK! this works only for "normal" menus, only for menu text labels, and generally sux. sorry.
120 FMaxWidth
: Integer; //HACK! used for right-aligning labels
123 procedure OnMessage(var Msg
: TMessage
); virtual;
124 procedure Update
; virtual;
125 procedure Draw
; virtual;
126 function GetWidth(): Integer; virtual;
127 function GetHeight(): Integer; virtual;
128 function WantActivationKey (key
: LongInt): Boolean; virtual;
129 property X
: Integer read FX write FX
;
130 property Y
: Integer read FY write FY
;
131 property Enabled
: Boolean read FEnabled write FEnabled
;
132 property Name
: string read FName write FName
;
133 property UserData
: Pointer read FUserData write FUserData
;
134 property RightAlign
: Boolean read FRightAlign write FRightAlign
; // for menu
137 TGUIWindow
= class{$IFDEF USE_MEMPOOL}(TPoolObject
){$ENDIF}
139 FActiveControl
: TGUIControl
;
141 FPrevWindow
: TGUIWindow
;
143 FBackTexture
: string;
144 FMainWindow
: Boolean;
145 FOnKeyDown
: TOnKeyDownEvent
;
146 FOnKeyDownEx
: TOnKeyDownEventEx
;
147 FOnCloseEvent
: TOnCloseEvent
;
148 FOnShowEvent
: TOnShowEvent
;
151 Childs
: array of TGUIControl
;
152 constructor Create(Name
: string);
153 destructor Destroy
; override;
154 function AddChild(Child
: TGUIControl
): TGUIControl
;
155 procedure OnMessage(var Msg
: TMessage
);
158 procedure SetActive(Control
: TGUIControl
);
159 function GetControl(Name
: string): TGUIControl
;
160 property OnKeyDown
: TOnKeyDownEvent read FOnKeyDown write FOnKeyDown
;
161 property OnKeyDownEx
: TOnKeyDownEventEx read FOnKeyDownEx write FOnKeyDownEx
;
162 property OnClose
: TOnCloseEvent read FOnCloseEvent write FOnCloseEvent
;
163 property OnShow
: TOnShowEvent read FOnShowEvent write FOnShowEvent
;
164 property Name
: string read FName
;
165 property DefControl
: string read FDefControl write FDefControl
;
166 property BackTexture
: string read FBackTexture write FBackTexture
;
167 property MainWindow
: Boolean read FMainWindow write FMainWindow
;
168 property UserData
: Pointer read FUserData write FUserData
;
171 TGUITextButton
= class(TGUIControl
)
180 ProcEx
: procedure (sender
: TGUITextButton
);
181 constructor Create(aProc
: Pointer; FontID
: DWORD
; Text: string);
182 destructor Destroy(); override;
183 procedure OnMessage(var Msg
: TMessage
); override;
184 procedure Update(); override;
185 procedure Draw(); override;
186 function GetWidth(): Integer; override;
187 function GetHeight(): Integer; override;
188 procedure Click(Silent
: Boolean = False);
189 property Caption
: string read FText write FText
;
190 property Color
: TRGB read FColor write FColor
;
191 property Font
: TFont read FFont write FFont
;
192 property ShowWindow
: string read FShowWindow write FShowWindow
;
195 TGUILabel
= class(TGUIControl
)
201 FOnClickEvent
: TOnClickEvent
;
203 constructor Create(Text: string; FontID
: DWORD
);
204 procedure OnMessage(var Msg
: TMessage
); override;
205 procedure Draw
; override;
206 function GetWidth
: Integer; override;
207 function GetHeight
: Integer; override;
208 property OnClick
: TOnClickEvent read FOnClickEvent write FOnClickEvent
;
209 property FixedLength
: Word read FFixedLen write FFixedLen
;
210 property Text: string read FText write FText
;
211 property Color
: TRGB read FColor write FColor
;
212 property Font
: TFont read FFont write FFont
;
215 TGUIScroll
= class(TGUIControl
)
223 FOnChangeEvent
: TOnChangeEvent
;
224 procedure FSetValue(a
: Integer);
226 constructor Create();
227 procedure OnMessage(var Msg
: TMessage
); override;
228 procedure Update
; override;
229 procedure Draw
; override;
230 function GetWidth(): Integer; override;
231 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
232 property Max
: Word read FMax write FMax
;
233 property Value
: Integer read FValue write FSetValue
;
236 TGUISwitch
= class(TGUIControl
)
239 FItems
: array of string;
242 FOnChangeEvent
: TOnChangeEvent
;
244 constructor Create(FontID
: DWORD
);
245 procedure OnMessage(var Msg
: TMessage
); override;
246 procedure AddItem(Item
: string);
247 procedure Update
; override;
248 procedure Draw
; override;
249 function GetWidth(): Integer; override;
250 function GetText
: string;
251 property ItemIndex
: Integer read FIndex write FIndex
;
252 property Color
: TRGB read FColor write FColor
;
253 property Font
: TFont read FFont write FFont
;
254 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
257 TGUIEdit
= class(TGUIControl
)
265 FOnlyDigits
: Boolean;
269 FOnChangeEvent
: TOnChangeEvent
;
270 FOnEnterEvent
: TOnEnterEvent
;
272 procedure SetText(Text: string);
274 constructor Create(FontID
: DWORD
);
275 procedure OnMessage(var Msg
: TMessage
); override;
276 procedure Update
; override;
277 procedure Draw
; override;
278 function GetWidth(): Integer; override;
279 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
280 property OnEnter
: TOnEnterEvent read FOnEnterEvent write FOnEnterEvent
;
281 property Width
: Word read FWidth write FWidth
;
282 property MaxLength
: Word read FMaxLength write FMaxLength
;
283 property OnlyDigits
: Boolean read FOnlyDigits write FOnlyDigits
;
284 property Text: string read FText write SetText
;
285 property Color
: TRGB read FColor write FColor
;
286 property Font
: TFont read FFont write FFont
;
287 property Invalid
: Boolean read FInvalid write FInvalid
;
290 TGUIKeyRead
= class(TGUIControl
)
297 constructor Create(FontID
: DWORD
);
298 procedure OnMessage(var Msg
: TMessage
); override;
299 procedure Draw
; override;
300 function GetWidth(): Integer; override;
301 function WantActivationKey (key
: LongInt): Boolean; override;
302 property Key
: Word read FKey write FKey
;
303 property Color
: TRGB read FColor write FColor
;
304 property Font
: TFont read FFont write FFont
;
308 TGUIKeyRead2
= class(TGUIControl
)
313 FKey0
, FKey1
: Word; // this should be an array. sorry.
316 FMaxKeyNameWdt
: Integer;
318 constructor Create(FontID
: DWORD
);
319 procedure OnMessage(var Msg
: TMessage
); override;
320 procedure Draw
; override;
321 function GetWidth(): Integer; override;
322 function WantActivationKey (key
: LongInt): Boolean; override;
323 property Key0
: Word read FKey0 write FKey0
;
324 property Key1
: Word read FKey1 write FKey1
;
325 property Color
: TRGB read FColor write FColor
;
326 property Font
: TFont read FFont write FFont
;
329 TGUIModelView
= class(TGUIControl
)
331 FModel
: TPlayerModel
;
335 destructor Destroy
; override;
336 procedure OnMessage(var Msg
: TMessage
); override;
337 procedure SetModel(ModelName
: string);
338 procedure SetColor(Red
, Green
, Blue
: Byte);
339 procedure NextAnim();
340 procedure NextWeapon();
341 procedure Update
; override;
342 procedure Draw
; override;
343 property Model
: TPlayerModel read FModel
;
346 TPreviewPanel
= record
347 X1
, Y1
, X2
, Y2
: Integer;
351 TGUIMapPreview
= class(TGUIControl
)
353 FMapData
: array of TPreviewPanel
;
357 constructor Create();
358 destructor Destroy(); override;
359 procedure OnMessage(var Msg
: TMessage
); override;
360 procedure SetMap(Res
: string);
361 procedure ClearMap();
362 procedure Update(); override;
363 procedure Draw(); override;
364 function GetScaleStr
: String;
367 TGUIImage
= class(TGUIControl
)
372 constructor Create();
373 destructor Destroy(); override;
374 procedure OnMessage(var Msg
: TMessage
); override;
375 procedure SetImage(Res
: string);
376 procedure ClearImage();
377 procedure Update(); override;
378 procedure Draw(); override;
379 property DefaultRes
: string read FDefaultRes write FDefaultRes
;
382 TGUIListBox
= class(TGUIControl
)
386 FUnActiveColor
: TRGB
;
394 FDrawScroll
: Boolean;
395 FOnChangeEvent
: TOnChangeEvent
;
397 procedure FSetItems(Items
: SSArray
);
398 procedure FSetIndex(aIndex
: Integer);
401 constructor Create(FontID
: DWORD
; Width
, Height
: Word);
402 procedure OnMessage(var Msg
: TMessage
); override;
403 procedure Draw(); override;
404 procedure AddItem(Item
: String);
405 procedure SelectItem(Item
: String);
407 function GetWidth(): Integer; override;
408 function GetHeight(): Integer; override;
409 function SelectedItem(): String;
411 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
412 property Sort
: Boolean read FSort write FSort
;
413 property ItemIndex
: Integer read FIndex write FSetIndex
;
414 property Items
: SSArray read FItems write FSetItems
;
415 property DrawBack
: Boolean read FDrawBack write FDrawBack
;
416 property DrawScrollBar
: Boolean read FDrawScroll write FDrawScroll
;
417 property ActiveColor
: TRGB read FActiveColor write FActiveColor
;
418 property UnActiveColor
: TRGB read FUnActiveColor write FUnActiveColor
;
419 property Font
: TFont read FFont write FFont
;
422 TGUIFileListBox
= class(TGUIListBox
)
429 procedure OpenDir(path
: String);
432 procedure OnMessage(var Msg
: TMessage
); override;
433 procedure SetBase(path
: String);
434 function SelectedItem(): String;
435 procedure UpdateFileList();
437 property Dirs
: Boolean read FDirs write FDirs
;
438 property FileMask
: String read FFileMask write FFileMask
;
439 property Path
: String read FPath
;
442 TGUIMemo
= class(TGUIControl
)
451 FDrawScroll
: Boolean;
453 constructor Create(FontID
: DWORD
; Width
, Height
: Word);
454 procedure OnMessage(var Msg
: TMessage
); override;
455 procedure Draw
; override;
457 function GetWidth(): Integer; override;
458 function GetHeight(): Integer; override;
459 procedure SetText(Text: string);
460 property DrawBack
: Boolean read FDrawBack write FDrawBack
;
461 property DrawScrollBar
: Boolean read FDrawScroll write FDrawScroll
;
462 property Color
: TRGB read FColor write FColor
;
463 property Font
: TFont read FFont write FFont
;
466 TGUIMainMenu
= class(TGUIControl
)
468 FButtons
: array of TGUITextButton
;
476 constructor Create(FontID
: DWORD
; Header
: string);
477 destructor Destroy
; override;
478 procedure OnMessage(var Msg
: TMessage
); override;
479 function AddButton(fProc
: Pointer; Caption
: string; ShowWindow
: string = ''): TGUITextButton
;
480 function GetButton(aName
: string): TGUITextButton
;
481 procedure EnableButton(aName
: string; e
: Boolean);
482 procedure AddSpace();
483 procedure Update
; override;
484 procedure Draw
; override;
487 TControlType
= class of TGUIControl
;
489 PMenuItem
= ^TMenuItem
;
492 ControlType
: TControlType
;
493 Control
: TGUIControl
;
496 TGUIMenu
= class(TGUIControl
)
498 FItems
: array of TMenuItem
;
506 function NewItem(): Integer;
508 constructor Create(HeaderFont
, ItemsFont
: DWORD
; Header
: string);
509 destructor Destroy
; override;
510 procedure OnMessage(var Msg
: TMessage
); override;
511 procedure AddSpace();
512 procedure AddLine(fText
: string);
513 procedure AddText(fText
: string; MaxWidth
: Word);
514 function AddLabel(fText
: string): TGUILabel
;
515 function AddButton(Proc
: Pointer; fText
: string; _ShowWindow
: string = ''): TGUITextButton
;
516 function AddScroll(fText
: string): TGUIScroll
;
517 function AddSwitch(fText
: string): TGUISwitch
;
518 function AddEdit(fText
: string): TGUIEdit
;
519 function AddKeyRead(fText
: string): TGUIKeyRead
;
520 function AddKeyRead2(fText
: string): TGUIKeyRead2
;
521 function AddList(fText
: string; Width
, Height
: Word): TGUIListBox
;
522 function AddFileList(fText
: string; Width
, Height
: Word): TGUIFileListBox
;
523 function AddMemo(fText
: string; Width
, Height
: Word): TGUIMemo
;
525 function GetControl(aName
: string): TGUIControl
;
526 function GetControlsText(aName
: string): TGUILabel
;
527 procedure Draw
; override;
528 procedure Update
; override;
529 procedure UpdateIndex();
530 property Align
: Boolean read FAlign write FAlign
;
531 property Left
: Integer read FLeft write FLeft
;
532 property YesNo
: Boolean read FYesNo write FYesNo
;
536 g_GUIWindows
: array of TGUIWindow
;
537 g_ActiveWindow
: TGUIWindow
= nil;
539 procedure g_GUI_Init();
540 function g_GUI_AddWindow(Window
: TGUIWindow
): TGUIWindow
;
541 function g_GUI_GetWindow(Name
: string): TGUIWindow
;
542 procedure g_GUI_ShowWindow(Name
: string);
543 procedure g_GUI_HideWindow(PlaySound
: Boolean = True);
544 function g_GUI_Destroy(): Boolean;
545 procedure g_GUI_SaveMenuPos();
546 procedure g_GUI_LoadMenuPos();
552 {$INCLUDE ../nogl/noGLuses.inc}
553 g_textures
, g_sound
, SysUtils
,
554 g_game
, Math
, StrUtils
, g_player
, g_options
,
555 g_map
, g_weapons
, xdynrec
, wadreader
;
559 Box
: Array [0..8] of DWORD
;
560 Saved_Windows
: SSArray
;
563 procedure g_GUI_Init();
565 g_Texture_Get(BOX1
, Box
[0]);
566 g_Texture_Get(BOX2
, Box
[1]);
567 g_Texture_Get(BOX3
, Box
[2]);
568 g_Texture_Get(BOX4
, Box
[3]);
569 g_Texture_Get(BOX5
, Box
[4]);
570 g_Texture_Get(BOX6
, Box
[5]);
571 g_Texture_Get(BOX7
, Box
[6]);
572 g_Texture_Get(BOX8
, Box
[7]);
573 g_Texture_Get(BOX9
, Box
[8]);
576 function g_GUI_Destroy(): Boolean;
580 Result
:= (Length(g_GUIWindows
) > 0);
582 for i
:= 0 to High(g_GUIWindows
) do
583 g_GUIWindows
[i
].Free();
586 g_ActiveWindow
:= nil;
589 function g_GUI_AddWindow(Window
: TGUIWindow
): TGUIWindow
;
591 SetLength(g_GUIWindows
, Length(g_GUIWindows
)+1);
592 g_GUIWindows
[High(g_GUIWindows
)] := Window
;
597 function g_GUI_GetWindow(Name
: string): TGUIWindow
;
603 if g_GUIWindows
<> nil then
604 for i
:= 0 to High(g_GUIWindows
) do
605 if g_GUIWindows
[i
].FName
= Name
then
607 Result
:= g_GUIWindows
[i
];
611 Assert(Result
<> nil, 'GUI_Window "'+Name
+'" not found');
614 procedure g_GUI_ShowWindow(Name
: string);
618 if g_GUIWindows
= nil then
621 for i
:= 0 to High(g_GUIWindows
) do
622 if g_GUIWindows
[i
].FName
= Name
then
624 g_GUIWindows
[i
].FPrevWindow
:= g_ActiveWindow
;
625 g_ActiveWindow
:= g_GUIWindows
[i
];
627 if g_ActiveWindow
.MainWindow
then
628 g_ActiveWindow
.FPrevWindow
:= nil;
630 if g_ActiveWindow
.FDefControl
<> '' then
631 g_ActiveWindow
.SetActive(g_ActiveWindow
.GetControl(g_ActiveWindow
.FDefControl
))
633 g_ActiveWindow
.SetActive(nil);
635 if @g_ActiveWindow
.FOnShowEvent
<> nil then
636 g_ActiveWindow
.FOnShowEvent();
642 procedure g_GUI_HideWindow(PlaySound
: Boolean = True);
644 if g_ActiveWindow
<> nil then
646 if @g_ActiveWindow
.OnClose
<> nil then
647 g_ActiveWindow
.OnClose();
648 g_ActiveWindow
:= g_ActiveWindow
.FPrevWindow
;
650 g_Sound_PlayEx(WINDOW_CLOSESOUND
);
654 procedure g_GUI_SaveMenuPos();
659 SetLength(Saved_Windows
, 0);
660 win
:= g_ActiveWindow
;
664 len
:= Length(Saved_Windows
);
665 SetLength(Saved_Windows
, len
+ 1);
667 Saved_Windows
[len
] := win
.Name
;
669 if win
.MainWindow
then
672 win
:= win
.FPrevWindow
;
676 procedure g_GUI_LoadMenuPos();
678 i
, j
, k
, len
: Integer;
681 g_ActiveWindow
:= nil;
682 len
:= Length(Saved_Windows
);
687 // Îêíî ñ ãëàâíûì ìåíþ:
688 g_GUI_ShowWindow(Saved_Windows
[len
-1]);
690 // Íå ïåðåêëþ÷èëîñü (èëè íåêóäà äàëüøå):
691 if (len
= 1) or (g_ActiveWindow
= nil) then
694 // Èùåì êíîïêè â îñòàëüíûõ îêíàõ:
695 for k
:= len
-1 downto 1 do
699 for i
:= 0 to Length(g_ActiveWindow
.Childs
)-1 do
701 if g_ActiveWindow
.Childs
[i
] is TGUIMainMenu
then
702 begin // GUI_MainMenu
703 with TGUIMainMenu(g_ActiveWindow
.Childs
[i
]) do
704 for j
:= 0 to Length(FButtons
)-1 do
705 if FButtons
[j
].ShowWindow
= Saved_Windows
[k
-1] then
707 FButtons
[j
].Click(True);
713 if g_ActiveWindow
.Childs
[i
] is TGUIMenu
then
714 with TGUIMenu(g_ActiveWindow
.Childs
[i
]) do
715 for j
:= 0 to Length(FItems
)-1 do
716 if FItems
[j
].ControlType
= TGUITextButton
then
717 if TGUITextButton(FItems
[j
].Control
).ShowWindow
= Saved_Windows
[k
-1] then
719 TGUITextButton(FItems
[j
].Control
).Click(True);
730 (g_ActiveWindow
.Name
= Saved_Windows
[k
]) then
735 procedure DrawBox(X
, Y
: Integer; Width
, Height
: Word);
737 e_Draw(Box
[0], X
, Y
, 0, False, False);
738 e_DrawFill(Box
[1], X
+4, Y
, Width
*4, 1, 0, False, False);
739 e_Draw(Box
[2], X
+4+Width
*16, Y
, 0, False, False);
740 e_DrawFill(Box
[3], X
, Y
+4, 1, Height
*4, 0, False, False);
741 e_DrawFill(Box
[4], X
+4, Y
+4, Width
, Height
, 0, False, False);
742 e_DrawFill(Box
[5], X
+4+Width
*16, Y
+4, 1, Height
*4, 0, False, False);
743 e_Draw(Box
[6], X
, Y
+4+Height
*16, 0, False, False);
744 e_DrawFill(Box
[7], X
+4, Y
+4+Height
*16, Width
*4, 1, 0, False, False);
745 e_Draw(Box
[8], X
+4+Width
*16, Y
+4+Height
*16, 0, False, False);
748 procedure DrawScroll(X
, Y
: Integer; Height
: Word; Up
, Down
: Boolean);
752 if Height
< 3 then Exit
;
755 g_Texture_Get(BSCROLL_UPA
, ID
)
757 g_Texture_Get(BSCROLL_UPU
, ID
);
758 e_Draw(ID
, X
, Y
, 0, False, False);
761 g_Texture_Get(BSCROLL_DOWNA
, ID
)
763 g_Texture_Get(BSCROLL_DOWNU
, ID
);
764 e_Draw(ID
, X
, Y
+(Height
-1)*16, 0, False, False);
766 g_Texture_Get(BSCROLL_MIDDLE
, ID
);
767 e_DrawFill(ID
, X
, Y
+16, 1, Height
-2, 0, False, False);
772 constructor TGUIWindow
.Create(Name
: string);
775 FActiveControl
:= nil;
779 FOnCloseEvent
:= nil;
783 destructor TGUIWindow
.Destroy
;
790 for i
:= 0 to High(Childs
) do
794 function TGUIWindow
.AddChild(Child
: TGUIControl
): TGUIControl
;
796 Child
.FWindow
:= Self
;
798 SetLength(Childs
, Length(Childs
) + 1);
799 Childs
[High(Childs
)] := Child
;
804 procedure TGUIWindow
.Update
;
808 for i
:= 0 to High(Childs
) do
809 if Childs
[i
] <> nil then Childs
[i
].Update
;
812 procedure TGUIWindow
.Draw
;
817 if FBackTexture
<> '' then
818 if g_Texture_Get(FBackTexture
, ID
) then
819 e_DrawSize(ID
, 0, 0, 0, False, False, gScreenWidth
, gScreenHeight
)
821 e_Clear(GL_COLOR_BUFFER_BIT
, 0.5, 0.5, 0.5);
823 for i
:= 0 to High(Childs
) do
824 if Childs
[i
] <> nil then Childs
[i
].Draw
;
827 procedure TGUIWindow
.OnMessage(var Msg
: TMessage
);
829 if FActiveControl
<> nil then FActiveControl
.OnMessage(Msg
);
830 if @FOnKeyDown
<> nil then FOnKeyDown(Msg
.wParam
);
831 if @FOnKeyDownEx
<> nil then FOnKeyDownEx(self
, Msg
.wParam
);
833 if Msg
.Msg
= WM_KEYDOWN
then
834 if (Msg
.wParam
= IK_ESCAPE
) or (Msg
.wParam
= VK_ESCAPE
) then
841 procedure TGUIWindow
.SetActive(Control
: TGUIControl
);
843 FActiveControl
:= Control
;
846 function TGUIWindow
.GetControl(Name
: String): TGUIControl
;
852 if Childs
<> nil then
853 for i
:= 0 to High(Childs
) do
854 if Childs
[i
] <> nil then
855 if LowerCase(Childs
[i
].FName
) = LowerCase(Name
) then
861 Assert(Result
<> nil, 'Window Control "'+Name
+'" not Found!');
866 constructor TGUIControl
.Create();
872 FRightAlign
:= false;
876 procedure TGUIControl
.OnMessage(var Msg
: TMessage
);
882 procedure TGUIControl
.Update();
886 procedure TGUIControl
.Draw();
890 function TGUIControl
.WantActivationKey (key
: LongInt): Boolean;
895 function TGUIControl
.GetWidth(): Integer;
900 function TGUIControl
.GetHeight(): Integer;
907 procedure TGUITextButton
.Click(Silent
: Boolean = False);
909 if (FSound
<> '') and (not Silent
) then g_Sound_PlayEx(FSound
);
911 if @Proc
<> nil then Proc();
912 if @ProcEx
<> nil then ProcEx(self
);
914 if FShowWindow
<> '' then g_GUI_ShowWindow(FShowWindow
);
917 constructor TGUITextButton
.Create(aProc
: Pointer; FontID
: DWORD
; Text: string);
924 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
929 destructor TGUITextButton
.Destroy
;
935 procedure TGUITextButton
.Draw
;
937 FFont
.Draw(FX
, FY
, FText
, FColor
.R
, FColor
.G
, FColor
.B
)
940 function TGUITextButton
.GetHeight
: Integer;
944 FFont
.GetTextSize(FText
, w
, h
);
948 function TGUITextButton
.GetWidth
: Integer;
952 FFont
.GetTextSize(FText
, w
, h
);
956 procedure TGUITextButton
.OnMessage(var Msg
: TMessage
);
958 if not FEnabled
then Exit
;
965 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
: Click();
970 procedure TGUITextButton
.Update
;
977 constructor TFont
.Create(FontID
: DWORD
; FontType
: TFontType
);
982 FFontType
:= FontType
;
985 destructor TFont
.Destroy
;
991 procedure TFont
.Draw(X
, Y
: Integer; Text: string; R
, G
, B
: Byte);
993 if FFontType
= TFontType
.Character
then e_CharFont_PrintEx(ID
, X
, Y
, Text, _RGB(R
, G
, B
), FScale
)
994 else e_TextureFontPrintEx(X
, Y
, Text, ID
, R
, G
, B
, FScale
);
997 procedure TFont
.GetTextSize(Text: string; var w
, h
: Word);
1001 if FFontType
= TFontType
.Character
then e_CharFont_GetSize(ID
, Text, w
, h
)
1004 e_TextureFontGetSize(ID
, cw
, ch
);
1005 w
:= cw
*Length(Text);
1009 w
:= Round(w
*FScale
);
1010 h
:= Round(h
*FScale
);
1015 function TGUIMainMenu
.AddButton(fProc
: Pointer; Caption
: string; ShowWindow
: string = ''): TGUITextButton
;
1022 SetLength(FButtons
, Length(FButtons
)+1);
1023 FButtons
[High(FButtons
)] := TGUITextButton
.Create(fProc
, FFontID
, Caption
);
1024 FButtons
[High(FButtons
)].ShowWindow
:= ShowWindow
;
1025 with FButtons
[High(FButtons
)] do
1027 if (fProc
<> nil) or (ShowWindow
<> '') then FColor
:= MAINMENU_ITEMS_COLOR
1028 else FColor
:= MAINMENU_UNACTIVEITEMS_COLOR
;
1029 FSound
:= MAINMENU_CLICKSOUND
;
1032 _x
:= gScreenWidth
div 2;
1034 for a
:= 0 to High(FButtons
) do
1035 if FButtons
[a
] <> nil then
1036 _x
:= Min(_x
, (gScreenWidth
div 2)-(FButtons
[a
].GetWidth
div 2));
1038 hh
:= FHeader
.GetHeight
;
1040 h
:= hh
*(2+Length(FButtons
))+MAINMENU_SPACE
*(Length(FButtons
)-1);
1041 h
:= (gScreenHeight
div 2)-(h
div 2);
1051 for a
:= 0 to High(FButtons
) do
1053 if FButtons
[a
] <> nil then
1060 Inc(h
, hh
+MAINMENU_SPACE
);
1063 Result
:= FButtons
[High(FButtons
)];
1066 procedure TGUIMainMenu
.AddSpace
;
1068 SetLength(FButtons
, Length(FButtons
)+1);
1069 FButtons
[High(FButtons
)] := nil;
1072 constructor TGUIMainMenu
.Create(FontID
: DWORD
; Header
: string);
1078 FCounter
:= MAINMENU_MARKERDELAY
;
1080 g_Texture_Get(MAINMENU_MARKER1
, FMarkerID1
);
1081 g_Texture_Get(MAINMENU_MARKER2
, FMarkerID2
);
1083 FHeader
:= TGUILabel
.Create(Header
, FFontID
);
1086 FColor
:= MAINMENU_HEADER_COLOR
;
1087 FX
:= (gScreenWidth
div 2)-(GetWidth
div 2);
1088 FY
:= (gScreenHeight
div 2)-(GetHeight
div 2);
1092 destructor TGUIMainMenu
.Destroy
;
1096 if FButtons
<> nil then
1097 for a
:= 0 to High(FButtons
) do
1105 procedure TGUIMainMenu
.Draw
;
1113 if FButtons
<> nil then
1115 for a
:= 0 to High(FButtons
) do
1116 if FButtons
[a
] <> nil then FButtons
[a
].Draw
;
1118 if FIndex
<> -1 then
1119 e_Draw(FMarkerID1
, FButtons
[FIndex
].FX
-48, FButtons
[FIndex
].FY
, 0, True, False);
1123 procedure TGUIMainMenu
.EnableButton(aName
: string; e
: Boolean);
1127 if FButtons
= nil then Exit
;
1129 for a
:= 0 to High(FButtons
) do
1130 if (FButtons
[a
] <> nil) and (FButtons
[a
].Name
= aName
) then
1132 if e
then FButtons
[a
].FColor
:= MAINMENU_ITEMS_COLOR
1133 else FButtons
[a
].FColor
:= MAINMENU_UNACTIVEITEMS_COLOR
;
1134 FButtons
[a
].Enabled
:= e
;
1139 function TGUIMainMenu
.GetButton(aName
: string): TGUITextButton
;
1145 if FButtons
= nil then Exit
;
1147 for a
:= 0 to High(FButtons
) do
1148 if (FButtons
[a
] <> nil) and (FButtons
[a
].Name
= aName
) then
1150 Result
:= FButtons
[a
];
1155 procedure TGUIMainMenu
.OnMessage(var Msg
: TMessage
);
1160 if not FEnabled
then Exit
;
1164 if FButtons
= nil then Exit
;
1167 for a
:= 0 to High(FButtons
) do
1168 if FButtons
[a
] <> nil then
1174 if not ok
then Exit
;
1179 IK_UP
, IK_KPUP
, VK_UP
:
1183 if FIndex
< 0 then FIndex
:= High(FButtons
);
1184 until FButtons
[FIndex
] <> nil;
1186 g_Sound_PlayEx(MENU_CHANGESOUND
);
1188 IK_DOWN
, IK_KPDOWN
, VK_DOWN
:
1192 if FIndex
> High(FButtons
) then FIndex
:= 0;
1193 until FButtons
[FIndex
] <> nil;
1195 g_Sound_PlayEx(MENU_CHANGESOUND
);
1197 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
: if (FIndex
<> -1) and FButtons
[FIndex
].FEnabled
then FButtons
[FIndex
].Click
;
1202 procedure TGUIMainMenu
.Update
;
1208 if FCounter
= 0 then
1211 FMarkerID1
:= FMarkerID2
;
1214 FCounter
:= MAINMENU_MARKERDELAY
;
1215 end else Dec(FCounter
);
1220 constructor TGUILabel
.Create(Text: string; FontID
: DWORD
);
1224 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
1228 FOnClickEvent
:= nil;
1231 procedure TGUILabel
.Draw
;
1237 FFont
.GetTextSize(FText
, w
, h
);
1238 FFont
.Draw(FX
+FMaxWidth
-w
, FY
, FText
, FColor
.R
, FColor
.G
, FColor
.B
);
1242 FFont
.Draw(FX
, FY
, FText
, FColor
.R
, FColor
.G
, FColor
.B
);
1246 function TGUILabel
.GetHeight
: Integer;
1250 FFont
.GetTextSize(FText
, w
, h
);
1254 function TGUILabel
.GetWidth
: Integer;
1258 if FFixedLen
= 0 then
1259 FFont
.GetTextSize(FText
, w
, h
)
1261 w
:= e_CharFont_GetMaxWidth(FFont
.ID
)*FFixedLen
;
1265 procedure TGUILabel
.OnMessage(var Msg
: TMessage
);
1267 if not FEnabled
then Exit
;
1274 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
: if @FOnClickEvent
<> nil then FOnClickEvent();
1281 function TGUIMenu
.AddButton(Proc
: Pointer; fText
: string; _ShowWindow
: string = ''): TGUITextButton
;
1288 Control
:= TGUITextButton
.Create(Proc
, FFontID
, fText
);
1289 with Control
as TGUITextButton
do
1291 ShowWindow
:= _ShowWindow
;
1292 FColor
:= MENU_ITEMSCTRL_COLOR
;
1296 ControlType
:= TGUITextButton
;
1298 Result
:= (Control
as TGUITextButton
);
1301 if FIndex
= -1 then FIndex
:= i
;
1306 procedure TGUIMenu
.AddLine(fText
: string);
1313 Text := TGUILabel
.Create(fText
, FFontID
);
1316 FColor
:= MENU_ITEMSTEXT_COLOR
;
1325 procedure TGUIMenu
.AddText(fText
: string; MaxWidth
: Word);
1330 l
:= GetLines(fText
, FFontID
, MaxWidth
);
1332 if l
= nil then Exit
;
1334 for a
:= 0 to High(l
) do
1339 Text := TGUILabel
.Create(l
[a
], FFontID
);
1342 with Text do begin FColor
:= _RGB(255, 0, 0); end;
1346 with Text do begin FColor
:= MENU_ITEMSTEXT_COLOR
; end;
1356 procedure TGUIMenu
.AddSpace
;
1370 constructor TGUIMenu
.Create(HeaderFont
, ItemsFont
: DWORD
; Header
: string);
1376 FFontID
:= ItemsFont
;
1377 FCounter
:= MENU_MARKERDELAY
;
1381 FHeader
:= TGUILabel
.Create(Header
, HeaderFont
);
1384 FX
:= (gScreenWidth
div 2)-(GetWidth
div 2);
1386 FColor
:= MAINMENU_HEADER_COLOR
;
1390 destructor TGUIMenu
.Destroy
;
1394 if FItems
<> nil then
1395 for a
:= 0 to High(FItems
) do
1409 procedure TGUIMenu
.Draw
;
1411 a
, locx
, locy
: Integer;
1415 if FHeader
<> nil then FHeader
.Draw
;
1417 if FItems
<> nil then
1418 for a
:= 0 to High(FItems
) do
1420 if FItems
[a
].Text <> nil then FItems
[a
].Text.Draw
;
1421 if FItems
[a
].Control
<> nil then FItems
[a
].Control
.Draw
;
1424 if (FIndex
<> -1) and (FCounter
> MENU_MARKERDELAY
div 2) then
1429 if FItems
[FIndex
].Text <> nil then
1431 locx
:= FItems
[FIndex
].Text.FX
;
1432 locy
:= FItems
[FIndex
].Text.FY
;
1434 if FItems
[FIndex
].Text.RightAlign
then
1436 locx
:= locx
+FItems
[FIndex
].Text.FMaxWidth
-FItems
[FIndex
].Text.GetWidth
;
1439 else if FItems
[FIndex
].Control
<> nil then
1441 locx
:= FItems
[FIndex
].Control
.FX
;
1442 locy
:= FItems
[FIndex
].Control
.FY
;
1445 locx
:= locx
-e_CharFont_GetMaxWidth(FFontID
);
1447 e_CharFont_PrintEx(FFontID
, locx
, locy
, #16, _RGB(255, 0, 0));
1451 function TGUIMenu
.GetControl(aName
: String): TGUIControl
;
1457 if FItems
<> nil then
1458 for a
:= 0 to High(FItems
) do
1459 if FItems
[a
].Control
<> nil then
1460 if LowerCase(FItems
[a
].Control
.Name
) = LowerCase(aName
) then
1462 Result
:= FItems
[a
].Control
;
1466 Assert(Result
<> nil, 'GUI control "'+aName
+'" not found!');
1469 function TGUIMenu
.GetControlsText(aName
: String): TGUILabel
;
1475 if FItems
<> nil then
1476 for a
:= 0 to High(FItems
) do
1477 if FItems
[a
].Control
<> nil then
1478 if LowerCase(FItems
[a
].Control
.Name
) = LowerCase(aName
) then
1480 Result
:= FItems
[a
].Text;
1484 Assert(Result
<> nil, 'GUI control''s text "'+aName
+'" not found!');
1487 function TGUIMenu
.NewItem
: Integer;
1489 SetLength(FItems
, Length(FItems
)+1);
1490 Result
:= High(FItems
);
1493 procedure TGUIMenu
.OnMessage(var Msg
: TMessage
);
1498 if not FEnabled
then Exit
;
1502 if FItems
= nil then Exit
;
1505 for a
:= 0 to High(FItems
) do
1506 if FItems
[a
].Control
<> nil then
1512 if not ok
then Exit
;
1514 if (Msg
.Msg
= WM_KEYDOWN
) and (FIndex
<> -1) and (FItems
[FIndex
].Control
<> nil) and
1515 (FItems
[FIndex
].Control
.WantActivationKey(Msg
.wParam
)) then
1517 FItems
[FIndex
].Control
.OnMessage(Msg
);
1518 g_Sound_PlayEx(MENU_CLICKSOUND
);
1526 IK_UP
, IK_KPUP
, VK_UP
:
1531 if c
> Length(FItems
) then
1538 if FIndex
< 0 then FIndex
:= High(FItems
);
1539 until (FItems
[FIndex
].Control
<> nil) and
1540 (FItems
[FIndex
].Control
.Enabled
);
1544 g_Sound_PlayEx(MENU_CHANGESOUND
);
1547 IK_DOWN
, IK_KPDOWN
, VK_DOWN
:
1552 if c
> Length(FItems
) then
1559 if FIndex
> High(FItems
) then FIndex
:= 0;
1560 until (FItems
[FIndex
].Control
<> nil) and
1561 (FItems
[FIndex
].Control
.Enabled
);
1565 g_Sound_PlayEx(MENU_CHANGESOUND
);
1568 IK_LEFT
, IK_RIGHT
, IK_KPLEFT
, IK_KPRIGHT
, VK_LEFT
, VK_RIGHT
:
1570 if FIndex
<> -1 then
1571 if FItems
[FIndex
].Control
<> nil then
1572 FItems
[FIndex
].Control
.OnMessage(Msg
);
1574 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
:
1576 if FIndex
<> -1 then
1578 if FItems
[FIndex
].Control
<> nil then FItems
[FIndex
].Control
.OnMessage(Msg
);
1580 g_Sound_PlayEx(MENU_CLICKSOUND
);
1584 if FYesNo
and (length(FItems
) > 1) then
1586 Msg
.wParam
:= IK_RETURN
; // to register keypress
1587 FIndex
:= High(FItems
)-1;
1588 if FItems
[FIndex
].Control
<> nil then FItems
[FIndex
].Control
.OnMessage(Msg
);
1591 if FYesNo
and (length(FItems
) > 1) then
1593 Msg
.wParam
:= IK_RETURN
; // to register keypress
1594 FIndex
:= High(FItems
);
1595 if FItems
[FIndex
].Control
<> nil then FItems
[FIndex
].Control
.OnMessage(Msg
);
1602 procedure TGUIMenu
.ReAlign();
1604 a
, tx
, cx
, w
, h
: Integer;
1605 cww
: array of Integer; // cached widths
1608 if FItems
= nil then Exit
;
1610 SetLength(cww
, length(FItems
));
1612 for a
:= 0 to High(FItems
) do
1614 if FItems
[a
].Text <> nil then
1616 cww
[a
] := FItems
[a
].Text.GetWidth
;
1617 if maxcww
< cww
[a
] then maxcww
:= cww
[a
];
1628 for a
:= 0 to High(FItems
) do
1631 if FItems
[a
].Text <> nil then w
:= FItems
[a
].Text.GetWidth
;
1632 if FItems
[a
].Control
<> nil then
1635 if FItems
[a
].ControlType
= TGUILabel
then w
:= w
+(FItems
[a
].Control
as TGUILabel
).GetWidth
1636 else if FItems
[a
].ControlType
= TGUITextButton
then w
:= w
+(FItems
[a
].Control
as TGUITextButton
).GetWidth
1637 else if FItems
[a
].ControlType
= TGUIScroll
then w
:= w
+(FItems
[a
].Control
as TGUIScroll
).GetWidth
1638 else if FItems
[a
].ControlType
= TGUISwitch
then w
:= w
+(FItems
[a
].Control
as TGUISwitch
).GetWidth
1639 else if FItems
[a
].ControlType
= TGUIEdit
then w
:= w
+(FItems
[a
].Control
as TGUIEdit
).GetWidth
1640 else if FItems
[a
].ControlType
= TGUIKeyRead
then w
:= w
+(FItems
[a
].Control
as TGUIKeyRead
).GetWidth
1641 else if FItems
[a
].ControlType
= TGUIKeyRead2
then w
:= w
+(FItems
[a
].Control
as TGUIKeyRead2
).GetWidth
1642 else if FItems
[a
].ControlType
= TGUIListBox
then w
:= w
+(FItems
[a
].Control
as TGUIListBox
).GetWidth
1643 else if FItems
[a
].ControlType
= TGUIFileListBox
then w
:= w
+(FItems
[a
].Control
as TGUIFileListBox
).GetWidth
1644 else if FItems
[a
].ControlType
= TGUIMemo
then w
:= w
+(FItems
[a
].Control
as TGUIMemo
).GetWidth
;
1646 tx
:= Min(tx
, (gScreenWidth
div 2)-(w
div 2));
1651 for a
:= 0 to High(FItems
) do
1655 if (Text <> nil) and (Control
= nil) then Continue
;
1657 if Text <> nil then w
:= tx
+Text.GetWidth
;
1658 if w
> cx
then cx
:= w
;
1662 cx
:= cx
+MENU_HSPACE
;
1664 h
:= FHeader
.GetHeight
*2+MENU_VSPACE
*(Length(FItems
)-1);
1666 for a
:= 0 to High(FItems
) do
1670 if (ControlType
= TGUIListBox
) or (ControlType
= TGUIFileListBox
) then
1671 h
:= h
+(FItems
[a
].Control
as TGUIListBox
).GetHeight()
1673 h
:= h
+e_CharFont_GetMaxHeight(FFontID
);
1677 h
:= (gScreenHeight
div 2)-(h
div 2);
1681 FX
:= (gScreenWidth
div 2)-(GetWidth
div 2);
1684 Inc(h
, GetHeight
*2);
1687 for a
:= 0 to High(FItems
) do
1699 if Text.RightAlign
and (length(cww
) > a
) then
1701 //Text.FX := Text.FX+maxcww;
1702 Text.FMaxWidth
:= maxcww
;
1706 if Control
<> nil then
1723 if (ControlType
= TGUIListBox
) or (ControlType
= TGUIFileListBox
) then Inc(h
, (Control
as TGUIListBox
).GetHeight
+MENU_VSPACE
)
1724 else if ControlType
= TGUIMemo
then Inc(h
, (Control
as TGUIMemo
).GetHeight
+MENU_VSPACE
)
1725 else Inc(h
, e_CharFont_GetMaxHeight(FFontID
)+MENU_VSPACE
);
1729 // another ugly hack
1730 if FYesNo
and (length(FItems
) > 1) then
1733 for a
:= High(FItems
)-1 to High(FItems
) do
1735 if (FItems
[a
].Control
<> nil) and (FItems
[a
].ControlType
= TGUITextButton
) then
1737 cx
:= (FItems
[a
].Control
as TGUITextButton
).GetWidth
;
1738 if cx
> w
then w
:= cx
;
1743 for a
:= High(FItems
)-1 to High(FItems
) do
1745 if (FItems
[a
].Control
<> nil) and (FItems
[a
].ControlType
= TGUITextButton
) then
1747 FItems
[a
].Control
.FX
:= (gScreenWidth
-w
) div 2;
1754 function TGUIMenu
.AddScroll(fText
: string): TGUIScroll
;
1761 Control
:= TGUIScroll
.Create();
1763 Text := TGUILabel
.Create(fText
, FFontID
);
1766 FColor
:= MENU_ITEMSTEXT_COLOR
;
1769 ControlType
:= TGUIScroll
;
1771 Result
:= (Control
as TGUIScroll
);
1774 if FIndex
= -1 then FIndex
:= i
;
1779 function TGUIMenu
.AddSwitch(fText
: string): TGUISwitch
;
1786 Control
:= TGUISwitch
.Create(FFontID
);
1787 (Control
as TGUISwitch
).FColor
:= MENU_ITEMSCTRL_COLOR
;
1789 Text := TGUILabel
.Create(fText
, FFontID
);
1792 FColor
:= MENU_ITEMSTEXT_COLOR
;
1795 ControlType
:= TGUISwitch
;
1797 Result
:= (Control
as TGUISwitch
);
1800 if FIndex
= -1 then FIndex
:= i
;
1805 function TGUIMenu
.AddEdit(fText
: string): TGUIEdit
;
1812 Control
:= TGUIEdit
.Create(FFontID
);
1813 with Control
as TGUIEdit
do
1815 FWindow
:= Self
.FWindow
;
1816 FColor
:= MENU_ITEMSCTRL_COLOR
;
1819 if fText
= '' then Text := nil else
1821 Text := TGUILabel
.Create(fText
, FFontID
);
1822 Text.FColor
:= MENU_ITEMSTEXT_COLOR
;
1825 ControlType
:= TGUIEdit
;
1827 Result
:= (Control
as TGUIEdit
);
1830 if FIndex
= -1 then FIndex
:= i
;
1835 procedure TGUIMenu
.Update
;
1841 if FCounter
= 0 then FCounter
:= MENU_MARKERDELAY
else Dec(FCounter
);
1843 if FItems
<> nil then
1844 for a
:= 0 to High(FItems
) do
1845 if FItems
[a
].Control
<> nil then
1846 (FItems
[a
].Control
as FItems
[a
].ControlType
).Update
;
1849 function TGUIMenu
.AddKeyRead(fText
: string): TGUIKeyRead
;
1856 Control
:= TGUIKeyRead
.Create(FFontID
);
1857 with Control
as TGUIKeyRead
do
1859 FWindow
:= Self
.FWindow
;
1860 FColor
:= MENU_ITEMSCTRL_COLOR
;
1863 Text := TGUILabel
.Create(fText
, FFontID
);
1866 FColor
:= MENU_ITEMSTEXT_COLOR
;
1869 ControlType
:= TGUIKeyRead
;
1871 Result
:= (Control
as TGUIKeyRead
);
1874 if FIndex
= -1 then FIndex
:= i
;
1879 function TGUIMenu
.AddKeyRead2(fText
: string): TGUIKeyRead2
;
1886 Control
:= TGUIKeyRead2
.Create(FFontID
);
1887 with Control
as TGUIKeyRead2
do
1889 FWindow
:= Self
.FWindow
;
1890 FColor
:= MENU_ITEMSCTRL_COLOR
;
1893 Text := TGUILabel
.Create(fText
, FFontID
);
1896 FColor
:= MENU_ITEMSCTRL_COLOR
; //MENU_ITEMSTEXT_COLOR;
1900 ControlType
:= TGUIKeyRead2
;
1902 Result
:= (Control
as TGUIKeyRead2
);
1905 if FIndex
= -1 then FIndex
:= i
;
1910 function TGUIMenu
.AddList(fText
: string; Width
, Height
: Word): TGUIListBox
;
1917 Control
:= TGUIListBox
.Create(FFontID
, Width
, Height
);
1918 with Control
as TGUIListBox
do
1920 FWindow
:= Self
.FWindow
;
1921 FActiveColor
:= MENU_ITEMSCTRL_COLOR
;
1922 FUnActiveColor
:= MENU_ITEMSTEXT_COLOR
;
1925 Text := TGUILabel
.Create(fText
, FFontID
);
1928 FColor
:= MENU_ITEMSTEXT_COLOR
;
1931 ControlType
:= TGUIListBox
;
1933 Result
:= (Control
as TGUIListBox
);
1936 if FIndex
= -1 then FIndex
:= i
;
1941 function TGUIMenu
.AddFileList(fText
: string; Width
, Height
: Word): TGUIFileListBox
;
1948 Control
:= TGUIFileListBox
.Create(FFontID
, Width
, Height
);
1949 with Control
as TGUIFileListBox
do
1951 FWindow
:= Self
.FWindow
;
1952 FActiveColor
:= MENU_ITEMSCTRL_COLOR
;
1953 FUnActiveColor
:= MENU_ITEMSTEXT_COLOR
;
1956 if fText
= '' then Text := nil else
1958 Text := TGUILabel
.Create(fText
, FFontID
);
1959 Text.FColor
:= MENU_ITEMSTEXT_COLOR
;
1962 ControlType
:= TGUIFileListBox
;
1964 Result
:= (Control
as TGUIFileListBox
);
1967 if FIndex
= -1 then FIndex
:= i
;
1972 function TGUIMenu
.AddLabel(fText
: string): TGUILabel
;
1979 Control
:= TGUILabel
.Create('', FFontID
);
1980 with Control
as TGUILabel
do
1982 FWindow
:= Self
.FWindow
;
1983 FColor
:= MENU_ITEMSCTRL_COLOR
;
1986 Text := TGUILabel
.Create(fText
, FFontID
);
1989 FColor
:= MENU_ITEMSTEXT_COLOR
;
1992 ControlType
:= TGUILabel
;
1994 Result
:= (Control
as TGUILabel
);
1997 if FIndex
= -1 then FIndex
:= i
;
2002 function TGUIMenu
.AddMemo(fText
: string; Width
, Height
: Word): TGUIMemo
;
2009 Control
:= TGUIMemo
.Create(FFontID
, Width
, Height
);
2010 with Control
as TGUIMemo
do
2012 FWindow
:= Self
.FWindow
;
2013 FColor
:= MENU_ITEMSTEXT_COLOR
;
2016 if fText
= '' then Text := nil else
2018 Text := TGUILabel
.Create(fText
, FFontID
);
2019 Text.FColor
:= MENU_ITEMSTEXT_COLOR
;
2022 ControlType
:= TGUIMemo
;
2024 Result
:= (Control
as TGUIMemo
);
2027 if FIndex
= -1 then FIndex
:= i
;
2032 procedure TGUIMenu
.UpdateIndex();
2040 if (FIndex
< 0) or (FIndex
> High(FItems
)) then
2046 if FItems
[FIndex
].Control
.Enabled
then
2055 constructor TGUIScroll
.Create
;
2060 FOnChangeEvent
:= nil;
2062 g_Texture_Get(SCROLL_LEFT
, FLeftID
);
2063 g_Texture_Get(SCROLL_RIGHT
, FRightID
);
2064 g_Texture_Get(SCROLL_MIDDLE
, FMiddleID
);
2065 g_Texture_Get(SCROLL_MARKER
, FMarkerID
);
2068 procedure TGUIScroll
.Draw
;
2074 e_Draw(FLeftID
, FX
, FY
, 0, True, False);
2075 e_Draw(FRightID
, FX
+8+(FMax
+1)*8, FY
, 0, True, False);
2077 for a
:= 0 to FMax
do
2078 e_Draw(FMiddleID
, FX
+8+a
*8, FY
, 0, True, False);
2080 e_Draw(FMarkerID
, FX
+8+FValue
*8, FY
, 0, True, False);
2083 procedure TGUIScroll
.FSetValue(a
: Integer);
2085 if a
> FMax
then FValue
:= FMax
else FValue
:= a
;
2088 function TGUIScroll
.GetWidth
: Integer;
2090 Result
:= 16+(FMax
+1)*8;
2093 procedure TGUIScroll
.OnMessage(var Msg
: TMessage
);
2095 if not FEnabled
then Exit
;
2103 IK_LEFT
, IK_KPLEFT
, VK_LEFT
:
2107 g_Sound_PlayEx(SCROLL_SUBSOUND
);
2108 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2110 IK_RIGHT
, IK_KPRIGHT
, VK_RIGHT
:
2111 if FValue
< FMax
then
2114 g_Sound_PlayEx(SCROLL_ADDSOUND
);
2115 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2122 procedure TGUIScroll
.Update
;
2130 procedure TGUISwitch
.AddItem(Item
: string);
2132 SetLength(FItems
, Length(FItems
)+1);
2133 FItems
[High(FItems
)] := Item
;
2135 if FIndex
= -1 then FIndex
:= 0;
2138 constructor TGUISwitch
.Create(FontID
: DWORD
);
2144 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
2147 procedure TGUISwitch
.Draw
;
2151 FFont
.Draw(FX
, FY
, FItems
[FIndex
], FColor
.R
, FColor
.G
, FColor
.B
);
2154 function TGUISwitch
.GetText
: string;
2156 if FIndex
<> -1 then Result
:= FItems
[FIndex
]
2160 function TGUISwitch
.GetWidth
: Integer;
2167 if FItems
= nil then Exit
;
2169 for a
:= 0 to High(FItems
) do
2171 FFont
.GetTextSize(FItems
[a
], w
, h
);
2172 if w
> Result
then Result
:= w
;
2176 procedure TGUISwitch
.OnMessage(var Msg
: TMessage
);
2178 if not FEnabled
then Exit
;
2182 if FItems
= nil then Exit
;
2187 IK_RETURN
, IK_RIGHT
, IK_KPRETURN
, IK_KPRIGHT
, VK_FIRE
, VK_OPEN
, VK_RIGHT
:
2189 if FIndex
< High(FItems
) then
2194 if @FOnChangeEvent
<> nil then
2195 FOnChangeEvent(Self
);
2198 IK_LEFT
, IK_KPLEFT
, VK_LEFT
:
2203 FIndex
:= High(FItems
);
2205 if @FOnChangeEvent
<> nil then
2206 FOnChangeEvent(Self
);
2212 procedure TGUISwitch
.Update
;
2220 constructor TGUIEdit
.Create(FontID
: DWORD
);
2224 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
2230 g_Texture_Get(EDIT_LEFT
, FLeftID
);
2231 g_Texture_Get(EDIT_RIGHT
, FRightID
);
2232 g_Texture_Get(EDIT_MIDDLE
, FMiddleID
);
2235 procedure TGUIEdit
.Draw
;
2242 e_Draw(FLeftID
, FX
, FY
, 0, True, False);
2243 e_Draw(FRightID
, FX
+8+FWidth
*16, FY
, 0, True, False);
2245 for c
:= 0 to FWidth
-1 do
2246 e_Draw(FMiddleID
, FX
+8+c
*16, FY
, 0, True, False);
2251 if FInvalid
and (FWindow
.FActiveControl
<> self
) then begin r
:= 128; g
:= 128; b
:= 128; end;
2252 FFont
.Draw(FX
+8, FY
, FText
, r
, g
, b
);
2254 if (FWindow
.FActiveControl
= self
) then
2256 FFont
.GetTextSize(Copy(FText
, 1, FCaretPos
), w
, h
);
2257 h
:= e_CharFont_GetMaxHeight(FFont
.ID
);
2258 e_DrawLine(2, FX
+8+w
, FY
+h
-3, FX
+8+w
+EDIT_CURSORLEN
, FY
+h
-3,
2259 EDIT_CURSORCOLOR
.R
, EDIT_CURSORCOLOR
.G
, EDIT_CURSORCOLOR
.B
);
2263 function TGUIEdit
.GetWidth
: Integer;
2265 Result
:= 16+FWidth
*16;
2268 procedure TGUIEdit
.OnMessage(var Msg
: TMessage
);
2270 if not FEnabled
then Exit
;
2279 if (wParam
in [48..57]) and (Chr(wParam
) <> '`') then
2280 if Length(Text) < FMaxLength
then
2282 Insert(Chr(wParam
), FText
, FCaretPos
+ 1);
2288 if (wParam
in [32..255]) and (Chr(wParam
) <> '`') then
2289 if Length(Text) < FMaxLength
then
2291 Insert(Chr(wParam
), FText
, FCaretPos
+ 1);
2299 Delete(FText
, FCaretPos
, 1);
2300 if FCaretPos
> 0 then Dec(FCaretPos
);
2302 IK_DELETE
: Delete(FText
, FCaretPos
+ 1, 1);
2303 IK_END
, IK_KPEND
: FCaretPos
:= Length(FText
);
2304 IK_HOME
, IK_KPHOME
: FCaretPos
:= 0;
2305 IK_LEFT
, IK_KPLEFT
, VK_LEFT
: if FCaretPos
> 0 then Dec(FCaretPos
);
2306 IK_RIGHT
, IK_KPRIGHT
, VK_RIGHT
: if FCaretPos
< Length(FText
) then Inc(FCaretPos
);
2307 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
:
2310 if FActiveControl
<> Self
then
2313 if @FOnEnterEvent
<> nil then FOnEnterEvent(Self
);
2317 if FDefControl
<> '' then SetActive(GetControl(FDefControl
))
2318 else SetActive(nil);
2319 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2325 g_Touch_ShowKeyboard(FWindow
.FActiveControl
= Self
);
2328 procedure TGUIEdit
.SetText(Text: string);
2330 if Length(Text) > FMaxLength
then SetLength(Text, FMaxLength
);
2332 FCaretPos
:= Length(FText
);
2335 procedure TGUIEdit
.Update
;
2342 constructor TGUIKeyRead
.Create(FontID
: DWORD
);
2348 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
2351 procedure TGUIKeyRead
.Draw
;
2355 FFont
.Draw(FX
, FY
, IfThen(FIsQuery
, KEYREAD_QUERY
, IfThen(FKey
<> 0, e_KeyNames
[FKey
], KEYREAD_CLEAR
)),
2356 FColor
.R
, FColor
.G
, FColor
.B
);
2359 function TGUIKeyRead
.GetWidth
: Integer;
2366 for a
:= 0 to 255 do
2368 FFont
.GetTextSize(e_KeyNames
[a
], w
, h
);
2369 Result
:= Max(Result
, w
);
2372 FFont
.GetTextSize(KEYREAD_QUERY
, w
, h
);
2373 if w
> Result
then Result
:= w
;
2375 FFont
.GetTextSize(KEYREAD_CLEAR
, w
, h
);
2376 if w
> Result
then Result
:= w
;
2379 function TGUIKeyRead
.WantActivationKey (key
: LongInt): Boolean;
2382 (key
= IK_BACKSPACE
) or
2386 procedure TGUIKeyRead
.OnMessage(var Msg
: TMessage
);
2387 procedure actDefCtl ();
2390 if FDefControl
<> '' then
2391 SetActive(GetControl(FDefControl
))
2399 if not FEnabled
then
2406 IK_ESCAPE
, VK_ESCAPE
:
2408 if FIsQuery
then actDefCtl();
2411 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
:
2413 if not FIsQuery
then
2416 if FActiveControl
<> Self
then
2423 FKey
:= IK_ENTER
; // <Enter>
2428 IK_BACKSPACE
: // clear keybinding if we aren't waiting for a key
2430 if not FIsQuery
then
2440 if not FIsQuery
and (wParam
= IK_BACKSPACE
) then
2445 else if FIsQuery
and (wParam
<> IK_ENTER
) and (wParam
<> IK_KPRETURN
) and (wParam
<> VK_FIRE
) and (wParam
<> VK_OPEN
) then // Not <Enter
2447 if e_KeyNames
[wParam
] <> '' then
2458 constructor TGUIKeyRead2
.Create(FontID
: DWORD
);
2471 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
2473 FMaxKeyNameWdt
:= 0;
2474 for a
:= 0 to 255 do
2476 FFont
.GetTextSize(e_KeyNames
[a
], w
, h
);
2477 FMaxKeyNameWdt
:= Max(FMaxKeyNameWdt
, w
);
2480 FMaxKeyNameWdt
:= FMaxKeyNameWdt
-(FMaxKeyNameWdt
div 3);
2482 FFont
.GetTextSize(KEYREAD_QUERY
, w
, h
);
2483 if w
> FMaxKeyNameWdt
then FMaxKeyNameWdt
:= w
;
2485 FFont
.GetTextSize(KEYREAD_CLEAR
, w
, h
);
2486 if w
> FMaxKeyNameWdt
then FMaxKeyNameWdt
:= w
;
2489 procedure TGUIKeyRead2
.Draw
;
2490 procedure drawText (idx
: Integer);
2496 if idx
= 0 then kk
:= FKey0
else kk
:= FKey1
;
2498 if idx
= 0 then x
:= FX
+8 else x
:= FX
+8+FMaxKeyNameWdt
+16;
2502 if FKeyIdx
= idx
then begin r
:= 255; g
:= 255; b
:= 255; end;
2503 if FIsQuery
and (FKeyIdx
= idx
) then
2504 FFont
.Draw(x
, y
, KEYREAD_QUERY
, r
, g
, b
)
2506 FFont
.Draw(x
, y
, IfThen(kk
<> 0, e_KeyNames
[kk
], KEYREAD_CLEAR
), r
, g
, b
);
2512 //FFont.Draw(FX+8, FY, IfThen(FIsQuery and (FKeyIdx = 0), KEYREAD_QUERY, IfThen(FKey0 <> 0, e_KeyNames[FKey0], KEYREAD_CLEAR)), FColor.R, FColor.G, FColor.B);
2513 //FFont.Draw(FX+8+FMaxKeyNameWdt+16, FY, IfThen(FIsQuery and (FKeyIdx = 1), KEYREAD_QUERY, IfThen(FKey1 <> 0, e_KeyNames[FKey1], KEYREAD_CLEAR)), FColor.R, FColor.G, FColor.B);
2518 function TGUIKeyRead2
.GetWidth
: Integer;
2520 Result
:= FMaxKeyNameWdt
*2+8+8+16;
2523 function TGUIKeyRead2
.WantActivationKey (key
: LongInt): Boolean;
2526 (key
= IK_BACKSPACE
) or
2527 (key
= IK_LEFT
) or (key
= IK_RIGHT
) or
2528 (key
= IK_KPLEFT
) or (key
= IK_KPRIGHT
) or
2529 (key
= VK_LEFT
) or (key
= VK_RIGHT
) or
2533 procedure TGUIKeyRead2
.OnMessage(var Msg
: TMessage
);
2534 procedure actDefCtl ();
2537 if FDefControl
<> '' then
2538 SetActive(GetControl(FDefControl
))
2546 if not FEnabled
then
2553 IK_ESCAPE
, VK_ESCAPE
:
2555 if FIsQuery
then actDefCtl();
2558 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
:
2560 if not FIsQuery
then
2563 if FActiveControl
<> Self
then
2570 if (FKeyIdx
= 0) then FKey0
:= IK_ENTER
else FKey1
:= IK_ENTER
; // <Enter>
2575 IK_BACKSPACE
: // clear keybinding if we aren't waiting for a key
2577 if not FIsQuery
then
2579 if (FKeyIdx
= 0) then FKey0
:= 0 else FKey1
:= 0;
2583 IK_LEFT
, IK_KPLEFT
, VK_LEFT
:
2584 if not FIsQuery
then
2589 IK_RIGHT
, IK_KPRIGHT
, VK_RIGHT
:
2590 if not FIsQuery
then
2599 if not FIsQuery
and (wParam
= IK_BACKSPACE
) then
2601 if (FKeyIdx
= 0) then FKey0
:= 0 else FKey1
:= 0;
2604 else if FIsQuery
and (wParam
<> IK_ENTER
) and (wParam
<> IK_KPRETURN
) and (wParam
<> VK_FIRE
) and (wParam
<> VK_OPEN
) then // Not <Enter
2606 if e_KeyNames
[wParam
] <> '' then
2608 if (FKeyIdx
= 0) then FKey0
:= wParam
else FKey1
:= wParam
;
2620 constructor TGUIModelView
.Create
;
2627 destructor TGUIModelView
.Destroy
;
2634 procedure TGUIModelView
.Draw
;
2638 DrawBox(FX
, FY
, 4, 4);
2640 if FModel
<> nil then FModel
.Draw(FX
+4, FY
+4);
2643 procedure TGUIModelView
.NextAnim();
2645 if FModel
= nil then
2648 if FModel
.Animation
< A_PAIN
then
2649 FModel
.ChangeAnimation(FModel
.Animation
+1, True)
2651 FModel
.ChangeAnimation(A_STAND
, True);
2654 procedure TGUIModelView
.NextWeapon();
2656 if FModel
= nil then
2659 if FModel
.Weapon
< WP_LAST
then
2660 FModel
.SetWeapon(FModel
.Weapon
+1)
2662 FModel
.SetWeapon(WEAPON_KASTET
);
2665 procedure TGUIModelView
.OnMessage(var Msg
: TMessage
);
2671 procedure TGUIModelView
.SetColor(Red
, Green
, Blue
: Byte);
2673 if FModel
<> nil then FModel
.SetColor(Red
, Green
, Blue
);
2676 procedure TGUIModelView
.SetModel(ModelName
: string);
2680 FModel
:= g_PlayerModel_Get(ModelName
);
2683 procedure TGUIModelView
.Update
;
2690 if FModel
<> nil then FModel
.Update
;
2695 constructor TGUIMapPreview
.Create();
2701 destructor TGUIMapPreview
.Destroy();
2707 procedure TGUIMapPreview
.Draw();
2714 DrawBox(FX
, FY
, MAPPREVIEW_WIDTH
, MAPPREVIEW_HEIGHT
);
2716 if (FMapSize
.X
<= 0) or (FMapSize
.Y
<= 0) then
2719 e_DrawFillQuad(FX
+4, FY
+4,
2720 FX
+4 + Trunc(FMapSize
.X
/ FScale
) - 1,
2721 FY
+4 + Trunc(FMapSize
.Y
/ FScale
) - 1,
2724 if FMapData
<> nil then
2725 for a
:= 0 to High(FMapData
) do
2728 if X1
> MAPPREVIEW_WIDTH
*16 then Continue
;
2729 if Y1
> MAPPREVIEW_HEIGHT
*16 then Continue
;
2731 if X2
< 0 then Continue
;
2732 if Y2
< 0 then Continue
;
2734 if X2
> MAPPREVIEW_WIDTH
*16 then X2
:= MAPPREVIEW_WIDTH
*16;
2735 if Y2
> MAPPREVIEW_HEIGHT
*16 then Y2
:= MAPPREVIEW_HEIGHT
*16;
2737 if X1
< 0 then X1
:= 0;
2738 if Y1
< 0 then Y1
:= 0;
2779 if ((X2
-X1
) > 0) and ((Y2
-Y1
) > 0) then
2780 e_DrawFillQuad(FX
+4 + X1
, FY
+4 + Y1
,
2781 FX
+4 + X2
- 1, FY
+4 + Y2
- 1, r
, g
, b
, 0);
2785 procedure TGUIMapPreview
.OnMessage(var Msg
: TMessage
);
2791 procedure TGUIMapPreview
.SetMap(Res
: string);
2796 //header: TMapHeaderRec_1;
2801 map
: TDynRecord
= nil;
2808 FileName
:= g_ExtractWadName(Res
);
2810 WAD
:= TWADFile
.Create();
2811 if not WAD
.ReadFile(FileName
) then
2817 //k8: ignores path again
2818 if not WAD
.GetMapResource(g_ExtractFileName(Res
), Data
, Len
) then
2827 map
:= g_Map_ParseMap(Data
, Len
);
2837 if (map
= nil) then exit
;
2840 panlist
:= map
.field
['panel'];
2841 //header := GetMapHeader(map);
2843 FMapSize
.X
:= map
.Width
div 16;
2844 FMapSize
.Y
:= map
.Height
div 16;
2846 rX
:= Ceil(map
.Width
/ (MAPPREVIEW_WIDTH
*256.0));
2847 rY
:= Ceil(map
.Height
/ (MAPPREVIEW_HEIGHT
*256.0));
2848 FScale
:= max(rX
, rY
);
2852 if (panlist
<> nil) then
2854 for pan
in panlist
do
2856 if (pan
.PanelType
and (PANEL_WALL
or PANEL_CLOSEDOOR
or
2857 PANEL_STEP
or PANEL_WATER
or
2858 PANEL_ACID1
or PANEL_ACID2
)) <> 0 then
2860 SetLength(FMapData
, Length(FMapData
)+1);
2861 with FMapData
[High(FMapData
)] do
2866 X2
:= (pan
.X
+ pan
.Width
) div 16;
2867 Y2
:= (pan
.Y
+ pan
.Height
) div 16;
2869 X1
:= Trunc(X1
/FScale
+ 0.5);
2870 Y1
:= Trunc(Y1
/FScale
+ 0.5);
2871 X2
:= Trunc(X2
/FScale
+ 0.5);
2872 Y2
:= Trunc(Y2
/FScale
+ 0.5);
2874 if (X1
<> X2
) or (Y1
<> Y2
) then
2882 PanelType
:= pan
.PanelType
;
2888 //writeln('freeing map');
2893 procedure TGUIMapPreview
.ClearMap();
2895 SetLength(FMapData
, 0);
2902 procedure TGUIMapPreview
.Update();
2908 function TGUIMapPreview
.GetScaleStr(): String;
2910 if FScale
> 0.0 then
2912 Result
:= FloatToStrF(FScale
*16.0, ffFixed
, 3, 3);
2913 while (Result
[Length(Result
)] = '0') do
2914 Delete(Result
, Length(Result
), 1);
2915 if (Result
[Length(Result
)] = ',') or (Result
[Length(Result
)] = '.') then
2916 Delete(Result
, Length(Result
), 1);
2917 Result
:= '1 : ' + Result
;
2925 procedure TGUIListBox
.AddItem(Item
: string);
2927 SetLength(FItems
, Length(FItems
)+1);
2928 FItems
[High(FItems
)] := Item
;
2930 if FSort
then g_Basic
.Sort(FItems
);
2933 procedure TGUIListBox
.Clear();
2941 constructor TGUIListBox
.Create(FontID
: DWORD
; Width
, Height
: Word);
2945 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
2950 FOnChangeEvent
:= nil;
2952 FDrawScroll
:= True;
2955 procedure TGUIListBox
.Draw
;
2963 if FDrawBack
then DrawBox(FX
, FY
, FWidth
+1, FHeight
);
2965 DrawScroll(FX
+4+FWidth
*16, FY
+4, FHeight
, (FStartLine
> 0) and (FItems
<> nil),
2966 (FStartLine
+FHeight
-1 < High(FItems
)) and (FItems
<> nil));
2968 if FItems
<> nil then
2969 for a
:= FStartLine
to Min(High(FItems
), FStartLine
+FHeight
-1) do
2973 FFont
.GetTextSize(s
, w2
, h2
);
2974 while (Length(s
) > 0) and (w2
> FWidth
*16) do
2976 SetLength(s
, Length(s
)-1);
2977 FFont
.GetTextSize(s
, w2
, h2
);
2981 FFont
.Draw(FX
+4, FY
+4+(a
-FStartLine
)*16, s
, FActiveColor
.R
, FActiveColor
.G
, FActiveColor
.B
)
2983 FFont
.Draw(FX
+4, FY
+4+(a
-FStartLine
)*16, s
, FUnActiveColor
.R
, FUnActiveColor
.G
, FUnActiveColor
.B
);
2987 function TGUIListBox
.GetHeight
: Integer;
2989 Result
:= 8+FHeight
*16;
2992 function TGUIListBox
.GetWidth
: Integer;
2994 Result
:= 8+(FWidth
+1)*16;
2997 procedure TGUIListBox
.OnMessage(var Msg
: TMessage
);
3001 if not FEnabled
then Exit
;
3005 if FItems
= nil then Exit
;
3018 FIndex
:= High(FItems
);
3019 FStartLine
:= Max(High(FItems
)-FHeight
+1, 0);
3021 IK_UP
, IK_LEFT
, IK_KPUP
, IK_KPLEFT
, VK_LEFT
:
3025 if FIndex
< FStartLine
then Dec(FStartLine
);
3026 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
3028 IK_DOWN
, IK_RIGHT
, IK_KPDOWN
, IK_KPRIGHT
, VK_RIGHT
:
3029 if FIndex
< High(FItems
) then
3032 if FIndex
> FStartLine
+FHeight
-1 then Inc(FStartLine
);
3033 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
3035 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
:
3038 if FActiveControl
<> Self
then SetActive(Self
)
3040 if FDefControl
<> '' then SetActive(GetControl(FDefControl
))
3041 else SetActive(nil);
3045 for a
:= 0 to High(FItems
) do
3046 if (Length(FItems
[a
]) > 0) and (LowerCase(FItems
[a
][1]) = LowerCase(Chr(wParam
))) then
3049 FStartLine
:= Min(Max(FIndex
-1, 0), Length(FItems
)-FHeight
);
3050 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
3056 function TGUIListBox
.SelectedItem(): String;
3060 if (FIndex
< 0) or (FItems
= nil) or
3061 (FIndex
> High(FItems
)) then
3064 Result
:= FItems
[FIndex
];
3067 procedure TGUIListBox
.FSetItems(Items
: SSArray
);
3069 if FItems
<> nil then
3077 if FSort
then g_Basic
.Sort(FItems
);
3080 procedure TGUIListBox
.SelectItem(Item
: String);
3084 if FItems
= nil then
3088 Item
:= LowerCase(Item
);
3090 for a
:= 0 to High(FItems
) do
3091 if LowerCase(FItems
[a
]) = Item
then
3097 if FIndex
< FHeight
then
3100 FStartLine
:= Min(FIndex
, Length(FItems
)-FHeight
);
3103 procedure TGUIListBox
.FSetIndex(aIndex
: Integer);
3105 if FItems
= nil then
3108 if (aIndex
< 0) or (aIndex
> High(FItems
)) then
3113 if FIndex
<= FHeight
then
3116 FStartLine
:= Min(FIndex
, Length(FItems
)-FHeight
);
3121 procedure TGUIFileListBox
.OnMessage(var Msg
: TMessage
);
3125 if not FEnabled
then
3128 if FItems
= nil then
3139 if @FOnChangeEvent
<> nil then
3140 FOnChangeEvent(Self
);
3145 FIndex
:= High(FItems
);
3146 FStartLine
:= Max(High(FItems
)-FHeight
+1, 0);
3147 if @FOnChangeEvent
<> nil then
3148 FOnChangeEvent(Self
);
3151 IK_PAGEUP
, IK_KPPAGEUP
:
3153 if FIndex
> FHeight
then
3154 FIndex
:= FIndex
-FHeight
3158 if FStartLine
> FHeight
then
3159 FStartLine
:= FStartLine
-FHeight
3164 IK_PAGEDN
, IK_KPPAGEDN
:
3166 if FIndex
< High(FItems
)-FHeight
then
3167 FIndex
:= FIndex
+FHeight
3169 FIndex
:= High(FItems
);
3171 if FStartLine
< High(FItems
)-FHeight
then
3172 FStartLine
:= FStartLine
+FHeight
3174 FStartLine
:= High(FItems
)-FHeight
+1;
3177 IK_UP
, IK_LEFT
, IK_KPUP
, IK_KPLEFT
, VK_UP
, VK_LEFT
:
3181 if FIndex
< FStartLine
then
3183 if @FOnChangeEvent
<> nil then
3184 FOnChangeEvent(Self
);
3187 IK_DOWN
, IK_RIGHT
, IK_KPDOWN
, IK_KPRIGHT
, VK_DOWN
, VK_RIGHT
:
3188 if FIndex
< High(FItems
) then
3191 if FIndex
> FStartLine
+FHeight
-1 then
3193 if @FOnChangeEvent
<> nil then
3194 FOnChangeEvent(Self
);
3197 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
:
3200 if FActiveControl
<> Self
then
3204 if FItems
[FIndex
][1] = #29 then // Ïàïêà
3206 OpenDir(FPath
+Copy(FItems
[FIndex
], 2, 255));
3211 if FDefControl
<> '' then
3212 SetActive(GetControl(FDefControl
))
3220 for a
:= 0 to High(FItems
) do
3221 if ( (Length(FItems
[a
]) > 0) and
3222 (LowerCase(FItems
[a
][1]) = LowerCase(Chr(wParam
))) ) or
3223 ( (Length(FItems
[a
]) > 1) and
3224 (FItems
[a
][1] = #29) and // Ïàïêà
3225 (LowerCase(FItems
[a
][2]) = LowerCase(Chr(wParam
))) ) then
3228 FStartLine
:= Min(Max(FIndex
-1, 0), Length(FItems
)-FHeight
);
3229 if @FOnChangeEvent
<> nil then
3230 FOnChangeEvent(Self
);
3236 procedure TGUIFileListBox
.OpenDir(path
: String);
3244 path
:= IncludeTrailingPathDelimiter(path
);
3245 path
:= ExpandFileName(path
);
3250 if FindFirst(path
+'*', faDirectory
, SR
) = 0 then
3252 if not LongBool(SR
.Attr
and faDirectory
) then
3254 if (SR
.Name
= '.') or
3255 ((SR
.Name
= '..') and (path
= ExpandFileName(FBasePath
))) then
3258 AddItem(#1 + SR
.Name
);
3259 until FindNext(SR
) <> 0;
3269 if i
= 0 then i
:= length(sm
)+1;
3270 sc
:= Copy(sm
, 1, i
-1);
3272 if FindFirst(path
+sc
, faAnyFile
, SR
) = 0 then repeat AddItem(SR
.Name
); until FindNext(SR
) <> 0;
3276 for i
:= 0 to High(FItems
) do
3277 if FItems
[i
][1] = #1 then
3278 FItems
[i
][1] := #29;
3283 procedure TGUIFileListBox
.SetBase(path
: String);
3289 function TGUIFileListBox
.SelectedItem(): String;
3293 if (FIndex
= -1) or (FItems
= nil) or
3294 (FIndex
> High(FItems
)) or
3295 (FItems
[FIndex
][1] = '/') or
3296 (FItems
[FIndex
][1] = '\') then
3299 Result
:= FPath
+ FItems
[FIndex
];
3302 procedure TGUIFileListBox
.UpdateFileList();
3306 if (FIndex
= -1) or (FItems
= nil) or
3307 (FIndex
> High(FItems
)) or
3308 (FItems
[FIndex
][1] = '/') or
3309 (FItems
[FIndex
][1] = '\') then
3312 fn
:= FItems
[FIndex
];
3322 procedure TGUIMemo
.Clear
;
3328 constructor TGUIMemo
.Create(FontID
: DWORD
; Width
, Height
: Word);
3332 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
3337 FDrawScroll
:= True;
3340 procedure TGUIMemo
.Draw
;
3346 if FDrawBack
then DrawBox(FX
, FY
, FWidth
+1, FHeight
);
3348 DrawScroll(FX
+4+FWidth
*16, FY
+4, FHeight
, (FStartLine
> 0) and (FLines
<> nil),
3349 (FStartLine
+FHeight
-1 < High(FLines
)) and (FLines
<> nil));
3351 if FLines
<> nil then
3352 for a
:= FStartLine
to Min(High(FLines
), FStartLine
+FHeight
-1) do
3353 FFont
.Draw(FX
+4, FY
+4+(a
-FStartLine
)*16, FLines
[a
], FColor
.R
, FColor
.G
, FColor
.B
);
3356 function TGUIMemo
.GetHeight
: Integer;
3358 Result
:= 8+FHeight
*16;
3361 function TGUIMemo
.GetWidth
: Integer;
3363 Result
:= 8+(FWidth
+1)*16;
3366 procedure TGUIMemo
.OnMessage(var Msg
: TMessage
);
3368 if not FEnabled
then Exit
;
3372 if FLines
= nil then Exit
;
3378 IK_UP
, IK_LEFT
, IK_KPUP
, IK_KPLEFT
, VK_UP
, VK_LEFT
:
3379 if FStartLine
> 0 then
3381 IK_DOWN
, IK_RIGHT
, IK_KPDOWN
, IK_KPRIGHT
, VK_DOWN
, VK_RIGHT
:
3382 if FStartLine
< Length(FLines
)-FHeight
then
3384 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
:
3387 if FActiveControl
<> Self
then
3393 if FDefControl
<> '' then SetActive(GetControl(FDefControl
))
3394 else SetActive(nil);
3400 procedure TGUIMemo
.SetText(Text: string);
3403 FLines
:= GetLines(Text, FFont
.ID
, FWidth
*16);
3408 procedure TGUIimage
.ClearImage();
3410 if FImageRes
= '' then Exit
;
3412 g_Texture_Delete(FImageRes
);
3416 constructor TGUIimage
.Create();
3423 destructor TGUIimage
.Destroy();
3428 procedure TGUIimage
.Draw();
3434 if FImageRes
= '' then
3436 if g_Texture_Get(FDefaultRes
, ID
) then e_Draw(ID
, FX
, FY
, 0, True, False);
3439 if g_Texture_Get(FImageRes
, ID
) then e_Draw(ID
, FX
, FY
, 0, True, False);
3442 procedure TGUIimage
.OnMessage(var Msg
: TMessage
);
3447 procedure TGUIimage
.SetImage(Res
: string);
3451 if g_Texture_CreateWADEx(Res
, Res
) then FImageRes
:= Res
;
3454 procedure TGUIimage
.Update();