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, version 3 of the License ONLY.
7 * This program is distributed in the hope that it will be useful,
8 * but WITHOUT ANY WARRANTY; without even the implied warranty of
9 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10 * GNU General Public License for more details.
12 * You should have received a copy of the GNU General Public License
13 * along with this program. If not, see <http://www.gnu.org/licenses/>.
15 {$INCLUDE ../shared/a_modes.inc}
24 g_base
, g_playermodel
, MAPDEF
, utils
29 MAINMENU_ITEMS_COLOR
: TRGB
= (R
:255; G
:255; B
:255);
30 MAINMENU_UNACTIVEITEMS_COLOR
: TRGB
= (R
:192; G
:192; B
:192);
31 MAINMENU_HEADER_COLOR
: TRGB
= (R
:255; G
:255; B
:255);
33 MAINMENU_MARKERDELAY
= 24;
35 MENU_ITEMSTEXT_COLOR
: TRGB
= (R
:255; G
:255; B
:255);
36 MENU_UNACTIVEITEMS_COLOR
: TRGB
= (R
:128; G
:128; B
:128);
37 MENU_ITEMSCTRL_COLOR
: TRGB
= (R
:255; G
:0; B
:0);
40 MENU_MARKERDELAY
= 24;
43 MAPPREVIEW_HEIGHT
= 8;
45 KEYREAD_QUERY
= '<...>';
46 KEYREAD_CLEAR
= '???';
48 WINDOW_CLOSESOUND
= 'MENU_CLOSE';
49 MAINMENU_CLICKSOUND
= 'MENU_SELECT';
50 MAINMENU_CHANGESOUND
= 'MENU_CHANGE';
51 MENU_CLICKSOUND
= 'MENU_SELECT';
52 MENU_CHANGESOUND
= 'MENU_CHANGE';
53 SCROLL_ADDSOUND
= 'SCROLL_ADD';
54 SCROLL_SUBSOUND
= 'SCROLL_SUB';
60 MESSAGE_DIKEY
= WM_USER
+ 1;
72 TOnKeyDownEvent
= procedure(Key
: Byte);
73 TOnKeyDownEventEx
= procedure(win
: TGUIWindow
; Key
: Byte);
74 TOnCloseEvent
= procedure;
75 TOnShowEvent
= procedure;
76 TOnClickEvent
= procedure;
77 TOnChangeEvent
= procedure(Sender
: TGUIControl
);
78 TOnEnterEvent
= procedure(Sender
: TGUIControl
);
80 TGUIControl
= class{$IFDEF USE_MEMPOOL}(TPoolObject
){$ENDIF}
87 FRightAlign
: Boolean; //HACK! this works only for "normal" menus, only for menu text labels, and generally sux. sorry.
88 FMaxWidth
: Integer; //HACK! used for right-aligning labels
91 procedure OnMessage(var Msg
: TMessage
); virtual;
92 procedure Update
; virtual;
93 function GetWidth(): Integer; virtual;
94 function GetHeight(): Integer; virtual;
95 function WantActivationKey (key
: LongInt): Boolean; virtual;
96 property X
: Integer read FX write FX
;
97 property Y
: Integer read FY write FY
;
98 property Enabled
: Boolean read FEnabled write FEnabled
;
99 property Name
: string read FName write FName
;
100 property UserData
: Pointer read FUserData write FUserData
;
101 property RightAlign
: Boolean read FRightAlign write FRightAlign
; // for menu
102 property CMaxWidth
: Integer read FMaxWidth
;
104 property Window
: TGUIWindow read FWindow
;
107 TGUIWindow
= class{$IFDEF USE_MEMPOOL}(TPoolObject
){$ENDIF}
109 FActiveControl
: TGUIControl
;
111 FPrevWindow
: TGUIWindow
;
113 FBackTexture
: string;
114 FMainWindow
: Boolean;
115 FOnKeyDown
: TOnKeyDownEvent
;
116 FOnKeyDownEx
: TOnKeyDownEventEx
;
117 FOnCloseEvent
: TOnCloseEvent
;
118 FOnShowEvent
: TOnShowEvent
;
121 Childs
: array of TGUIControl
;
122 constructor Create(Name
: string);
123 destructor Destroy
; override;
124 function AddChild(Child
: TGUIControl
): TGUIControl
;
125 procedure OnMessage(var Msg
: TMessage
);
127 procedure SetActive(Control
: TGUIControl
);
128 function GetControl(Name
: string): TGUIControl
;
129 property OnKeyDown
: TOnKeyDownEvent read FOnKeyDown write FOnKeyDown
;
130 property OnKeyDownEx
: TOnKeyDownEventEx read FOnKeyDownEx write FOnKeyDownEx
;
131 property OnClose
: TOnCloseEvent read FOnCloseEvent write FOnCloseEvent
;
132 property OnShow
: TOnShowEvent read FOnShowEvent write FOnShowEvent
;
133 property Name
: string read FName
;
134 property DefControl
: string read FDefControl write FDefControl
;
135 property BackTexture
: string read FBackTexture write FBackTexture
;
136 property MainWindow
: Boolean read FMainWindow write FMainWindow
;
137 property UserData
: Pointer read FUserData write FUserData
;
139 property ActiveControl
: TGUIControl read FActiveControl
;
142 TGUITextButton
= class(TGUIControl
)
151 ProcEx
: procedure (sender
: TGUITextButton
);
152 constructor Create(aProc
: Pointer; BigFont
: Boolean; Text: string);
153 destructor Destroy(); override;
154 procedure OnMessage(var Msg
: TMessage
); override;
155 procedure Update(); override;
156 procedure Click(Silent
: Boolean = False);
157 property Caption
: string read FText write FText
;
158 property Color
: TRGB read FColor write FColor
;
159 property BigFont
: Boolean read FBigFont write FBigFont
;
160 property ShowWindow
: string read FShowWindow write FShowWindow
;
163 TGUILabel
= class(TGUIControl
)
169 FOnClickEvent
: TOnClickEvent
;
171 constructor Create(Text: string; BigFont
: Boolean);
172 procedure OnMessage(var Msg
: TMessage
); override;
173 property OnClick
: TOnClickEvent read FOnClickEvent write FOnClickEvent
;
174 property FixedLength
: Word read FFixedLen write FFixedLen
;
175 property Text: string read FText write FText
;
176 property Color
: TRGB read FColor write FColor
;
177 property BigFont
: Boolean read FBigFont write FBigFont
;
180 TGUIScroll
= class(TGUIControl
)
184 FOnChangeEvent
: TOnChangeEvent
;
185 procedure FSetValue(a
: Integer);
187 constructor Create();
188 procedure OnMessage(var Msg
: TMessage
); override;
189 procedure Update
; override;
190 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
191 property Max
: Word read FMax write FMax
;
192 property Value
: Integer read FValue write FSetValue
;
195 TGUIItemsList
= array of string;
197 TGUISwitch
= class(TGUIControl
)
200 FItems
: TGUIItemsList
;
203 FOnChangeEvent
: TOnChangeEvent
;
205 constructor Create(BigFont
: Boolean);
206 procedure OnMessage(var Msg
: TMessage
); override;
207 procedure AddItem(Item
: string);
208 procedure Update
; override;
209 function GetText
: string;
210 property ItemIndex
: Integer read FIndex write FIndex
;
211 property Color
: TRGB read FColor write FColor
;
212 property BigFont
: Boolean read FBigFont write FBigFont
;
213 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
214 property Items
: TGUIItemsList read FItems
;
217 TGUIEdit
= class(TGUIControl
)
225 FOnlyDigits
: Boolean;
226 FOnChangeEvent
: TOnChangeEvent
;
227 FOnEnterEvent
: TOnEnterEvent
;
229 procedure SetText(Text: string);
231 constructor Create(BigFont
: Boolean);
232 procedure OnMessage(var Msg
: TMessage
); override;
233 procedure Update
; override;
234 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
235 property OnEnter
: TOnEnterEvent read FOnEnterEvent write FOnEnterEvent
;
236 property Width
: Word read FWidth write FWidth
;
237 property MaxLength
: Word read FMaxLength write FMaxLength
;
238 property OnlyDigits
: Boolean read FOnlyDigits write FOnlyDigits
;
239 property Text: string read FText write SetText
;
240 property Color
: TRGB read FColor write FColor
;
241 property BigFont
: Boolean read FBigFont write FBigFont
;
242 property Invalid
: Boolean read FInvalid write FInvalid
;
244 property CaretPos
: Integer read FCaretPos
;
247 TGUIKeyRead
= class(TGUIControl
)
254 constructor Create(BigFont
: Boolean);
255 procedure OnMessage(var Msg
: TMessage
); override;
256 function WantActivationKey (key
: LongInt): Boolean; override;
257 property Key
: Word read FKey write FKey
;
258 property Color
: TRGB read FColor write FColor
;
259 property BigFont
: Boolean read FBigFont write FBigFont
;
261 property IsQuery
: Boolean read FIsQuery
;
265 TGUIKeyRead2
= class(TGUIControl
)
269 FKey0
, FKey1
: Word; // this should be an array. sorry.
272 FMaxKeyNameWdt
: Integer;
274 constructor Create(BigFont
: Boolean);
275 procedure OnMessage(var Msg
: TMessage
); override;
276 function WantActivationKey (key
: LongInt): Boolean; override;
277 property Key0
: Word read FKey0 write FKey0
;
278 property Key1
: Word read FKey1 write FKey1
;
279 property Color
: TRGB read FColor write FColor
;
280 property BigFont
: Boolean read FBigFont write FBigFont
;
282 property IsQuery
: Boolean read FIsQuery
;
283 property MaxKeyNameWdt
: Integer read FMaxKeyNameWdt
;
284 property KeyIdx
: Integer read FKeyIdx
;
287 TGUIModelView
= class(TGUIControl
)
289 FModel
: TPlayerModel
;
293 destructor Destroy
; override;
294 procedure OnMessage(var Msg
: TMessage
); override;
295 procedure SetModel(ModelName
: string);
296 procedure SetColor(Red
, Green
, Blue
: Byte);
297 procedure NextAnim();
298 procedure NextWeapon();
299 procedure Update
; override;
300 property Model
: TPlayerModel read FModel
;
303 TPreviewPanel
= record
304 X1
, Y1
, X2
, Y2
: Integer;
308 TPreviewPanelArray
= array of TPreviewPanel
;
310 TGUIMapPreview
= class(TGUIControl
)
312 FMapData
: TPreviewPanelArray
;
316 constructor Create();
317 destructor Destroy(); override;
318 procedure OnMessage(var Msg
: TMessage
); override;
319 procedure SetMap(Res
: string);
320 procedure ClearMap();
321 procedure Update(); override;
322 function GetScaleStr
: String;
324 property MapData
: TPreviewPanelArray read FMapData
;
325 property MapSize
: TDFPoint read FMapSize
;
326 property Scale
: Single read FScale
;
329 TGUIImage
= class(TGUIControl
)
334 constructor Create();
335 destructor Destroy(); override;
336 procedure OnMessage(var Msg
: TMessage
); override;
337 procedure SetImage(Res
: string);
338 procedure ClearImage();
339 procedure Update(); override;
341 property DefaultRes
: string read FDefaultRes write FDefaultRes
;
342 property ImageRes
: string read FImageRes
;
345 TGUIListBox
= class(TGUIControl
)
349 FUnActiveColor
: TRGB
;
357 FDrawScroll
: Boolean;
358 FOnChangeEvent
: TOnChangeEvent
;
360 procedure FSetItems(Items
: SSArray
);
361 procedure FSetIndex(aIndex
: Integer);
364 constructor Create(BigFont
: Boolean; Width
, Height
: Word);
365 procedure OnMessage(var Msg
: TMessage
); override;
366 procedure AddItem(Item
: String);
367 function ItemExists (item
: String): Boolean;
368 procedure SelectItem(Item
: String);
370 function SelectedItem(): String;
372 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
373 property Sort
: Boolean read FSort write FSort
;
374 property ItemIndex
: Integer read FIndex write FSetIndex
;
375 property Items
: SSArray read FItems write FSetItems
;
376 property DrawBack
: Boolean read FDrawBack write FDrawBack
;
377 property DrawScrollBar
: Boolean read FDrawScroll write FDrawScroll
;
378 property ActiveColor
: TRGB read FActiveColor write FActiveColor
;
379 property UnActiveColor
: TRGB read FUnActiveColor write FUnActiveColor
;
380 property BigFont
: Boolean read FBigFont write FBigFont
;
382 property Width
: Word read FWidth
;
383 property Height
: Word read FHeight
;
384 property StartLine
: Integer read FStartLine
;
387 TGUIFileListBox
= class(TGUIListBox
)
392 FBaseList
: SSArray
; // highter index have highter priority
397 procedure OnMessage (var Msg
: TMessage
); override;
398 procedure SetBase (dirs
: SSArray
; path
: String = '');
399 function SelectedItem(): String;
400 procedure UpdateFileList
;
402 property Dirs
: Boolean read FDirs write FDirs
;
403 property FileMask
: String read FFileMask write FFileMask
;
406 TGUIMemo
= class(TGUIControl
)
415 FDrawScroll
: Boolean;
417 constructor Create(BigFont
: Boolean; Width
, Height
: Word);
418 procedure OnMessage(var Msg
: TMessage
); override;
420 procedure SetText(Text: string);
421 property DrawBack
: Boolean read FDrawBack write FDrawBack
;
422 property DrawScrollBar
: Boolean read FDrawScroll write FDrawScroll
;
423 property Color
: TRGB read FColor write FColor
;
424 property BigFont
: Boolean read FBigFont write FBigFont
;
426 property Width
: Word read FWidth
;
427 property Height
: Word read FHeight
;
428 property StartLine
: Integer read FStartLine
;
429 property Lines
: SSArray read FLines
;
432 TGUITextButtonList
= array of TGUITextButton
;
434 TGUIMainMenu
= class(TGUIControl
)
436 FButtons
: TGUITextButtonList
;
440 FCounter
: Byte; // !!! update it within render
442 constructor Create(BigFont
: Boolean; Header
: string);
443 destructor Destroy
; override;
444 procedure OnMessage(var Msg
: TMessage
); override;
445 function AddButton(fProc
: Pointer; Caption
: string; ShowWindow
: string = ''): TGUITextButton
;
446 function GetButton(aName
: string): TGUITextButton
;
447 procedure EnableButton(aName
: string; e
: Boolean);
448 procedure AddSpace();
449 procedure Update
; override;
451 property Header
: TGUILabel read FHeader
;
452 property Buttons
: TGUITextButtonList read FButtons
;
453 property Index
: Integer read FIndex
;
454 property Counter
: Byte read FCounter
;
457 TControlType
= class of TGUIControl
;
459 PMenuItem
= ^TMenuItem
;
462 ControlType
: TControlType
;
463 Control
: TGUIControl
;
465 TMenuItemList
= array of TMenuItem
;
467 TGUIMenu
= class(TGUIControl
)
469 FItems
: TMenuItemList
;
477 function NewItem(): Integer;
479 constructor Create(HeaderBigFont
, ItemsBigFont
: Boolean; Header
: string);
480 destructor Destroy
; override;
481 procedure OnMessage(var Msg
: TMessage
); override;
482 procedure AddSpace();
483 procedure AddLine(fText
: string);
484 procedure AddText(fText
: string; MaxWidth
: Word);
485 function AddLabel(fText
: string): TGUILabel
;
486 function AddButton(Proc
: Pointer; fText
: string; _ShowWindow
: string = ''): TGUITextButton
;
487 function AddScroll(fText
: string): TGUIScroll
;
488 function AddSwitch(fText
: string): TGUISwitch
;
489 function AddEdit(fText
: string): TGUIEdit
;
490 function AddKeyRead(fText
: string): TGUIKeyRead
;
491 function AddKeyRead2(fText
: string): TGUIKeyRead2
;
492 function AddList(fText
: string; Width
, Height
: Word): TGUIListBox
;
493 function AddFileList(fText
: string; Width
, Height
: Word): TGUIFileListBox
;
494 function AddMemo(fText
: string; Width
, Height
: Word): TGUIMemo
;
496 function GetControl(aName
: string): TGUIControl
;
497 function GetControlsText(aName
: string): TGUILabel
;
498 procedure Update
; override;
499 procedure UpdateIndex();
500 property Align
: Boolean read FAlign write FAlign
;
501 property Left
: Integer read FLeft write FLeft
;
502 property YesNo
: Boolean read FYesNo write FYesNo
;
504 property Header
: TGUILabel read FHeader
;
505 property Counter
: Byte read FCounter
;
506 property Index
: Integer read FIndex
;
507 property Items
: TMenuItemList read FItems
;
508 property BigFont
: Boolean read FBigFont
;
512 g_GUIWindows
: array of TGUIWindow
;
513 g_ActiveWindow
: TGUIWindow
= nil;
514 g_GUIGrabInput
: Boolean = False;
516 function g_GUI_AddWindow(Window
: TGUIWindow
): TGUIWindow
;
517 function g_GUI_GetWindow(Name
: string): TGUIWindow
;
518 procedure g_GUI_ShowWindow(Name
: string);
519 procedure g_GUI_HideWindow(PlaySound
: Boolean = True);
520 function g_GUI_Destroy(): Boolean;
521 procedure g_GUI_SaveMenuPos();
522 procedure g_GUI_LoadMenuPos();
528 {$IFDEF ENABLE_TOUCH}
531 {$IFDEF ENABLE_RENDER}
535 g_sound
, SysUtils
, e_res
,
536 g_game
, Math
, StrUtils
, g_player
, g_options
,
537 g_map
, g_weapons
, xdynrec
, wadreader
;
541 Saved_Windows
: SSArray
;
543 function GetLines (Text: string; BigFont
: Boolean; MaxWidth
: Word): SSArray
;
544 var i
, j
, len
, lines
: Integer;
546 function GetLine (j
, i
: Integer): String;
548 result
:= Copy(text, j
, i
- j
+ 1);
551 function GetWidth (j
, i
: Integer): Integer;
552 {$IFDEF ENABLE_RENDER}
556 {$IFDEF ENABLE_RENDER}
557 r_Render_GetStringSize(BigFont
, GetLine(j
, i
), w
, h
);
565 result
:= nil; lines
:= 0;
566 j
:= 1; i
:= 1; len
:= Length(Text);
567 // e_LogWritefln('GetLines @%s len=%s [%s]', [MaxWidth, len, Text]);
570 (* --- Get longest possible sequence --- *)
571 while (i
+ 1 <= len
) and (GetWidth(j
, i
+ 1) <= MaxWidth
) do Inc(i
);
572 (* --- Do not include part of word --- *)
573 if (i
< len
) and (text[i
] <> ' ') then
574 while (i
>= j
) and (text[i
] <> ' ') do Dec(i
);
575 (* --- Do not include spaces --- *)
576 while (i
>= j
) and (text[i
] = ' ') do Dec(i
);
577 (* --- Add line --- *)
578 SetLength(result
, lines
+ 1);
579 result
[lines
] := GetLine(j
, i
);
580 // e_LogWritefln(' -> (%s:%s::%s) [%s]', [j, i, GetWidth(j, i), result[lines]]);
582 (* --- Skip spaces --- *)
583 while (i
<= len
) and (text[i
] = ' ') do Inc(i
);
588 procedure Sort (var a
: SSArray
);
589 var i
, j
: Integer; s
: string;
591 if a
= nil then Exit
;
593 for i
:= High(a
) downto Low(a
) do
594 for j
:= Low(a
) to High(a
) - 1 do
595 if LowerCase(a
[j
]) > LowerCase(a
[j
+ 1]) then
603 function g_GUI_Destroy(): Boolean;
607 Result
:= (Length(g_GUIWindows
) > 0);
609 for i
:= 0 to High(g_GUIWindows
) do
610 g_GUIWindows
[i
].Free();
613 g_ActiveWindow
:= nil;
616 function g_GUI_AddWindow(Window
: TGUIWindow
): TGUIWindow
;
618 SetLength(g_GUIWindows
, Length(g_GUIWindows
)+1);
619 g_GUIWindows
[High(g_GUIWindows
)] := Window
;
624 function g_GUI_GetWindow(Name
: string): TGUIWindow
;
630 if g_GUIWindows
<> nil then
631 for i
:= 0 to High(g_GUIWindows
) do
632 if g_GUIWindows
[i
].FName
= Name
then
634 Result
:= g_GUIWindows
[i
];
638 Assert(Result
<> nil, 'GUI_Window "'+Name
+'" not found');
641 procedure g_GUI_ShowWindow(Name
: string);
645 if g_GUIWindows
= nil then
648 for i
:= 0 to High(g_GUIWindows
) do
649 if g_GUIWindows
[i
].FName
= Name
then
651 g_GUIWindows
[i
].FPrevWindow
:= g_ActiveWindow
;
652 g_ActiveWindow
:= g_GUIWindows
[i
];
654 if g_ActiveWindow
.MainWindow
then
655 g_ActiveWindow
.FPrevWindow
:= nil;
657 if g_ActiveWindow
.FDefControl
<> '' then
658 g_ActiveWindow
.SetActive(g_ActiveWindow
.GetControl(g_ActiveWindow
.FDefControl
))
660 g_ActiveWindow
.SetActive(nil);
662 if @g_ActiveWindow
.FOnShowEvent
<> nil then
663 g_ActiveWindow
.FOnShowEvent();
669 procedure g_GUI_HideWindow(PlaySound
: Boolean = True);
671 if g_ActiveWindow
<> nil then
673 if @g_ActiveWindow
.OnClose
<> nil then
674 g_ActiveWindow
.OnClose();
675 g_ActiveWindow
:= g_ActiveWindow
.FPrevWindow
;
677 g_Sound_PlayEx(WINDOW_CLOSESOUND
);
681 procedure g_GUI_SaveMenuPos();
686 SetLength(Saved_Windows
, 0);
687 win
:= g_ActiveWindow
;
691 len
:= Length(Saved_Windows
);
692 SetLength(Saved_Windows
, len
+ 1);
694 Saved_Windows
[len
] := win
.Name
;
696 if win
.MainWindow
then
699 win
:= win
.FPrevWindow
;
703 procedure g_GUI_LoadMenuPos();
705 i
, j
, k
, len
: Integer;
708 g_ActiveWindow
:= nil;
709 len
:= Length(Saved_Windows
);
714 // Îêíî ñ ãëàâíûì ìåíþ:
715 g_GUI_ShowWindow(Saved_Windows
[len
-1]);
717 // Íå ïåðåêëþ÷èëîñü (èëè íåêóäà äàëüøå):
718 if (len
= 1) or (g_ActiveWindow
= nil) then
721 // Èùåì êíîïêè â îñòàëüíûõ îêíàõ:
722 for k
:= len
-1 downto 1 do
726 for i
:= 0 to Length(g_ActiveWindow
.Childs
)-1 do
728 if g_ActiveWindow
.Childs
[i
] is TGUIMainMenu
then
729 begin // GUI_MainMenu
730 with TGUIMainMenu(g_ActiveWindow
.Childs
[i
]) do
731 for j
:= 0 to Length(FButtons
)-1 do
732 if FButtons
[j
].ShowWindow
= Saved_Windows
[k
-1] then
734 FButtons
[j
].Click(True);
740 if g_ActiveWindow
.Childs
[i
] is TGUIMenu
then
741 with TGUIMenu(g_ActiveWindow
.Childs
[i
]) do
742 for j
:= 0 to Length(FItems
)-1 do
743 if FItems
[j
].ControlType
= TGUITextButton
then
744 if TGUITextButton(FItems
[j
].Control
).ShowWindow
= Saved_Windows
[k
-1] then
746 TGUITextButton(FItems
[j
].Control
).Click(True);
757 (g_ActiveWindow
.Name
= Saved_Windows
[k
]) then
764 constructor TGUIWindow
.Create(Name
: string);
767 FActiveControl
:= nil;
771 FOnCloseEvent
:= nil;
775 destructor TGUIWindow
.Destroy
;
782 for i
:= 0 to High(Childs
) do
786 function TGUIWindow
.AddChild(Child
: TGUIControl
): TGUIControl
;
788 Child
.FWindow
:= Self
;
790 SetLength(Childs
, Length(Childs
) + 1);
791 Childs
[High(Childs
)] := Child
;
796 procedure TGUIWindow
.Update
;
800 for i
:= 0 to High(Childs
) do
801 if Childs
[i
] <> nil then Childs
[i
].Update
;
804 procedure TGUIWindow
.OnMessage(var Msg
: TMessage
);
806 if FActiveControl
<> nil then FActiveControl
.OnMessage(Msg
);
807 if @FOnKeyDown
<> nil then FOnKeyDown(Msg
.wParam
);
808 if @FOnKeyDownEx
<> nil then FOnKeyDownEx(self
, Msg
.wParam
);
810 if Msg
.Msg
= WM_KEYDOWN
then
822 procedure TGUIWindow
.SetActive(Control
: TGUIControl
);
824 FActiveControl
:= Control
;
827 function TGUIWindow
.GetControl(Name
: String): TGUIControl
;
833 if Childs
<> nil then
834 for i
:= 0 to High(Childs
) do
835 if Childs
[i
] <> nil then
836 if LowerCase(Childs
[i
].FName
) = LowerCase(Name
) then
842 Assert(Result
<> nil, 'Window Control "'+Name
+'" not Found!');
847 constructor TGUIControl
.Create();
853 FRightAlign
:= false;
857 procedure TGUIControl
.OnMessage(var Msg
: TMessage
);
863 procedure TGUIControl
.Update();
867 function TGUIControl
.WantActivationKey (key
: LongInt): Boolean;
872 function TGUIControl
.GetWidth (): Integer;
873 {$IFDEF ENABLE_RENDER}
877 {$IFDEF ENABLE_RENDER}
878 r_Render_GetControlSize(Self
, Result
, h
);
884 function TGUIControl
.GetHeight (): Integer;
885 {$IFDEF ENABLE_RENDER}
889 {$IFDEF ENABLE_RENDER}
890 r_Render_GetControlSize(Self
, w
, Result
);
898 procedure TGUITextButton
.Click(Silent
: Boolean = False);
900 if (FSound
<> '') and (not Silent
) then g_Sound_PlayEx(FSound
);
902 if @Proc
<> nil then Proc();
903 if @ProcEx
<> nil then ProcEx(self
);
905 if FShowWindow
<> '' then g_GUI_ShowWindow(FShowWindow
);
908 constructor TGUITextButton
.Create(aProc
: Pointer; BigFont
: Boolean; Text: string);
919 destructor TGUITextButton
.Destroy
;
925 procedure TGUITextButton
.OnMessage(var Msg
: TMessage
);
927 if not FEnabled
then Exit
;
934 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
: Click();
939 procedure TGUITextButton
.Update
;
946 function TGUIMainMenu
.AddButton(fProc
: Pointer; Caption
: string; ShowWindow
: string = ''): TGUITextButton
;
948 {$IFDEF ENABLE_RENDER}
957 SetLength(FButtons
, Length(FButtons
)+1);
958 FButtons
[High(FButtons
)] := TGUITextButton
.Create(fProc
, FBigFont
, Caption
);
959 FButtons
[High(FButtons
)].ShowWindow
:= ShowWindow
;
960 with FButtons
[High(FButtons
)] do
962 if (fProc
<> nil) or (ShowWindow
<> '') then FColor
:= MAINMENU_ITEMS_COLOR
963 else FColor
:= MAINMENU_UNACTIVEITEMS_COLOR
;
964 FSound
:= MAINMENU_CLICKSOUND
;
967 _x
:= gScreenWidth
div 2;
969 for a
:= 0 to High(FButtons
) do
970 if FButtons
[a
] <> nil then
971 _x
:= Min(_x
, (gScreenWidth
div 2)-(FButtons
[a
].GetWidth
div 2));
975 {$IFDEF ENABLE_RENDER}
976 if FHeader
= nil then
977 r_Render_GetLogoSize(lw
, lh
);
979 hh
:= FButtons
[High(FButtons
)].GetHeight
;
981 if FHeader
= nil then h
:= lh
+ hh
* (1 + Length(FButtons
)) + MAINMENU_SPACE
* (Length(FButtons
) - 1)
982 else h
:= hh
* (2 + Length(FButtons
)) + MAINMENU_SPACE
* (Length(FButtons
) - 1);
983 h
:= (gScreenHeight
div 2) - (h
div 2);
985 if FHeader
<> nil then with FHeader
do
991 if FHeader
= nil then Inc(h
, lh
)
994 for a
:= 0 to High(FButtons
) do
996 if FButtons
[a
] <> nil then
1003 Inc(h
, hh
+MAINMENU_SPACE
);
1006 Result
:= FButtons
[High(FButtons
)];
1009 procedure TGUIMainMenu
.AddSpace
;
1011 SetLength(FButtons
, Length(FButtons
)+1);
1012 FButtons
[High(FButtons
)] := nil;
1015 constructor TGUIMainMenu
.Create(BigFont
: Boolean; Header
: string);
1020 FBigFont
:= BigFont
;
1021 FCounter
:= MAINMENU_MARKERDELAY
;
1023 if Header
<> '' then
1025 FHeader
:= TGUILabel
.Create(Header
, BigFont
);
1028 FColor
:= MAINMENU_HEADER_COLOR
;
1029 FX
:= (gScreenWidth
div 2)-(GetWidth
div 2);
1030 FY
:= (gScreenHeight
div 2)-(GetHeight
div 2);
1035 destructor TGUIMainMenu
.Destroy
;
1039 if FButtons
<> nil then
1040 for a
:= 0 to High(FButtons
) do
1048 procedure TGUIMainMenu
.EnableButton(aName
: string; e
: Boolean);
1052 if FButtons
= nil then Exit
;
1054 for a
:= 0 to High(FButtons
) do
1055 if (FButtons
[a
] <> nil) and (FButtons
[a
].Name
= aName
) then
1057 if e
then FButtons
[a
].FColor
:= MAINMENU_ITEMS_COLOR
1058 else FButtons
[a
].FColor
:= MAINMENU_UNACTIVEITEMS_COLOR
;
1059 FButtons
[a
].Enabled
:= e
;
1064 function TGUIMainMenu
.GetButton(aName
: string): TGUITextButton
;
1070 if FButtons
= nil then Exit
;
1072 for a
:= 0 to High(FButtons
) do
1073 if (FButtons
[a
] <> nil) and (FButtons
[a
].Name
= aName
) then
1075 Result
:= FButtons
[a
];
1080 procedure TGUIMainMenu
.OnMessage(var Msg
: TMessage
);
1085 if not FEnabled
then Exit
;
1089 if FButtons
= nil then Exit
;
1092 for a
:= 0 to High(FButtons
) do
1093 if FButtons
[a
] <> nil then
1099 if not ok
then Exit
;
1104 IK_UP
, IK_KPUP
, VK_UP
, JOY0_UP
, JOY1_UP
, JOY2_UP
, JOY3_UP
:
1108 if FIndex
< 0 then FIndex
:= High(FButtons
);
1109 until FButtons
[FIndex
] <> nil;
1111 g_Sound_PlayEx(MENU_CHANGESOUND
);
1113 IK_DOWN
, IK_KPDOWN
, VK_DOWN
, JOY0_DOWN
, JOY1_DOWN
, JOY2_DOWN
, JOY3_DOWN
:
1117 if FIndex
> High(FButtons
) then FIndex
:= 0;
1118 until FButtons
[FIndex
] <> nil;
1120 g_Sound_PlayEx(MENU_CHANGESOUND
);
1122 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
: if (FIndex
<> -1) and FButtons
[FIndex
].FEnabled
then FButtons
[FIndex
].Click
;
1127 procedure TGUIMainMenu
.Update
;
1130 FCounter
:= (FCounter
+ 1) MOD (2 * MAINMENU_MARKERDELAY
)
1135 constructor TGUILabel
.Create(Text: string; BigFont
: Boolean);
1139 FBigFont
:= BigFont
;
1142 FOnClickEvent
:= nil;
1145 procedure TGUILabel
.OnMessage(var Msg
: TMessage
);
1147 if not FEnabled
then Exit
;
1154 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
: if @FOnClickEvent
<> nil then FOnClickEvent();
1161 function TGUIMenu
.AddButton(Proc
: Pointer; fText
: string; _ShowWindow
: string = ''): TGUITextButton
;
1168 Control
:= TGUITextButton
.Create(Proc
, FBigFont
, fText
);
1169 with Control
as TGUITextButton
do
1171 ShowWindow
:= _ShowWindow
;
1172 FColor
:= MENU_ITEMSCTRL_COLOR
;
1176 ControlType
:= TGUITextButton
;
1178 Result
:= (Control
as TGUITextButton
);
1181 if FIndex
= -1 then FIndex
:= i
;
1186 procedure TGUIMenu
.AddLine(fText
: string);
1193 Text := TGUILabel
.Create(fText
, FBigFont
);
1196 FColor
:= MENU_ITEMSTEXT_COLOR
;
1205 procedure TGUIMenu
.AddText(fText
: string; MaxWidth
: Word);
1210 l
:= GetLines(fText
, FBigFont
, MaxWidth
);
1212 if l
= nil then Exit
;
1214 for a
:= 0 to High(l
) do
1219 Text := TGUILabel
.Create(l
[a
], FBigFont
);
1222 with Text do begin FColor
:= _RGB(255, 0, 0); end;
1226 with Text do begin FColor
:= MENU_ITEMSTEXT_COLOR
; end;
1236 procedure TGUIMenu
.AddSpace
;
1250 constructor TGUIMenu
.Create(HeaderBigFont
, ItemsBigFont
: Boolean; Header
: string);
1256 FBigFont
:= ItemsBigFont
;
1257 FCounter
:= MENU_MARKERDELAY
;
1261 FHeader
:= TGUILabel
.Create(Header
, HeaderBigFont
);
1264 FX
:= (gScreenWidth
div 2)-(GetWidth
div 2);
1266 FColor
:= MAINMENU_HEADER_COLOR
;
1270 destructor TGUIMenu
.Destroy
;
1274 if FItems
<> nil then
1275 for a
:= 0 to High(FItems
) do
1289 function TGUIMenu
.GetControl(aName
: String): TGUIControl
;
1295 if FItems
<> nil then
1296 for a
:= 0 to High(FItems
) do
1297 if FItems
[a
].Control
<> nil then
1298 if LowerCase(FItems
[a
].Control
.Name
) = LowerCase(aName
) then
1300 Result
:= FItems
[a
].Control
;
1304 Assert(Result
<> nil, 'GUI control "'+aName
+'" not found!');
1307 function TGUIMenu
.GetControlsText(aName
: String): TGUILabel
;
1313 if FItems
<> nil then
1314 for a
:= 0 to High(FItems
) do
1315 if FItems
[a
].Control
<> nil then
1316 if LowerCase(FItems
[a
].Control
.Name
) = LowerCase(aName
) then
1318 Result
:= FItems
[a
].Text;
1322 Assert(Result
<> nil, 'GUI control''s text "'+aName
+'" not found!');
1325 function TGUIMenu
.NewItem
: Integer;
1327 SetLength(FItems
, Length(FItems
)+1);
1328 Result
:= High(FItems
);
1331 procedure TGUIMenu
.OnMessage(var Msg
: TMessage
);
1336 if not FEnabled
then Exit
;
1340 if FItems
= nil then Exit
;
1343 for a
:= 0 to High(FItems
) do
1344 if FItems
[a
].Control
<> nil then
1350 if not ok
then Exit
;
1352 if (Msg
.Msg
= WM_KEYDOWN
) and (FIndex
<> -1) and (FItems
[FIndex
].Control
<> nil) and
1353 (FItems
[FIndex
].Control
.WantActivationKey(Msg
.wParam
)) then
1355 FItems
[FIndex
].Control
.OnMessage(Msg
);
1356 g_Sound_PlayEx(MENU_CLICKSOUND
);
1364 IK_UP
, IK_KPUP
, VK_UP
,JOY0_UP
, JOY1_UP
, JOY2_UP
, JOY3_UP
:
1369 if c
> Length(FItems
) then
1376 if FIndex
< 0 then FIndex
:= High(FItems
);
1377 until (FItems
[FIndex
].Control
<> nil) and
1378 (FItems
[FIndex
].Control
.Enabled
);
1382 g_Sound_PlayEx(MENU_CHANGESOUND
);
1385 IK_DOWN
, IK_KPDOWN
, VK_DOWN
, JOY0_DOWN
, JOY1_DOWN
, JOY2_DOWN
, JOY3_DOWN
:
1390 if c
> Length(FItems
) then
1397 if FIndex
> High(FItems
) then FIndex
:= 0;
1398 until (FItems
[FIndex
].Control
<> nil) and
1399 (FItems
[FIndex
].Control
.Enabled
);
1403 g_Sound_PlayEx(MENU_CHANGESOUND
);
1406 IK_LEFT
, IK_RIGHT
, IK_KPLEFT
, IK_KPRIGHT
, VK_LEFT
, VK_RIGHT
,
1407 JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
,
1408 JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
1410 if FIndex
<> -1 then
1411 if FItems
[FIndex
].Control
<> nil then
1412 FItems
[FIndex
].Control
.OnMessage(Msg
);
1414 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
1416 if FIndex
<> -1 then
1418 if FItems
[FIndex
].Control
<> nil then FItems
[FIndex
].Control
.OnMessage(Msg
);
1420 g_Sound_PlayEx(MENU_CLICKSOUND
);
1424 if FYesNo
and (length(FItems
) > 1) then
1426 Msg
.wParam
:= IK_RETURN
; // to register keypress
1427 FIndex
:= High(FItems
)-1;
1428 if FItems
[FIndex
].Control
<> nil then FItems
[FIndex
].Control
.OnMessage(Msg
);
1431 if FYesNo
and (length(FItems
) > 1) then
1433 Msg
.wParam
:= IK_RETURN
; // to register keypress
1434 FIndex
:= High(FItems
);
1435 if FItems
[FIndex
].Control
<> nil then FItems
[FIndex
].Control
.OnMessage(Msg
);
1442 procedure TGUIMenu
.ReAlign();
1444 {$IFDEF ENABLE_RENDER}
1447 a
, tx
, cx
, w
, h
: Integer;
1448 cww
: array of Integer; // cached widths
1451 if FItems
= nil then Exit
;
1453 SetLength(cww
, length(FItems
));
1455 for a
:= 0 to High(FItems
) do
1457 if FItems
[a
].Text <> nil then
1459 cww
[a
] := FItems
[a
].Text.GetWidth
;
1460 if maxcww
< cww
[a
] then maxcww
:= cww
[a
];
1471 for a
:= 0 to High(FItems
) do
1474 if FItems
[a
].Text <> nil then w
:= FItems
[a
].Text.GetWidth
;
1475 if FItems
[a
].Control
<> nil then
1478 if FItems
[a
].ControlType
= TGUILabel
then w
:= w
+(FItems
[a
].Control
as TGUILabel
).GetWidth
1479 else if FItems
[a
].ControlType
= TGUITextButton
then w
:= w
+(FItems
[a
].Control
as TGUITextButton
).GetWidth
1480 else if FItems
[a
].ControlType
= TGUIScroll
then w
:= w
+(FItems
[a
].Control
as TGUIScroll
).GetWidth
1481 else if FItems
[a
].ControlType
= TGUISwitch
then w
:= w
+(FItems
[a
].Control
as TGUISwitch
).GetWidth
1482 else if FItems
[a
].ControlType
= TGUIEdit
then w
:= w
+(FItems
[a
].Control
as TGUIEdit
).GetWidth
1483 else if FItems
[a
].ControlType
= TGUIKeyRead
then w
:= w
+(FItems
[a
].Control
as TGUIKeyRead
).GetWidth
1484 else if FItems
[a
].ControlType
= TGUIKeyRead2
then w
:= w
+(FItems
[a
].Control
as TGUIKeyRead2
).GetWidth
1485 else if FItems
[a
].ControlType
= TGUIListBox
then w
:= w
+(FItems
[a
].Control
as TGUIListBox
).GetWidth
1486 else if FItems
[a
].ControlType
= TGUIFileListBox
then w
:= w
+(FItems
[a
].Control
as TGUIFileListBox
).GetWidth
1487 else if FItems
[a
].ControlType
= TGUIMemo
then w
:= w
+(FItems
[a
].Control
as TGUIMemo
).GetWidth
;
1489 tx
:= Min(tx
, (gScreenWidth
div 2)-(w
div 2));
1494 for a
:= 0 to High(FItems
) do
1498 if (Text <> nil) and (Control
= nil) then Continue
;
1500 if Text <> nil then w
:= tx
+Text.GetWidth
;
1501 if w
> cx
then cx
:= w
;
1505 cx
:= cx
+MENU_HSPACE
;
1507 h
:= FHeader
.GetHeight
*2+MENU_VSPACE
*(Length(FItems
)-1);
1509 for a
:= 0 to High(FItems
) do
1513 if (ControlType
= TGUIListBox
) or (ControlType
= TGUIFileListBox
) then
1514 h
:= h
+(FItems
[a
].Control
as TGUIListBox
).GetHeight()
1517 {$IFDEF ENABLE_RENDER}
1518 r_Render_GetMaxFontSize(FBigFont
, fw
, fh
);
1525 h
:= (gScreenHeight
div 2)-(h
div 2);
1529 FX
:= (gScreenWidth
div 2)-(GetWidth
div 2);
1532 Inc(h
, GetHeight
*2);
1535 for a
:= 0 to High(FItems
) do
1547 if Text.RightAlign
and (length(cww
) > a
) then
1549 //Text.FX := Text.FX+maxcww;
1550 Text.FMaxWidth
:= maxcww
;
1554 if Control
<> nil then
1571 if (ControlType
= TGUIListBox
) or (ControlType
= TGUIFileListBox
) then Inc(h
, (Control
as TGUIListBox
).GetHeight
+MENU_VSPACE
)
1572 else if ControlType
= TGUIMemo
then Inc(h
, (Control
as TGUIMemo
).GetHeight
+MENU_VSPACE
)
1575 {$IFDEF ENABLE_RENDER}
1576 r_Render_GetMaxFontSize(FBigFont
, fw
, fh
);
1577 h
:= h
+ fh
+ MENU_VSPACE
;
1579 h
:= h
+ MENU_VSPACE
;
1585 // another ugly hack
1586 if FYesNo
and (length(FItems
) > 1) then
1589 for a
:= High(FItems
)-1 to High(FItems
) do
1591 if (FItems
[a
].Control
<> nil) and (FItems
[a
].ControlType
= TGUITextButton
) then
1593 cx
:= (FItems
[a
].Control
as TGUITextButton
).GetWidth
;
1594 if cx
> w
then w
:= cx
;
1599 for a
:= High(FItems
)-1 to High(FItems
) do
1601 if (FItems
[a
].Control
<> nil) and (FItems
[a
].ControlType
= TGUITextButton
) then
1603 FItems
[a
].Control
.FX
:= (gScreenWidth
-w
) div 2;
1610 function TGUIMenu
.AddScroll(fText
: string): TGUIScroll
;
1617 Control
:= TGUIScroll
.Create();
1619 Text := TGUILabel
.Create(fText
, FBigFont
);
1622 FColor
:= MENU_ITEMSTEXT_COLOR
;
1625 ControlType
:= TGUIScroll
;
1627 Result
:= (Control
as TGUIScroll
);
1630 if FIndex
= -1 then FIndex
:= i
;
1635 function TGUIMenu
.AddSwitch(fText
: string): TGUISwitch
;
1642 Control
:= TGUISwitch
.Create(FBigFont
);
1643 (Control
as TGUISwitch
).FColor
:= MENU_ITEMSCTRL_COLOR
;
1645 Text := TGUILabel
.Create(fText
, FBigFont
);
1648 FColor
:= MENU_ITEMSTEXT_COLOR
;
1651 ControlType
:= TGUISwitch
;
1653 Result
:= (Control
as TGUISwitch
);
1656 if FIndex
= -1 then FIndex
:= i
;
1661 function TGUIMenu
.AddEdit(fText
: string): TGUIEdit
;
1668 Control
:= TGUIEdit
.Create(FBigFont
);
1669 with Control
as TGUIEdit
do
1671 FWindow
:= Self
.FWindow
;
1672 FColor
:= MENU_ITEMSCTRL_COLOR
;
1675 if fText
= '' then Text := nil else
1677 Text := TGUILabel
.Create(fText
, FBigFont
);
1678 Text.FColor
:= MENU_ITEMSTEXT_COLOR
;
1681 ControlType
:= TGUIEdit
;
1683 Result
:= (Control
as TGUIEdit
);
1686 if FIndex
= -1 then FIndex
:= i
;
1691 procedure TGUIMenu
.Update
;
1697 if FCounter
= 0 then FCounter
:= MENU_MARKERDELAY
else Dec(FCounter
);
1699 if FItems
<> nil then
1700 for a
:= 0 to High(FItems
) do
1701 if FItems
[a
].Control
<> nil then
1702 (FItems
[a
].Control
as FItems
[a
].ControlType
).Update
;
1705 function TGUIMenu
.AddKeyRead(fText
: string): TGUIKeyRead
;
1712 Control
:= TGUIKeyRead
.Create(FBigFont
);
1713 with Control
as TGUIKeyRead
do
1715 FWindow
:= Self
.FWindow
;
1716 FColor
:= MENU_ITEMSCTRL_COLOR
;
1719 Text := TGUILabel
.Create(fText
, FBigFont
);
1722 FColor
:= MENU_ITEMSTEXT_COLOR
;
1725 ControlType
:= TGUIKeyRead
;
1727 Result
:= (Control
as TGUIKeyRead
);
1730 if FIndex
= -1 then FIndex
:= i
;
1735 function TGUIMenu
.AddKeyRead2(fText
: string): TGUIKeyRead2
;
1742 Control
:= TGUIKeyRead2
.Create(FBigFont
);
1743 with Control
as TGUIKeyRead2
do
1745 FWindow
:= Self
.FWindow
;
1746 FColor
:= MENU_ITEMSCTRL_COLOR
;
1749 Text := TGUILabel
.Create(fText
, FBigFont
);
1752 FColor
:= MENU_ITEMSCTRL_COLOR
; //MENU_ITEMSTEXT_COLOR;
1756 ControlType
:= TGUIKeyRead2
;
1758 Result
:= (Control
as TGUIKeyRead2
);
1761 if FIndex
= -1 then FIndex
:= i
;
1766 function TGUIMenu
.AddList(fText
: string; Width
, Height
: Word): TGUIListBox
;
1773 Control
:= TGUIListBox
.Create(FBigFont
, Width
, Height
);
1774 with Control
as TGUIListBox
do
1776 FWindow
:= Self
.FWindow
;
1777 FActiveColor
:= MENU_ITEMSCTRL_COLOR
;
1778 FUnActiveColor
:= MENU_ITEMSTEXT_COLOR
;
1781 Text := TGUILabel
.Create(fText
, FBigFont
);
1784 FColor
:= MENU_ITEMSTEXT_COLOR
;
1787 ControlType
:= TGUIListBox
;
1789 Result
:= (Control
as TGUIListBox
);
1792 if FIndex
= -1 then FIndex
:= i
;
1797 function TGUIMenu
.AddFileList(fText
: string; Width
, Height
: Word): TGUIFileListBox
;
1804 Control
:= TGUIFileListBox
.Create(FBigFont
, Width
, Height
);
1805 with Control
as TGUIFileListBox
do
1807 FWindow
:= Self
.FWindow
;
1808 FActiveColor
:= MENU_ITEMSCTRL_COLOR
;
1809 FUnActiveColor
:= MENU_ITEMSTEXT_COLOR
;
1812 if fText
= '' then Text := nil else
1814 Text := TGUILabel
.Create(fText
, FBigFont
);
1815 Text.FColor
:= MENU_ITEMSTEXT_COLOR
;
1818 ControlType
:= TGUIFileListBox
;
1820 Result
:= (Control
as TGUIFileListBox
);
1823 if FIndex
= -1 then FIndex
:= i
;
1828 function TGUIMenu
.AddLabel(fText
: string): TGUILabel
;
1835 Control
:= TGUILabel
.Create('', FBigFont
);
1836 with Control
as TGUILabel
do
1838 FWindow
:= Self
.FWindow
;
1839 FColor
:= MENU_ITEMSCTRL_COLOR
;
1842 Text := TGUILabel
.Create(fText
, FBigFont
);
1845 FColor
:= MENU_ITEMSTEXT_COLOR
;
1848 ControlType
:= TGUILabel
;
1850 Result
:= (Control
as TGUILabel
);
1853 if FIndex
= -1 then FIndex
:= i
;
1858 function TGUIMenu
.AddMemo(fText
: string; Width
, Height
: Word): TGUIMemo
;
1865 Control
:= TGUIMemo
.Create(FBigFont
, Width
, Height
);
1866 with Control
as TGUIMemo
do
1868 FWindow
:= Self
.FWindow
;
1869 FColor
:= MENU_ITEMSTEXT_COLOR
;
1872 if fText
= '' then Text := nil else
1874 Text := TGUILabel
.Create(fText
, FBigFont
);
1875 Text.FColor
:= MENU_ITEMSTEXT_COLOR
;
1878 ControlType
:= TGUIMemo
;
1880 Result
:= (Control
as TGUIMemo
);
1883 if FIndex
= -1 then FIndex
:= i
;
1888 procedure TGUIMenu
.UpdateIndex();
1896 if (FIndex
< 0) or (FIndex
> High(FItems
)) then
1902 if FItems
[FIndex
].Control
.Enabled
then
1911 constructor TGUIScroll
.Create
;
1916 FOnChangeEvent
:= nil;
1919 procedure TGUIScroll
.FSetValue(a
: Integer);
1921 if a
> FMax
then FValue
:= FMax
else FValue
:= a
;
1924 procedure TGUIScroll
.OnMessage(var Msg
: TMessage
);
1926 if not FEnabled
then Exit
;
1934 IK_LEFT
, IK_KPLEFT
, VK_LEFT
, JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
:
1938 g_Sound_PlayEx(SCROLL_SUBSOUND
);
1939 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
1941 IK_RIGHT
, IK_KPRIGHT
, VK_RIGHT
, JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
1942 if FValue
< FMax
then
1945 g_Sound_PlayEx(SCROLL_ADDSOUND
);
1946 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
1953 procedure TGUIScroll
.Update
;
1961 procedure TGUISwitch
.AddItem(Item
: string);
1963 SetLength(FItems
, Length(FItems
)+1);
1964 FItems
[High(FItems
)] := Item
;
1966 if FIndex
= -1 then FIndex
:= 0;
1969 constructor TGUISwitch
.Create(BigFont
: Boolean);
1975 FBigFont
:= BigFont
;
1978 function TGUISwitch
.GetText
: string;
1980 if FIndex
<> -1 then Result
:= FItems
[FIndex
]
1984 procedure TGUISwitch
.OnMessage(var Msg
: TMessage
);
1986 if not FEnabled
then Exit
;
1990 if FItems
= nil then Exit
;
1995 IK_RETURN
, IK_RIGHT
, IK_KPRETURN
, IK_KPRIGHT
, VK_FIRE
, VK_OPEN
, VK_RIGHT
,
1996 JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
,
1997 JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
1999 if FIndex
< High(FItems
) then
2004 g_Sound_PlayEx(SCROLL_ADDSOUND
);
2006 if @FOnChangeEvent
<> nil then
2007 FOnChangeEvent(Self
);
2010 IK_LEFT
, IK_KPLEFT
, VK_LEFT
,
2011 JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
:
2016 FIndex
:= High(FItems
);
2018 g_Sound_PlayEx(SCROLL_SUBSOUND
);
2020 if @FOnChangeEvent
<> nil then
2021 FOnChangeEvent(Self
);
2027 procedure TGUISwitch
.Update
;
2035 constructor TGUIEdit
.Create(BigFont
: Boolean);
2039 FBigFont
:= BigFont
;
2045 procedure TGUIEdit
.OnMessage(var Msg
: TMessage
);
2047 if not FEnabled
then Exit
;
2056 if (wParam
in [48..57]) and (Chr(wParam
) <> '`') then
2057 if Length(Text) < FMaxLength
then
2059 Insert(Chr(wParam
), FText
, FCaretPos
+ 1);
2065 if (wParam
in [32..255]) and (Chr(wParam
) <> '`') then
2066 if Length(Text) < FMaxLength
then
2068 Insert(Chr(wParam
), FText
, FCaretPos
+ 1);
2076 Delete(FText
, FCaretPos
, 1);
2077 if FCaretPos
> 0 then Dec(FCaretPos
);
2079 IK_DELETE
: Delete(FText
, FCaretPos
+ 1, 1);
2080 IK_END
, IK_KPEND
: FCaretPos
:= Length(FText
);
2081 IK_HOME
, IK_KPHOME
: FCaretPos
:= 0;
2082 IK_LEFT
, IK_KPLEFT
, VK_LEFT
, JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
: if FCaretPos
> 0 then Dec(FCaretPos
);
2083 IK_RIGHT
, IK_KPRIGHT
, VK_RIGHT
, JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
: if FCaretPos
< Length(FText
) then Inc(FCaretPos
);
2084 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
2087 if FActiveControl
<> Self
then
2090 if @FOnEnterEvent
<> nil then FOnEnterEvent(Self
);
2094 if FDefControl
<> '' then SetActive(GetControl(FDefControl
))
2095 else SetActive(nil);
2096 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2102 g_GUIGrabInput
:= (@FOnEnterEvent
= nil) and (FWindow
.FActiveControl
= Self
);
2104 {$IFDEF ENABLE_TOUCH}
2105 sys_ShowKeyboard(g_GUIGrabInput
)
2109 procedure TGUIEdit
.SetText(Text: string);
2111 if Length(Text) > FMaxLength
then SetLength(Text, FMaxLength
);
2113 FCaretPos
:= Length(FText
);
2116 procedure TGUIEdit
.Update
;
2123 constructor TGUIKeyRead
.Create(BigFont
: Boolean);
2128 FBigFont
:= BigFont
;
2131 function TGUIKeyRead
.WantActivationKey (key
: LongInt): Boolean;
2134 (key
= IK_BACKSPACE
) or
2138 procedure TGUIKeyRead
.OnMessage(var Msg
: TMessage
);
2139 procedure actDefCtl ();
2142 if FDefControl
<> '' then
2143 SetActive(GetControl(FDefControl
))
2151 if not FEnabled
then
2160 if FIsQuery
then actDefCtl();
2163 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
2165 if not FIsQuery
then
2168 if FActiveControl
<> Self
then
2173 else if (wParam
< VK_FIRSTKEY
) and (wParam
> VK_LASTKEY
) then
2175 // FKey := IK_ENTER; // <Enter>
2181 IK_BACKSPACE
: // clear keybinding if we aren't waiting for a key
2183 if not FIsQuery
then
2193 if not FIsQuery
and (wParam
= IK_BACKSPACE
) then
2198 else if FIsQuery
then
2201 IK_ENTER
, IK_KPRETURN
, VK_FIRSTKEY
..VK_LASTKEY (*, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK*): // Not <Enter
2203 if e_KeyNames
[wParam
] <> '' then
2212 g_GUIGrabInput
:= FIsQuery
2217 constructor TGUIKeyRead2
.Create(BigFont
: Boolean);
2218 {$IFDEF ENABLE_RENDER}
2219 var a
: Byte; w
, h
: Integer;
2229 FBigFont
:= BigFont
;
2231 FMaxKeyNameWdt
:= 0;
2233 {$IFDEF ENABLE_RENDER}
2234 for a
:= 0 to 255 do
2236 r_Render_GetStringSize(BigFont
, e_KeyNames
[a
], w
, h
);
2237 FMaxKeyNameWdt
:= Max(FMaxKeyNameWdt
, w
);
2239 FMaxKeyNameWdt
:= FMaxKeyNameWdt
-(FMaxKeyNameWdt
div 3);
2240 r_Render_GetStringSize(BigFont
, KEYREAD_QUERY
, w
, h
);
2241 if w
> FMaxKeyNameWdt
then FMaxKeyNameWdt
:= w
;
2242 r_Render_GetStringSize(BigFont
, KEYREAD_CLEAR
, w
, h
);
2243 if w
> FMaxKeyNameWdt
then FMaxKeyNameWdt
:= w
;
2247 function TGUIKeyRead2
.WantActivationKey (key
: LongInt): Boolean;
2250 IK_BACKSPACE
, IK_LEFT
, IK_RIGHT
, IK_KPLEFT
, IK_KPRIGHT
, VK_LEFT
, VK_RIGHT
,
2251 JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
,
2252 JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
2259 procedure TGUIKeyRead2
.OnMessage(var Msg
: TMessage
);
2260 procedure actDefCtl ();
2263 if FDefControl
<> '' then
2264 SetActive(GetControl(FDefControl
))
2272 if not FEnabled
then
2281 if FIsQuery
then actDefCtl();
2284 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
2286 if not FIsQuery
then
2289 if FActiveControl
<> Self
then
2294 else if (wParam
< VK_FIRSTKEY
) and (wParam
> VK_LASTKEY
) then
2296 // if (FKeyIdx = 0) then FKey0 := IK_ENTER else FKey1 := IK_ENTER; // <Enter>
2297 if (FKeyIdx
= 0) then FKey0
:= wParam
else FKey1
:= wParam
;
2302 IK_BACKSPACE
: // clear keybinding if we aren't waiting for a key
2304 if not FIsQuery
then
2306 if (FKeyIdx
= 0) then FKey0
:= 0 else FKey1
:= 0;
2310 IK_LEFT
, IK_KPLEFT
, VK_LEFT
, JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
:
2311 if not FIsQuery
then
2316 IK_RIGHT
, IK_KPRIGHT
, VK_RIGHT
, JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
2317 if not FIsQuery
then
2326 if not FIsQuery
and (wParam
= IK_BACKSPACE
) then
2328 if (FKeyIdx
= 0) then FKey0
:= 0 else FKey1
:= 0;
2331 else if FIsQuery
then
2334 IK_ENTER
, IK_KPRETURN
, VK_FIRSTKEY
..VK_LASTKEY (*, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK*): // Not <Enter
2336 if e_KeyNames
[wParam
] <> '' then
2338 if (FKeyIdx
= 0) then FKey0
:= wParam
else FKey1
:= wParam
;
2347 g_GUIGrabInput
:= FIsQuery
2353 constructor TGUIModelView
.Create
;
2360 destructor TGUIModelView
.Destroy
;
2367 procedure TGUIModelView
.NextAnim();
2369 if FModel
= nil then
2372 if FModel
.Animation
< A_PAIN
then
2373 FModel
.ChangeAnimation(FModel
.Animation
+1, True)
2375 FModel
.ChangeAnimation(A_STAND
, True);
2378 procedure TGUIModelView
.NextWeapon();
2380 if FModel
= nil then
2383 if FModel
.Weapon
< WP_LAST
then
2384 FModel
.SetWeapon(FModel
.Weapon
+1)
2386 FModel
.SetWeapon(WEAPON_KASTET
);
2389 procedure TGUIModelView
.OnMessage(var Msg
: TMessage
);
2395 procedure TGUIModelView
.SetColor(Red
, Green
, Blue
: Byte);
2397 if FModel
<> nil then FModel
.SetColor(Red
, Green
, Blue
);
2400 procedure TGUIModelView
.SetModel(ModelName
: string);
2404 FModel
:= g_PlayerModel_Get(ModelName
);
2407 procedure TGUIModelView
.Update
;
2414 if FModel
<> nil then FModel
.Update
;
2419 constructor TGUIMapPreview
.Create();
2425 destructor TGUIMapPreview
.Destroy();
2431 procedure TGUIMapPreview
.OnMessage(var Msg
: TMessage
);
2437 procedure TGUIMapPreview
.SetMap(Res
: string);
2442 //header: TMapHeaderRec_1;
2447 map
: TDynRecord
= nil;
2454 FileName
:= g_ExtractWadName(Res
);
2456 WAD
:= TWADFile
.Create();
2457 if not WAD
.ReadFile(FileName
) then
2463 //k8: ignores path again
2464 if not WAD
.GetMapResource(g_ExtractFileName(Res
), Data
, Len
) then
2473 map
:= g_Map_ParseMap(Data
, Len
);
2483 if (map
= nil) then exit
;
2486 panlist
:= map
.field
['panel'];
2487 //header := GetMapHeader(map);
2489 FMapSize
.X
:= map
.Width
div 16;
2490 FMapSize
.Y
:= map
.Height
div 16;
2492 rX
:= Ceil(map
.Width
/ (MAPPREVIEW_WIDTH
*256.0));
2493 rY
:= Ceil(map
.Height
/ (MAPPREVIEW_HEIGHT
*256.0));
2494 FScale
:= max(rX
, rY
);
2498 if (panlist
<> nil) then
2500 for pan
in panlist
do
2502 if (pan
.PanelType
and (PANEL_WALL
or PANEL_CLOSEDOOR
or
2503 PANEL_STEP
or PANEL_WATER
or
2504 PANEL_ACID1
or PANEL_ACID2
)) <> 0 then
2506 SetLength(FMapData
, Length(FMapData
)+1);
2507 with FMapData
[High(FMapData
)] do
2512 X2
:= (pan
.X
+ pan
.Width
) div 16;
2513 Y2
:= (pan
.Y
+ pan
.Height
) div 16;
2515 X1
:= Trunc(X1
/FScale
+ 0.5);
2516 Y1
:= Trunc(Y1
/FScale
+ 0.5);
2517 X2
:= Trunc(X2
/FScale
+ 0.5);
2518 Y2
:= Trunc(Y2
/FScale
+ 0.5);
2520 if (X1
<> X2
) or (Y1
<> Y2
) then
2528 PanelType
:= pan
.PanelType
;
2534 //writeln('freeing map');
2539 procedure TGUIMapPreview
.ClearMap();
2541 SetLength(FMapData
, 0);
2548 procedure TGUIMapPreview
.Update();
2554 function TGUIMapPreview
.GetScaleStr(): String;
2556 if FScale
> 0.0 then
2558 Result
:= FloatToStrF(FScale
*16.0, ffFixed
, 3, 3);
2559 while (Result
[Length(Result
)] = '0') do
2560 Delete(Result
, Length(Result
), 1);
2561 if (Result
[Length(Result
)] = ',') or (Result
[Length(Result
)] = '.') then
2562 Delete(Result
, Length(Result
), 1);
2563 Result
:= '1 : ' + Result
;
2571 procedure TGUIListBox
.AddItem(Item
: string);
2573 SetLength(FItems
, Length(FItems
)+1);
2574 FItems
[High(FItems
)] := Item
;
2576 if FSort
then g_gui
.Sort(FItems
);
2579 function TGUIListBox
.ItemExists (item
: String): Boolean;
2583 while (i
<= High(FItems
)) and (FItems
[i
] <> item
) do Inc(i
);
2584 result
:= i
<= High(FItems
)
2587 procedure TGUIListBox
.Clear
;
2595 constructor TGUIListBox
.Create(BigFont
: Boolean; Width
, Height
: Word);
2599 FBigFont
:= BigFont
;
2603 FOnChangeEvent
:= nil;
2605 FDrawScroll
:= True;
2608 procedure TGUIListBox
.OnMessage(var Msg
: TMessage
);
2612 if not FEnabled
then Exit
;
2616 if FItems
= nil then Exit
;
2629 FIndex
:= High(FItems
);
2630 FStartLine
:= Max(High(FItems
)-FHeight
+1, 0);
2632 IK_UP
, IK_LEFT
, IK_KPUP
, IK_KPLEFT
, VK_LEFT
, JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
:
2636 if FIndex
< FStartLine
then Dec(FStartLine
);
2637 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2639 IK_DOWN
, IK_RIGHT
, IK_KPDOWN
, IK_KPRIGHT
, VK_RIGHT
, JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
2640 if FIndex
< High(FItems
) then
2643 if FIndex
> FStartLine
+FHeight
-1 then Inc(FStartLine
);
2644 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2646 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
2649 if FActiveControl
<> Self
then SetActive(Self
)
2651 if FDefControl
<> '' then SetActive(GetControl(FDefControl
))
2652 else SetActive(nil);
2656 for a
:= 0 to High(FItems
) do
2657 if (Length(FItems
[a
]) > 0) and (LowerCase(FItems
[a
][1]) = LowerCase(Chr(wParam
))) then
2660 FStartLine
:= Min(Max(FIndex
-1, 0), Length(FItems
)-FHeight
);
2661 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2667 function TGUIListBox
.SelectedItem(): String;
2671 if (FIndex
< 0) or (FItems
= nil) or
2672 (FIndex
> High(FItems
)) then
2675 Result
:= FItems
[FIndex
];
2678 procedure TGUIListBox
.FSetItems(Items
: SSArray
);
2680 if FItems
<> nil then
2688 if FSort
then g_gui
.Sort(FItems
);
2691 procedure TGUIListBox
.SelectItem(Item
: String);
2695 if FItems
= nil then
2699 Item
:= LowerCase(Item
);
2701 for a
:= 0 to High(FItems
) do
2702 if LowerCase(FItems
[a
]) = Item
then
2708 if FIndex
< FHeight
then
2711 FStartLine
:= Min(FIndex
, Length(FItems
)-FHeight
);
2714 procedure TGUIListBox
.FSetIndex(aIndex
: Integer);
2716 if FItems
= nil then
2719 if (aIndex
< 0) or (aIndex
> High(FItems
)) then
2724 if FIndex
<= FHeight
then
2727 FStartLine
:= Min(FIndex
, Length(FItems
)-FHeight
);
2732 procedure TGUIFileListBox
.OnMessage(var Msg
: TMessage
);
2734 a
, b
: Integer; s
: AnsiString;
2736 if not FEnabled
then
2739 if FItems
= nil then
2750 if @FOnChangeEvent
<> nil then
2751 FOnChangeEvent(Self
);
2756 FIndex
:= High(FItems
);
2757 FStartLine
:= Max(High(FItems
)-FHeight
+1, 0);
2758 if @FOnChangeEvent
<> nil then
2759 FOnChangeEvent(Self
);
2762 IK_PAGEUP
, IK_KPPAGEUP
:
2764 if FIndex
> FHeight
then
2765 FIndex
:= FIndex
-FHeight
2769 if FStartLine
> FHeight
then
2770 FStartLine
:= FStartLine
-FHeight
2775 IK_PAGEDN
, IK_KPPAGEDN
:
2777 if FIndex
< High(FItems
)-FHeight
then
2778 FIndex
:= FIndex
+FHeight
2780 FIndex
:= High(FItems
);
2782 if FStartLine
< High(FItems
)-FHeight
then
2783 FStartLine
:= FStartLine
+FHeight
2785 FStartLine
:= High(FItems
)-FHeight
+1;
2788 IK_UP
, IK_LEFT
, IK_KPUP
, IK_KPLEFT
, VK_UP
, VK_LEFT
, JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
:
2792 if FIndex
< FStartLine
then
2794 if @FOnChangeEvent
<> nil then
2795 FOnChangeEvent(Self
);
2798 IK_DOWN
, IK_RIGHT
, IK_KPDOWN
, IK_KPRIGHT
, VK_DOWN
, VK_RIGHT
, JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
2799 if FIndex
< High(FItems
) then
2802 if FIndex
> FStartLine
+FHeight
-1 then
2804 if @FOnChangeEvent
<> nil then
2805 FOnChangeEvent(Self
);
2808 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
2811 if FActiveControl
<> Self
then
2815 if FItems
[FIndex
][1] = #29 then // Ïàïêà
2817 if FItems
[FIndex
] = #29 + '..' then
2819 e_LogWritefln('TGUIFileListBox: Upper dir "%s" -> "%s"', [FSubPath
, e_UpperDir(FSubPath
)]);
2820 FSubPath
:= e_UpperDir(FSubPath
)
2824 s
:= Copy(AnsiString(FItems
[FIndex
]), 2);
2825 e_LogWritefln('TGUIFileListBox: Enter dir "%s" -> "%s"', [FSubPath
, e_CatPath(FSubPath
, s
)]);
2826 FSubPath
:= e_CatPath(FSubPath
, s
);
2833 if FDefControl
<> '' then
2834 SetActive(GetControl(FDefControl
))
2842 for b
:= FIndex
+ 1 to High(FItems
) + FIndex
do
2844 a
:= b
mod Length(FItems
);
2845 if ( (Length(FItems
[a
]) > 0) and
2846 (LowerCase(FItems
[a
][1]) = LowerCase(Chr(wParam
))) ) or
2847 ( (Length(FItems
[a
]) > 1) and
2848 (FItems
[a
][1] = #29) and // Ïàïêà
2849 (LowerCase(FItems
[a
][2]) = LowerCase(Chr(wParam
))) ) then
2852 FStartLine
:= Min(Max(FIndex
-1, 0), Length(FItems
)-FHeight
);
2853 if @FOnChangeEvent
<> nil then
2854 FOnChangeEvent(Self
);
2861 procedure TGUIFileListBox
.ScanDirs
;
2862 var i
, j
: Integer; path
: AnsiString; SR
: TSearchRec
; sm
, sc
: String;
2866 i
:= High(FBaseList
);
2869 path
:= e_CatPath(FBaseList
[i
], FSubPath
);
2872 if FindFirst(path
+ '/' + '*', faDirectory
, SR
) = 0 then
2875 if LongBool(SR
.Attr
and faDirectory
) then
2876 if (SR
.Name
<> '.') and ((FSubPath
<> '') or (SR
.Name
<> '..')) then
2877 if Self
.ItemExists(#1 + SR
.Name
) = false then
2878 Self
.AddItem(#1 + SR
.Name
)
2879 until FindNext(SR
) <> 0
2886 i
:= High(FBaseList
);
2889 path
:= e_CatPath(FBaseList
[i
], FSubPath
);
2895 j
:= length(sm
) + 1;
2896 sc
:= Copy(sm
, 1, j
- 1);
2898 if FindFirst(path
+ '/' + sc
, faAnyFile
, SR
) = 0 then
2901 if Self
.ItemExists(SR
.Name
) = false then
2903 until FindNext(SR
) <> 0
2910 for i
:= 0 to High(FItems
) do
2911 if FItems
[i
][1] = #1 then
2912 FItems
[i
][1] := #29;
2915 procedure TGUIFileListBox
.SetBase (dirs
: SSArray
; path
: String = '');
2922 function TGUIFileListBox
.SelectedItem (): String;
2926 if (FIndex
>= 0) and (FIndex
<= High(FItems
)) and (FItems
[FIndex
][1] <> '/') and (FItems
[FIndex
][1] <> '\') then
2928 s
:= e_CatPath(FSubPath
, FItems
[FIndex
]);
2929 if e_FindResource(FBaseList
, s
) = true then
2930 result
:= ExpandFileName(s
)
2932 e_LogWritefln('TGUIFileListBox.SelectedItem -> "%s"', [result
]);
2935 procedure TGUIFileListBox
.UpdateFileList();
2939 if (FIndex
= -1) or (FItems
= nil) or
2940 (FIndex
> High(FItems
)) or
2941 (FItems
[FIndex
][1] = '/') or
2942 (FItems
[FIndex
][1] = '\') then
2945 fn
:= FItems
[FIndex
];
2956 procedure TGUIMemo
.Clear
;
2962 constructor TGUIMemo
.Create(BigFont
: Boolean; Width
, Height
: Word);
2966 FBigFont
:= BigFont
;
2970 FDrawScroll
:= True;
2973 procedure TGUIMemo
.OnMessage(var Msg
: TMessage
);
2975 if not FEnabled
then Exit
;
2979 if FLines
= nil then Exit
;
2985 IK_UP
, IK_LEFT
, IK_KPUP
, IK_KPLEFT
, VK_UP
, VK_LEFT
, JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
:
2986 if FStartLine
> 0 then
2988 IK_DOWN
, IK_RIGHT
, IK_KPDOWN
, IK_KPRIGHT
, VK_DOWN
, VK_RIGHT
, JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
2989 if FStartLine
< Length(FLines
)-FHeight
then
2991 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
2994 if FActiveControl
<> Self
then
3000 if FDefControl
<> '' then SetActive(GetControl(FDefControl
))
3001 else SetActive(nil);
3007 procedure TGUIMemo
.SetText(Text: string);
3010 FLines
:= GetLines(Text, FBigFont
, FWidth
* 16);
3015 procedure TGUIimage
.ClearImage();
3020 constructor TGUIimage
.Create();
3027 destructor TGUIimage
.Destroy();
3032 procedure TGUIimage
.OnMessage(var Msg
: TMessage
);
3037 procedure TGUIimage
.SetImage(Res
: string);
3042 procedure TGUIimage
.Update();