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}
21 {$IFDEF USE_MEMPOOL}mempool
,{$ENDIF}
22 g_base
, e_input
, e_log
, g_playermodel
, g_basic
, MAPDEF
, utils
;
25 MAINMENU_HEADER_COLOR
: TRGB
= (R
:255; G
:255; B
:255);
26 MAINMENU_ITEMS_COLOR
: TRGB
= (R
:255; G
:255; B
:255);
27 MAINMENU_UNACTIVEITEMS_COLOR
: TRGB
= (R
:192; G
:192; B
:192);
28 MAINMENU_CLICKSOUND
= 'MENU_SELECT';
29 MAINMENU_CHANGESOUND
= 'MENU_CHANGE';
31 MAINMENU_MARKER1
= 'MAINMENU_MARKER1';
32 MAINMENU_MARKER2
= 'MAINMENU_MARKER2';
33 MAINMENU_MARKERDELAY
= 24;
34 WINDOW_CLOSESOUND
= 'MENU_CLOSE';
35 MENU_HEADERCOLOR
: TRGB
= (R
:255; G
:255; B
:255);
36 MENU_ITEMSTEXT_COLOR
: TRGB
= (R
:255; G
:255; B
:255);
37 MENU_UNACTIVEITEMS_COLOR
: TRGB
= (R
:128; G
:128; B
:128);
38 MENU_ITEMSCTRL_COLOR
: TRGB
= (R
:255; G
:0; B
:0);
41 MENU_CLICKSOUND
= 'MENU_SELECT';
42 MENU_CHANGESOUND
= 'MENU_CHANGE';
43 MENU_MARKERDELAY
= 24;
44 SCROLL_LEFT
= 'SCROLL_LEFT';
45 SCROLL_RIGHT
= 'SCROLL_RIGHT';
46 SCROLL_MIDDLE
= 'SCROLL_MIDDLE';
47 SCROLL_MARKER
= 'SCROLL_MARKER';
48 SCROLL_ADDSOUND
= 'SCROLL_ADD';
49 SCROLL_SUBSOUND
= 'SCROLL_SUB';
50 EDIT_LEFT
= 'EDIT_LEFT';
51 EDIT_RIGHT
= 'EDIT_RIGHT';
52 EDIT_MIDDLE
= 'EDIT_MIDDLE';
53 EDIT_CURSORCOLOR
: TRGB
= (R
:200; G
:0; B
:0);
55 KEYREAD_QUERY
= '<...>';
56 KEYREAD_CLEAR
= '???';
59 MAPPREVIEW_HEIGHT
= 8;
60 BSCROLL_UPA
= 'BSCROLL_UP_A';
61 BSCROLL_UPU
= 'BSCROLL_UP_U';
62 BSCROLL_DOWNA
= 'BSCROLL_DOWN_A';
63 BSCROLL_DOWNU
= 'BSCROLL_DOWN_U';
64 BSCROLL_MIDDLE
= 'BSCROLL_MIDDLE';
69 MESSAGE_DIKEY
= WM_USER
+ 1;
81 TOnKeyDownEvent
= procedure(Key
: Byte);
82 TOnKeyDownEventEx
= procedure(win
: TGUIWindow
; Key
: Byte);
83 TOnCloseEvent
= procedure;
84 TOnShowEvent
= procedure;
85 TOnClickEvent
= procedure;
86 TOnChangeEvent
= procedure(Sender
: TGUIControl
);
87 TOnEnterEvent
= procedure(Sender
: TGUIControl
);
89 TGUIControl
= class{$IFDEF USE_MEMPOOL}(TPoolObject
){$ENDIF}
96 FRightAlign
: Boolean; //HACK! this works only for "normal" menus, only for menu text labels, and generally sux. sorry.
97 FMaxWidth
: Integer; //HACK! used for right-aligning labels
100 procedure OnMessage(var Msg
: TMessage
); virtual;
101 procedure Update
; virtual;
102 function GetWidth(): Integer; virtual;
103 function GetHeight(): Integer; virtual;
104 function WantActivationKey (key
: LongInt): Boolean; virtual;
105 property X
: Integer read FX write FX
;
106 property Y
: Integer read FY write FY
;
107 property Enabled
: Boolean read FEnabled write FEnabled
;
108 property Name
: string read FName write FName
;
109 property UserData
: Pointer read FUserData write FUserData
;
110 property RightAlign
: Boolean read FRightAlign write FRightAlign
; // for menu
111 property CMaxWidth
: Integer read FMaxWidth
;
113 property Window
: TGUIWindow read FWindow
;
116 TGUIWindow
= class{$IFDEF USE_MEMPOOL}(TPoolObject
){$ENDIF}
118 FActiveControl
: TGUIControl
;
120 FPrevWindow
: TGUIWindow
;
122 FBackTexture
: string;
123 FMainWindow
: Boolean;
124 FOnKeyDown
: TOnKeyDownEvent
;
125 FOnKeyDownEx
: TOnKeyDownEventEx
;
126 FOnCloseEvent
: TOnCloseEvent
;
127 FOnShowEvent
: TOnShowEvent
;
130 Childs
: array of TGUIControl
;
131 constructor Create(Name
: string);
132 destructor Destroy
; override;
133 function AddChild(Child
: TGUIControl
): TGUIControl
;
134 procedure OnMessage(var Msg
: TMessage
);
136 procedure SetActive(Control
: TGUIControl
);
137 function GetControl(Name
: string): TGUIControl
;
138 property OnKeyDown
: TOnKeyDownEvent read FOnKeyDown write FOnKeyDown
;
139 property OnKeyDownEx
: TOnKeyDownEventEx read FOnKeyDownEx write FOnKeyDownEx
;
140 property OnClose
: TOnCloseEvent read FOnCloseEvent write FOnCloseEvent
;
141 property OnShow
: TOnShowEvent read FOnShowEvent write FOnShowEvent
;
142 property Name
: string read FName
;
143 property DefControl
: string read FDefControl write FDefControl
;
144 property BackTexture
: string read FBackTexture write FBackTexture
;
145 property MainWindow
: Boolean read FMainWindow write FMainWindow
;
146 property UserData
: Pointer read FUserData write FUserData
;
148 property ActiveControl
: TGUIControl read FActiveControl
;
151 TGUITextButton
= class(TGUIControl
)
160 ProcEx
: procedure (sender
: TGUITextButton
);
161 constructor Create(aProc
: Pointer; BigFont
: Boolean; Text: string);
162 destructor Destroy(); override;
163 procedure OnMessage(var Msg
: TMessage
); override;
164 procedure Update(); override;
165 procedure Click(Silent
: Boolean = False);
166 property Caption
: string read FText write FText
;
167 property Color
: TRGB read FColor write FColor
;
168 property BigFont
: Boolean read FBigFont write FBigFont
;
169 property ShowWindow
: string read FShowWindow write FShowWindow
;
172 TGUILabel
= class(TGUIControl
)
178 FOnClickEvent
: TOnClickEvent
;
180 constructor Create(Text: string; BigFont
: Boolean);
181 procedure OnMessage(var Msg
: TMessage
); override;
182 property OnClick
: TOnClickEvent read FOnClickEvent write FOnClickEvent
;
183 property FixedLength
: Word read FFixedLen write FFixedLen
;
184 property Text: string read FText write FText
;
185 property Color
: TRGB read FColor write FColor
;
186 property BigFont
: Boolean read FBigFont write FBigFont
;
189 TGUIScroll
= class(TGUIControl
)
193 FOnChangeEvent
: TOnChangeEvent
;
194 procedure FSetValue(a
: Integer);
196 constructor Create();
197 procedure OnMessage(var Msg
: TMessage
); override;
198 procedure Update
; override;
199 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
200 property Max
: Word read FMax write FMax
;
201 property Value
: Integer read FValue write FSetValue
;
204 TGUIItemsList
= array of string;
206 TGUISwitch
= class(TGUIControl
)
209 FItems
: TGUIItemsList
;
212 FOnChangeEvent
: TOnChangeEvent
;
214 constructor Create(BigFont
: Boolean);
215 procedure OnMessage(var Msg
: TMessage
); override;
216 procedure AddItem(Item
: string);
217 procedure Update
; override;
218 function GetText
: string;
219 property ItemIndex
: Integer read FIndex write FIndex
;
220 property Color
: TRGB read FColor write FColor
;
221 property BigFont
: Boolean read FBigFont write FBigFont
;
222 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
223 property Items
: TGUIItemsList read FItems
;
226 TGUIEdit
= class(TGUIControl
)
234 FOnlyDigits
: Boolean;
235 FOnChangeEvent
: TOnChangeEvent
;
236 FOnEnterEvent
: TOnEnterEvent
;
238 procedure SetText(Text: string);
240 constructor Create(BigFont
: Boolean);
241 procedure OnMessage(var Msg
: TMessage
); override;
242 procedure Update
; override;
243 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
244 property OnEnter
: TOnEnterEvent read FOnEnterEvent write FOnEnterEvent
;
245 property Width
: Word read FWidth write FWidth
;
246 property MaxLength
: Word read FMaxLength write FMaxLength
;
247 property OnlyDigits
: Boolean read FOnlyDigits write FOnlyDigits
;
248 property Text: string read FText write SetText
;
249 property Color
: TRGB read FColor write FColor
;
250 property BigFont
: Boolean read FBigFont write FBigFont
;
251 property Invalid
: Boolean read FInvalid write FInvalid
;
253 property CaretPos
: Integer read FCaretPos
;
256 TGUIKeyRead
= class(TGUIControl
)
263 constructor Create(BigFont
: Boolean);
264 procedure OnMessage(var Msg
: TMessage
); override;
265 function WantActivationKey (key
: LongInt): Boolean; override;
266 property Key
: Word read FKey write FKey
;
267 property Color
: TRGB read FColor write FColor
;
268 property BigFont
: Boolean read FBigFont write FBigFont
;
270 property IsQuery
: Boolean read FIsQuery
;
274 TGUIKeyRead2
= class(TGUIControl
)
278 FKey0
, FKey1
: Word; // this should be an array. sorry.
281 FMaxKeyNameWdt
: Integer;
283 constructor Create(BigFont
: Boolean);
284 procedure OnMessage(var Msg
: TMessage
); override;
285 function WantActivationKey (key
: LongInt): Boolean; override;
286 property Key0
: Word read FKey0 write FKey0
;
287 property Key1
: Word read FKey1 write FKey1
;
288 property Color
: TRGB read FColor write FColor
;
289 property BigFont
: Boolean read FBigFont write FBigFont
;
291 property IsQuery
: Boolean read FIsQuery
;
292 property MaxKeyNameWdt
: Integer read FMaxKeyNameWdt
;
293 property KeyIdx
: Integer read FKeyIdx
;
296 TGUIModelView
= class(TGUIControl
)
298 FModel
: TPlayerModel
;
302 destructor Destroy
; override;
303 procedure OnMessage(var Msg
: TMessage
); override;
304 procedure SetModel(ModelName
: string);
305 procedure SetColor(Red
, Green
, Blue
: Byte);
306 procedure NextAnim();
307 procedure NextWeapon();
308 procedure Update
; override;
309 property Model
: TPlayerModel read FModel
;
312 TPreviewPanel
= record
313 X1
, Y1
, X2
, Y2
: Integer;
317 TPreviewPanelArray
= array of TPreviewPanel
;
319 TGUIMapPreview
= class(TGUIControl
)
321 FMapData
: TPreviewPanelArray
;
325 constructor Create();
326 destructor Destroy(); override;
327 procedure OnMessage(var Msg
: TMessage
); override;
328 procedure SetMap(Res
: string);
329 procedure ClearMap();
330 procedure Update(); override;
331 function GetScaleStr
: String;
333 property MapData
: TPreviewPanelArray read FMapData
;
334 property MapSize
: TDFPoint read FMapSize
;
335 property Scale
: Single read FScale
;
338 TGUIImage
= class(TGUIControl
)
343 constructor Create();
344 destructor Destroy(); override;
345 procedure OnMessage(var Msg
: TMessage
); override;
346 procedure SetImage(Res
: string);
347 procedure ClearImage();
348 procedure Update(); override;
350 property DefaultRes
: string read FDefaultRes write FDefaultRes
;
351 property ImageRes
: string read FImageRes
;
354 TGUIListBox
= class(TGUIControl
)
358 FUnActiveColor
: TRGB
;
366 FDrawScroll
: Boolean;
367 FOnChangeEvent
: TOnChangeEvent
;
369 procedure FSetItems(Items
: SSArray
);
370 procedure FSetIndex(aIndex
: Integer);
373 constructor Create(BigFont
: Boolean; Width
, Height
: Word);
374 procedure OnMessage(var Msg
: TMessage
); override;
375 procedure AddItem(Item
: String);
376 function ItemExists (item
: String): Boolean;
377 procedure SelectItem(Item
: String);
379 function SelectedItem(): String;
381 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
382 property Sort
: Boolean read FSort write FSort
;
383 property ItemIndex
: Integer read FIndex write FSetIndex
;
384 property Items
: SSArray read FItems write FSetItems
;
385 property DrawBack
: Boolean read FDrawBack write FDrawBack
;
386 property DrawScrollBar
: Boolean read FDrawScroll write FDrawScroll
;
387 property ActiveColor
: TRGB read FActiveColor write FActiveColor
;
388 property UnActiveColor
: TRGB read FUnActiveColor write FUnActiveColor
;
389 property BigFont
: Boolean read FBigFont write FBigFont
;
391 property Width
: Word read FWidth
;
392 property Height
: Word read FHeight
;
393 property StartLine
: Integer read FStartLine
;
396 TGUIFileListBox
= class(TGUIListBox
)
401 FBaseList
: SSArray
; // highter index have highter priority
406 procedure OnMessage (var Msg
: TMessage
); override;
407 procedure SetBase (dirs
: SSArray
; path
: String = '');
408 function SelectedItem(): String;
409 procedure UpdateFileList
;
411 property Dirs
: Boolean read FDirs write FDirs
;
412 property FileMask
: String read FFileMask write FFileMask
;
415 TGUIMemo
= class(TGUIControl
)
424 FDrawScroll
: Boolean;
426 constructor Create(BigFont
: Boolean; Width
, Height
: Word);
427 procedure OnMessage(var Msg
: TMessage
); override;
429 procedure SetText(Text: string);
430 property DrawBack
: Boolean read FDrawBack write FDrawBack
;
431 property DrawScrollBar
: Boolean read FDrawScroll write FDrawScroll
;
432 property Color
: TRGB read FColor write FColor
;
433 property BigFont
: Boolean read FBigFont write FBigFont
;
435 property Width
: Word read FWidth
;
436 property Height
: Word read FHeight
;
437 property StartLine
: Integer read FStartLine
;
438 property Lines
: SSArray read FLines
;
441 TGUITextButtonList
= array of TGUITextButton
;
443 TGUIMainMenu
= class(TGUIControl
)
445 FButtons
: TGUITextButtonList
;
449 FCounter
: Byte; // !!! update it within render
451 constructor Create(BigFont
: Boolean; Header
: string);
452 destructor Destroy
; override;
453 procedure OnMessage(var Msg
: TMessage
); override;
454 function AddButton(fProc
: Pointer; Caption
: string; ShowWindow
: string = ''): TGUITextButton
;
455 function GetButton(aName
: string): TGUITextButton
;
456 procedure EnableButton(aName
: string; e
: Boolean);
457 procedure AddSpace();
458 procedure Update
; override;
460 property Header
: TGUILabel read FHeader
;
461 property Buttons
: TGUITextButtonList read FButtons
;
462 property Index
: Integer read FIndex
;
463 property Counter
: Byte read FCounter
;
466 TControlType
= class of TGUIControl
;
468 PMenuItem
= ^TMenuItem
;
471 ControlType
: TControlType
;
472 Control
: TGUIControl
;
474 TMenuItemList
= array of TMenuItem
;
476 TGUIMenu
= class(TGUIControl
)
478 FItems
: TMenuItemList
;
486 function NewItem(): Integer;
488 constructor Create(HeaderBigFont
, ItemsBigFont
: Boolean; Header
: string);
489 destructor Destroy
; override;
490 procedure OnMessage(var Msg
: TMessage
); override;
491 procedure AddSpace();
492 procedure AddLine(fText
: string);
493 procedure AddText(fText
: string; MaxWidth
: Word);
494 function AddLabel(fText
: string): TGUILabel
;
495 function AddButton(Proc
: Pointer; fText
: string; _ShowWindow
: string = ''): TGUITextButton
;
496 function AddScroll(fText
: string): TGUIScroll
;
497 function AddSwitch(fText
: string): TGUISwitch
;
498 function AddEdit(fText
: string): TGUIEdit
;
499 function AddKeyRead(fText
: string): TGUIKeyRead
;
500 function AddKeyRead2(fText
: string): TGUIKeyRead2
;
501 function AddList(fText
: string; Width
, Height
: Word): TGUIListBox
;
502 function AddFileList(fText
: string; Width
, Height
: Word): TGUIFileListBox
;
503 function AddMemo(fText
: string; Width
, Height
: Word): TGUIMemo
;
505 function GetControl(aName
: string): TGUIControl
;
506 function GetControlsText(aName
: string): TGUILabel
;
507 procedure Update
; override;
508 procedure UpdateIndex();
509 property Align
: Boolean read FAlign write FAlign
;
510 property Left
: Integer read FLeft write FLeft
;
511 property YesNo
: Boolean read FYesNo write FYesNo
;
513 property Header
: TGUILabel read FHeader
;
514 property Counter
: Byte read FCounter
;
515 property Index
: Integer read FIndex
;
516 property Items
: TMenuItemList read FItems
;
517 property BigFont
: Boolean read FBigFont
;
521 g_GUIWindows
: array of TGUIWindow
;
522 g_ActiveWindow
: TGUIWindow
= nil;
523 g_GUIGrabInput
: Boolean = False;
525 function g_GUI_AddWindow(Window
: TGUIWindow
): TGUIWindow
;
526 function g_GUI_GetWindow(Name
: string): TGUIWindow
;
527 procedure g_GUI_ShowWindow(Name
: string);
528 procedure g_GUI_HideWindow(PlaySound
: Boolean = True);
529 function g_GUI_Destroy(): Boolean;
530 procedure g_GUI_SaveMenuPos();
531 procedure g_GUI_LoadMenuPos();
537 {$IFDEF ENABLE_TOUCH}
540 {$IFDEF ENABLE_RENDER}
543 g_sound
, SysUtils
, e_res
,
544 g_game
, Math
, StrUtils
, g_player
, g_options
,
545 g_map
, g_weapons
, xdynrec
, wadreader
;
549 Saved_Windows
: SSArray
;
551 function GetLines (Text: string; BigFont
: Boolean; MaxWidth
: Word): SSArray
;
552 var i
, j
, len
, lines
: Integer;
554 function GetLine (j
, i
: Integer): String;
556 result
:= Copy(text, j
, i
- j
+ 1);
559 function GetWidth (j
, i
: Integer): Integer;
560 {$IFDEF ENABLE_RENDER}
564 {$IFDEF ENABLE_RENDER}
565 r_GUI_GetStringSize(BigFont
, GetLine(j
, i
), w
, h
);
573 result
:= nil; lines
:= 0;
574 j
:= 1; i
:= 1; len
:= Length(Text);
575 // e_LogWritefln('GetLines @%s len=%s [%s]', [MaxWidth, len, Text]);
578 (* --- Get longest possible sequence --- *)
579 while (i
+ 1 <= len
) and (GetWidth(j
, i
+ 1) <= MaxWidth
) do Inc(i
);
580 (* --- Do not include part of word --- *)
581 if (i
< len
) and (text[i
] <> ' ') then
582 while (i
>= j
) and (text[i
] <> ' ') do Dec(i
);
583 (* --- Do not include spaces --- *)
584 while (i
>= j
) and (text[i
] = ' ') do Dec(i
);
585 (* --- Add line --- *)
586 SetLength(result
, lines
+ 1);
587 result
[lines
] := GetLine(j
, i
);
588 // e_LogWritefln(' -> (%s:%s::%s) [%s]', [j, i, GetWidth(j, i), result[lines]]);
590 (* --- Skip spaces --- *)
591 while (i
<= len
) and (text[i
] = ' ') do Inc(i
);
596 procedure Sort (var a
: SSArray
);
597 var i
, j
: Integer; s
: string;
599 if a
= nil then Exit
;
601 for i
:= High(a
) downto Low(a
) do
602 for j
:= Low(a
) to High(a
) - 1 do
603 if LowerCase(a
[j
]) > LowerCase(a
[j
+ 1]) then
611 function g_GUI_Destroy(): Boolean;
615 Result
:= (Length(g_GUIWindows
) > 0);
617 for i
:= 0 to High(g_GUIWindows
) do
618 g_GUIWindows
[i
].Free();
621 g_ActiveWindow
:= nil;
624 function g_GUI_AddWindow(Window
: TGUIWindow
): TGUIWindow
;
626 SetLength(g_GUIWindows
, Length(g_GUIWindows
)+1);
627 g_GUIWindows
[High(g_GUIWindows
)] := Window
;
632 function g_GUI_GetWindow(Name
: string): TGUIWindow
;
638 if g_GUIWindows
<> nil then
639 for i
:= 0 to High(g_GUIWindows
) do
640 if g_GUIWindows
[i
].FName
= Name
then
642 Result
:= g_GUIWindows
[i
];
646 Assert(Result
<> nil, 'GUI_Window "'+Name
+'" not found');
649 procedure g_GUI_ShowWindow(Name
: string);
653 if g_GUIWindows
= nil then
656 for i
:= 0 to High(g_GUIWindows
) do
657 if g_GUIWindows
[i
].FName
= Name
then
659 g_GUIWindows
[i
].FPrevWindow
:= g_ActiveWindow
;
660 g_ActiveWindow
:= g_GUIWindows
[i
];
662 if g_ActiveWindow
.MainWindow
then
663 g_ActiveWindow
.FPrevWindow
:= nil;
665 if g_ActiveWindow
.FDefControl
<> '' then
666 g_ActiveWindow
.SetActive(g_ActiveWindow
.GetControl(g_ActiveWindow
.FDefControl
))
668 g_ActiveWindow
.SetActive(nil);
670 if @g_ActiveWindow
.FOnShowEvent
<> nil then
671 g_ActiveWindow
.FOnShowEvent();
677 procedure g_GUI_HideWindow(PlaySound
: Boolean = True);
679 if g_ActiveWindow
<> nil then
681 if @g_ActiveWindow
.OnClose
<> nil then
682 g_ActiveWindow
.OnClose();
683 g_ActiveWindow
:= g_ActiveWindow
.FPrevWindow
;
685 g_Sound_PlayEx(WINDOW_CLOSESOUND
);
689 procedure g_GUI_SaveMenuPos();
694 SetLength(Saved_Windows
, 0);
695 win
:= g_ActiveWindow
;
699 len
:= Length(Saved_Windows
);
700 SetLength(Saved_Windows
, len
+ 1);
702 Saved_Windows
[len
] := win
.Name
;
704 if win
.MainWindow
then
707 win
:= win
.FPrevWindow
;
711 procedure g_GUI_LoadMenuPos();
713 i
, j
, k
, len
: Integer;
716 g_ActiveWindow
:= nil;
717 len
:= Length(Saved_Windows
);
722 // Îêíî ñ ãëàâíûì ìåíþ:
723 g_GUI_ShowWindow(Saved_Windows
[len
-1]);
725 // Íå ïåðåêëþ÷èëîñü (èëè íåêóäà äàëüøå):
726 if (len
= 1) or (g_ActiveWindow
= nil) then
729 // Èùåì êíîïêè â îñòàëüíûõ îêíàõ:
730 for k
:= len
-1 downto 1 do
734 for i
:= 0 to Length(g_ActiveWindow
.Childs
)-1 do
736 if g_ActiveWindow
.Childs
[i
] is TGUIMainMenu
then
737 begin // GUI_MainMenu
738 with TGUIMainMenu(g_ActiveWindow
.Childs
[i
]) do
739 for j
:= 0 to Length(FButtons
)-1 do
740 if FButtons
[j
].ShowWindow
= Saved_Windows
[k
-1] then
742 FButtons
[j
].Click(True);
748 if g_ActiveWindow
.Childs
[i
] is TGUIMenu
then
749 with TGUIMenu(g_ActiveWindow
.Childs
[i
]) do
750 for j
:= 0 to Length(FItems
)-1 do
751 if FItems
[j
].ControlType
= TGUITextButton
then
752 if TGUITextButton(FItems
[j
].Control
).ShowWindow
= Saved_Windows
[k
-1] then
754 TGUITextButton(FItems
[j
].Control
).Click(True);
765 (g_ActiveWindow
.Name
= Saved_Windows
[k
]) then
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
.OnMessage(var Msg
: TMessage
);
814 if FActiveControl
<> nil then FActiveControl
.OnMessage(Msg
);
815 if @FOnKeyDown
<> nil then FOnKeyDown(Msg
.wParam
);
816 if @FOnKeyDownEx
<> nil then FOnKeyDownEx(self
, Msg
.wParam
);
818 if Msg
.Msg
= WM_KEYDOWN
then
830 procedure TGUIWindow
.SetActive(Control
: TGUIControl
);
832 FActiveControl
:= Control
;
835 function TGUIWindow
.GetControl(Name
: String): TGUIControl
;
841 if Childs
<> nil then
842 for i
:= 0 to High(Childs
) do
843 if Childs
[i
] <> nil then
844 if LowerCase(Childs
[i
].FName
) = LowerCase(Name
) then
850 Assert(Result
<> nil, 'Window Control "'+Name
+'" not Found!');
855 constructor TGUIControl
.Create();
861 FRightAlign
:= false;
865 procedure TGUIControl
.OnMessage(var Msg
: TMessage
);
871 procedure TGUIControl
.Update();
875 function TGUIControl
.WantActivationKey (key
: LongInt): Boolean;
880 function TGUIControl
.GetWidth (): Integer;
881 {$IFDEF ENABLE_RENDER}
885 {$IFDEF ENABLE_RENDER}
886 r_GUI_GetSize(Self
, Result
, h
);
892 function TGUIControl
.GetHeight (): Integer;
893 {$IFDEF ENABLE_RENDER}
897 {$IFDEF ENABLE_RENDER}
898 r_GUI_GetSize(Self
, w
, Result
);
906 procedure TGUITextButton
.Click(Silent
: Boolean = False);
908 if (FSound
<> '') and (not Silent
) then g_Sound_PlayEx(FSound
);
910 if @Proc
<> nil then Proc();
911 if @ProcEx
<> nil then ProcEx(self
);
913 if FShowWindow
<> '' then g_GUI_ShowWindow(FShowWindow
);
916 constructor TGUITextButton
.Create(aProc
: Pointer; BigFont
: Boolean; Text: string);
927 destructor TGUITextButton
.Destroy
;
933 procedure TGUITextButton
.OnMessage(var Msg
: TMessage
);
935 if not FEnabled
then Exit
;
942 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
: Click();
947 procedure TGUITextButton
.Update
;
954 function TGUIMainMenu
.AddButton(fProc
: Pointer; Caption
: string; ShowWindow
: string = ''): TGUITextButton
;
956 {$IFDEF ENABLE_RENDER}
965 SetLength(FButtons
, Length(FButtons
)+1);
966 FButtons
[High(FButtons
)] := TGUITextButton
.Create(fProc
, FBigFont
, Caption
);
967 FButtons
[High(FButtons
)].ShowWindow
:= ShowWindow
;
968 with FButtons
[High(FButtons
)] do
970 if (fProc
<> nil) or (ShowWindow
<> '') then FColor
:= MAINMENU_ITEMS_COLOR
971 else FColor
:= MAINMENU_UNACTIVEITEMS_COLOR
;
972 FSound
:= MAINMENU_CLICKSOUND
;
975 _x
:= gScreenWidth
div 2;
977 for a
:= 0 to High(FButtons
) do
978 if FButtons
[a
] <> nil then
979 _x
:= Min(_x
, (gScreenWidth
div 2)-(FButtons
[a
].GetWidth
div 2));
981 {$IFDEF ENABLE_RENDER}
982 if FHeader
= nil then
983 r_GUI_GetLogoSize(lw
, lh
);
985 hh
:= FButtons
[High(FButtons
)].GetHeight
;
987 if FHeader
= nil then h
:= lh
+ hh
* (1 + Length(FButtons
)) + MAINMENU_SPACE
* (Length(FButtons
) - 1)
988 else h
:= hh
* (2 + Length(FButtons
)) + MAINMENU_SPACE
* (Length(FButtons
) - 1);
989 h
:= (gScreenHeight
div 2) - (h
div 2);
991 if FHeader
<> nil then with FHeader
do
997 if FHeader
= nil then Inc(h
, lh
)
1000 for a
:= 0 to High(FButtons
) do
1002 if FButtons
[a
] <> nil then
1009 Inc(h
, hh
+MAINMENU_SPACE
);
1012 Result
:= FButtons
[High(FButtons
)];
1015 procedure TGUIMainMenu
.AddSpace
;
1017 SetLength(FButtons
, Length(FButtons
)+1);
1018 FButtons
[High(FButtons
)] := nil;
1021 constructor TGUIMainMenu
.Create(BigFont
: Boolean; Header
: string);
1026 FBigFont
:= BigFont
;
1027 FCounter
:= MAINMENU_MARKERDELAY
;
1029 if Header
<> '' then
1031 FHeader
:= TGUILabel
.Create(Header
, BigFont
);
1034 FColor
:= MAINMENU_HEADER_COLOR
;
1035 FX
:= (gScreenWidth
div 2)-(GetWidth
div 2);
1036 FY
:= (gScreenHeight
div 2)-(GetHeight
div 2);
1041 destructor TGUIMainMenu
.Destroy
;
1045 if FButtons
<> nil then
1046 for a
:= 0 to High(FButtons
) do
1054 procedure TGUIMainMenu
.EnableButton(aName
: string; e
: Boolean);
1058 if FButtons
= nil then Exit
;
1060 for a
:= 0 to High(FButtons
) do
1061 if (FButtons
[a
] <> nil) and (FButtons
[a
].Name
= aName
) then
1063 if e
then FButtons
[a
].FColor
:= MAINMENU_ITEMS_COLOR
1064 else FButtons
[a
].FColor
:= MAINMENU_UNACTIVEITEMS_COLOR
;
1065 FButtons
[a
].Enabled
:= e
;
1070 function TGUIMainMenu
.GetButton(aName
: string): TGUITextButton
;
1076 if FButtons
= nil then Exit
;
1078 for a
:= 0 to High(FButtons
) do
1079 if (FButtons
[a
] <> nil) and (FButtons
[a
].Name
= aName
) then
1081 Result
:= FButtons
[a
];
1086 procedure TGUIMainMenu
.OnMessage(var Msg
: TMessage
);
1091 if not FEnabled
then Exit
;
1095 if FButtons
= nil then Exit
;
1098 for a
:= 0 to High(FButtons
) do
1099 if FButtons
[a
] <> nil then
1105 if not ok
then Exit
;
1110 IK_UP
, IK_KPUP
, VK_UP
, JOY0_UP
, JOY1_UP
, JOY2_UP
, JOY3_UP
:
1114 if FIndex
< 0 then FIndex
:= High(FButtons
);
1115 until FButtons
[FIndex
] <> nil;
1117 g_Sound_PlayEx(MENU_CHANGESOUND
);
1119 IK_DOWN
, IK_KPDOWN
, VK_DOWN
, JOY0_DOWN
, JOY1_DOWN
, JOY2_DOWN
, JOY3_DOWN
:
1123 if FIndex
> High(FButtons
) then FIndex
:= 0;
1124 until FButtons
[FIndex
] <> nil;
1126 g_Sound_PlayEx(MENU_CHANGESOUND
);
1128 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
;
1133 procedure TGUIMainMenu
.Update
;
1136 FCounter
:= (FCounter
+ 1) MOD (2 * MAINMENU_MARKERDELAY
)
1141 constructor TGUILabel
.Create(Text: string; BigFont
: Boolean);
1145 FBigFont
:= BigFont
;
1148 FOnClickEvent
:= nil;
1151 procedure TGUILabel
.OnMessage(var Msg
: TMessage
);
1153 if not FEnabled
then Exit
;
1160 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
: if @FOnClickEvent
<> nil then FOnClickEvent();
1167 function TGUIMenu
.AddButton(Proc
: Pointer; fText
: string; _ShowWindow
: string = ''): TGUITextButton
;
1174 Control
:= TGUITextButton
.Create(Proc
, FBigFont
, fText
);
1175 with Control
as TGUITextButton
do
1177 ShowWindow
:= _ShowWindow
;
1178 FColor
:= MENU_ITEMSCTRL_COLOR
;
1182 ControlType
:= TGUITextButton
;
1184 Result
:= (Control
as TGUITextButton
);
1187 if FIndex
= -1 then FIndex
:= i
;
1192 procedure TGUIMenu
.AddLine(fText
: string);
1199 Text := TGUILabel
.Create(fText
, FBigFont
);
1202 FColor
:= MENU_ITEMSTEXT_COLOR
;
1211 procedure TGUIMenu
.AddText(fText
: string; MaxWidth
: Word);
1216 l
:= GetLines(fText
, FBigFont
, MaxWidth
);
1218 if l
= nil then Exit
;
1220 for a
:= 0 to High(l
) do
1225 Text := TGUILabel
.Create(l
[a
], FBigFont
);
1228 with Text do begin FColor
:= _RGB(255, 0, 0); end;
1232 with Text do begin FColor
:= MENU_ITEMSTEXT_COLOR
; end;
1242 procedure TGUIMenu
.AddSpace
;
1256 constructor TGUIMenu
.Create(HeaderBigFont
, ItemsBigFont
: Boolean; Header
: string);
1262 FBigFont
:= ItemsBigFont
;
1263 FCounter
:= MENU_MARKERDELAY
;
1267 FHeader
:= TGUILabel
.Create(Header
, HeaderBigFont
);
1270 FX
:= (gScreenWidth
div 2)-(GetWidth
div 2);
1272 FColor
:= MAINMENU_HEADER_COLOR
;
1276 destructor TGUIMenu
.Destroy
;
1280 if FItems
<> nil then
1281 for a
:= 0 to High(FItems
) do
1295 function TGUIMenu
.GetControl(aName
: String): TGUIControl
;
1301 if FItems
<> nil then
1302 for a
:= 0 to High(FItems
) do
1303 if FItems
[a
].Control
<> nil then
1304 if LowerCase(FItems
[a
].Control
.Name
) = LowerCase(aName
) then
1306 Result
:= FItems
[a
].Control
;
1310 Assert(Result
<> nil, 'GUI control "'+aName
+'" not found!');
1313 function TGUIMenu
.GetControlsText(aName
: String): TGUILabel
;
1319 if FItems
<> nil then
1320 for a
:= 0 to High(FItems
) do
1321 if FItems
[a
].Control
<> nil then
1322 if LowerCase(FItems
[a
].Control
.Name
) = LowerCase(aName
) then
1324 Result
:= FItems
[a
].Text;
1328 Assert(Result
<> nil, 'GUI control''s text "'+aName
+'" not found!');
1331 function TGUIMenu
.NewItem
: Integer;
1333 SetLength(FItems
, Length(FItems
)+1);
1334 Result
:= High(FItems
);
1337 procedure TGUIMenu
.OnMessage(var Msg
: TMessage
);
1342 if not FEnabled
then Exit
;
1346 if FItems
= nil then Exit
;
1349 for a
:= 0 to High(FItems
) do
1350 if FItems
[a
].Control
<> nil then
1356 if not ok
then Exit
;
1358 if (Msg
.Msg
= WM_KEYDOWN
) and (FIndex
<> -1) and (FItems
[FIndex
].Control
<> nil) and
1359 (FItems
[FIndex
].Control
.WantActivationKey(Msg
.wParam
)) then
1361 FItems
[FIndex
].Control
.OnMessage(Msg
);
1362 g_Sound_PlayEx(MENU_CLICKSOUND
);
1370 IK_UP
, IK_KPUP
, VK_UP
,JOY0_UP
, JOY1_UP
, JOY2_UP
, JOY3_UP
:
1375 if c
> Length(FItems
) then
1382 if FIndex
< 0 then FIndex
:= High(FItems
);
1383 until (FItems
[FIndex
].Control
<> nil) and
1384 (FItems
[FIndex
].Control
.Enabled
);
1388 g_Sound_PlayEx(MENU_CHANGESOUND
);
1391 IK_DOWN
, IK_KPDOWN
, VK_DOWN
, JOY0_DOWN
, JOY1_DOWN
, JOY2_DOWN
, JOY3_DOWN
:
1396 if c
> Length(FItems
) then
1403 if FIndex
> High(FItems
) then FIndex
:= 0;
1404 until (FItems
[FIndex
].Control
<> nil) and
1405 (FItems
[FIndex
].Control
.Enabled
);
1409 g_Sound_PlayEx(MENU_CHANGESOUND
);
1412 IK_LEFT
, IK_RIGHT
, IK_KPLEFT
, IK_KPRIGHT
, VK_LEFT
, VK_RIGHT
,
1413 JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
,
1414 JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
1416 if FIndex
<> -1 then
1417 if FItems
[FIndex
].Control
<> nil then
1418 FItems
[FIndex
].Control
.OnMessage(Msg
);
1420 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
1422 if FIndex
<> -1 then
1424 if FItems
[FIndex
].Control
<> nil then FItems
[FIndex
].Control
.OnMessage(Msg
);
1426 g_Sound_PlayEx(MENU_CLICKSOUND
);
1430 if FYesNo
and (length(FItems
) > 1) then
1432 Msg
.wParam
:= IK_RETURN
; // to register keypress
1433 FIndex
:= High(FItems
)-1;
1434 if FItems
[FIndex
].Control
<> nil then FItems
[FIndex
].Control
.OnMessage(Msg
);
1437 if FYesNo
and (length(FItems
) > 1) then
1439 Msg
.wParam
:= IK_RETURN
; // to register keypress
1440 FIndex
:= High(FItems
);
1441 if FItems
[FIndex
].Control
<> nil then FItems
[FIndex
].Control
.OnMessage(Msg
);
1448 procedure TGUIMenu
.ReAlign();
1450 {$IFDEF ENABLE_RENDER}
1453 a
, tx
, cx
, w
, h
: Integer;
1454 cww
: array of Integer; // cached widths
1457 if FItems
= nil then Exit
;
1459 SetLength(cww
, length(FItems
));
1461 for a
:= 0 to High(FItems
) do
1463 if FItems
[a
].Text <> nil then
1465 cww
[a
] := FItems
[a
].Text.GetWidth
;
1466 if maxcww
< cww
[a
] then maxcww
:= cww
[a
];
1477 for a
:= 0 to High(FItems
) do
1480 if FItems
[a
].Text <> nil then w
:= FItems
[a
].Text.GetWidth
;
1481 if FItems
[a
].Control
<> nil then
1484 if FItems
[a
].ControlType
= TGUILabel
then w
:= w
+(FItems
[a
].Control
as TGUILabel
).GetWidth
1485 else if FItems
[a
].ControlType
= TGUITextButton
then w
:= w
+(FItems
[a
].Control
as TGUITextButton
).GetWidth
1486 else if FItems
[a
].ControlType
= TGUIScroll
then w
:= w
+(FItems
[a
].Control
as TGUIScroll
).GetWidth
1487 else if FItems
[a
].ControlType
= TGUISwitch
then w
:= w
+(FItems
[a
].Control
as TGUISwitch
).GetWidth
1488 else if FItems
[a
].ControlType
= TGUIEdit
then w
:= w
+(FItems
[a
].Control
as TGUIEdit
).GetWidth
1489 else if FItems
[a
].ControlType
= TGUIKeyRead
then w
:= w
+(FItems
[a
].Control
as TGUIKeyRead
).GetWidth
1490 else if FItems
[a
].ControlType
= TGUIKeyRead2
then w
:= w
+(FItems
[a
].Control
as TGUIKeyRead2
).GetWidth
1491 else if FItems
[a
].ControlType
= TGUIListBox
then w
:= w
+(FItems
[a
].Control
as TGUIListBox
).GetWidth
1492 else if FItems
[a
].ControlType
= TGUIFileListBox
then w
:= w
+(FItems
[a
].Control
as TGUIFileListBox
).GetWidth
1493 else if FItems
[a
].ControlType
= TGUIMemo
then w
:= w
+(FItems
[a
].Control
as TGUIMemo
).GetWidth
;
1495 tx
:= Min(tx
, (gScreenWidth
div 2)-(w
div 2));
1500 for a
:= 0 to High(FItems
) do
1504 if (Text <> nil) and (Control
= nil) then Continue
;
1506 if Text <> nil then w
:= tx
+Text.GetWidth
;
1507 if w
> cx
then cx
:= w
;
1511 cx
:= cx
+MENU_HSPACE
;
1513 h
:= FHeader
.GetHeight
*2+MENU_VSPACE
*(Length(FItems
)-1);
1515 for a
:= 0 to High(FItems
) do
1519 if (ControlType
= TGUIListBox
) or (ControlType
= TGUIFileListBox
) then
1520 h
:= h
+(FItems
[a
].Control
as TGUIListBox
).GetHeight()
1523 {$IFDEF ENABLE_RENDER}
1524 r_GUI_GetMaxFontSize(FBigFont
, fw
, fh
);
1531 h
:= (gScreenHeight
div 2)-(h
div 2);
1535 FX
:= (gScreenWidth
div 2)-(GetWidth
div 2);
1538 Inc(h
, GetHeight
*2);
1541 for a
:= 0 to High(FItems
) do
1553 if Text.RightAlign
and (length(cww
) > a
) then
1555 //Text.FX := Text.FX+maxcww;
1556 Text.FMaxWidth
:= maxcww
;
1560 if Control
<> nil then
1577 if (ControlType
= TGUIListBox
) or (ControlType
= TGUIFileListBox
) then Inc(h
, (Control
as TGUIListBox
).GetHeight
+MENU_VSPACE
)
1578 else if ControlType
= TGUIMemo
then Inc(h
, (Control
as TGUIMemo
).GetHeight
+MENU_VSPACE
)
1581 {$IFDEF ENABLE_RENDER}
1582 r_GUI_GetMaxFontSize(FBigFont
, fw
, fh
);
1583 h
:= h
+ fh
+ MENU_VSPACE
;
1585 h
:= h
+ MENU_VSPACE
;
1591 // another ugly hack
1592 if FYesNo
and (length(FItems
) > 1) then
1595 for a
:= High(FItems
)-1 to High(FItems
) do
1597 if (FItems
[a
].Control
<> nil) and (FItems
[a
].ControlType
= TGUITextButton
) then
1599 cx
:= (FItems
[a
].Control
as TGUITextButton
).GetWidth
;
1600 if cx
> w
then w
:= cx
;
1605 for a
:= High(FItems
)-1 to High(FItems
) do
1607 if (FItems
[a
].Control
<> nil) and (FItems
[a
].ControlType
= TGUITextButton
) then
1609 FItems
[a
].Control
.FX
:= (gScreenWidth
-w
) div 2;
1616 function TGUIMenu
.AddScroll(fText
: string): TGUIScroll
;
1623 Control
:= TGUIScroll
.Create();
1625 Text := TGUILabel
.Create(fText
, FBigFont
);
1628 FColor
:= MENU_ITEMSTEXT_COLOR
;
1631 ControlType
:= TGUIScroll
;
1633 Result
:= (Control
as TGUIScroll
);
1636 if FIndex
= -1 then FIndex
:= i
;
1641 function TGUIMenu
.AddSwitch(fText
: string): TGUISwitch
;
1648 Control
:= TGUISwitch
.Create(FBigFont
);
1649 (Control
as TGUISwitch
).FColor
:= MENU_ITEMSCTRL_COLOR
;
1651 Text := TGUILabel
.Create(fText
, FBigFont
);
1654 FColor
:= MENU_ITEMSTEXT_COLOR
;
1657 ControlType
:= TGUISwitch
;
1659 Result
:= (Control
as TGUISwitch
);
1662 if FIndex
= -1 then FIndex
:= i
;
1667 function TGUIMenu
.AddEdit(fText
: string): TGUIEdit
;
1674 Control
:= TGUIEdit
.Create(FBigFont
);
1675 with Control
as TGUIEdit
do
1677 FWindow
:= Self
.FWindow
;
1678 FColor
:= MENU_ITEMSCTRL_COLOR
;
1681 if fText
= '' then Text := nil else
1683 Text := TGUILabel
.Create(fText
, FBigFont
);
1684 Text.FColor
:= MENU_ITEMSTEXT_COLOR
;
1687 ControlType
:= TGUIEdit
;
1689 Result
:= (Control
as TGUIEdit
);
1692 if FIndex
= -1 then FIndex
:= i
;
1697 procedure TGUIMenu
.Update
;
1703 if FCounter
= 0 then FCounter
:= MENU_MARKERDELAY
else Dec(FCounter
);
1705 if FItems
<> nil then
1706 for a
:= 0 to High(FItems
) do
1707 if FItems
[a
].Control
<> nil then
1708 (FItems
[a
].Control
as FItems
[a
].ControlType
).Update
;
1711 function TGUIMenu
.AddKeyRead(fText
: string): TGUIKeyRead
;
1718 Control
:= TGUIKeyRead
.Create(FBigFont
);
1719 with Control
as TGUIKeyRead
do
1721 FWindow
:= Self
.FWindow
;
1722 FColor
:= MENU_ITEMSCTRL_COLOR
;
1725 Text := TGUILabel
.Create(fText
, FBigFont
);
1728 FColor
:= MENU_ITEMSTEXT_COLOR
;
1731 ControlType
:= TGUIKeyRead
;
1733 Result
:= (Control
as TGUIKeyRead
);
1736 if FIndex
= -1 then FIndex
:= i
;
1741 function TGUIMenu
.AddKeyRead2(fText
: string): TGUIKeyRead2
;
1748 Control
:= TGUIKeyRead2
.Create(FBigFont
);
1749 with Control
as TGUIKeyRead2
do
1751 FWindow
:= Self
.FWindow
;
1752 FColor
:= MENU_ITEMSCTRL_COLOR
;
1755 Text := TGUILabel
.Create(fText
, FBigFont
);
1758 FColor
:= MENU_ITEMSCTRL_COLOR
; //MENU_ITEMSTEXT_COLOR;
1762 ControlType
:= TGUIKeyRead2
;
1764 Result
:= (Control
as TGUIKeyRead2
);
1767 if FIndex
= -1 then FIndex
:= i
;
1772 function TGUIMenu
.AddList(fText
: string; Width
, Height
: Word): TGUIListBox
;
1779 Control
:= TGUIListBox
.Create(FBigFont
, Width
, Height
);
1780 with Control
as TGUIListBox
do
1782 FWindow
:= Self
.FWindow
;
1783 FActiveColor
:= MENU_ITEMSCTRL_COLOR
;
1784 FUnActiveColor
:= MENU_ITEMSTEXT_COLOR
;
1787 Text := TGUILabel
.Create(fText
, FBigFont
);
1790 FColor
:= MENU_ITEMSTEXT_COLOR
;
1793 ControlType
:= TGUIListBox
;
1795 Result
:= (Control
as TGUIListBox
);
1798 if FIndex
= -1 then FIndex
:= i
;
1803 function TGUIMenu
.AddFileList(fText
: string; Width
, Height
: Word): TGUIFileListBox
;
1810 Control
:= TGUIFileListBox
.Create(FBigFont
, Width
, Height
);
1811 with Control
as TGUIFileListBox
do
1813 FWindow
:= Self
.FWindow
;
1814 FActiveColor
:= MENU_ITEMSCTRL_COLOR
;
1815 FUnActiveColor
:= MENU_ITEMSTEXT_COLOR
;
1818 if fText
= '' then Text := nil else
1820 Text := TGUILabel
.Create(fText
, FBigFont
);
1821 Text.FColor
:= MENU_ITEMSTEXT_COLOR
;
1824 ControlType
:= TGUIFileListBox
;
1826 Result
:= (Control
as TGUIFileListBox
);
1829 if FIndex
= -1 then FIndex
:= i
;
1834 function TGUIMenu
.AddLabel(fText
: string): TGUILabel
;
1841 Control
:= TGUILabel
.Create('', FBigFont
);
1842 with Control
as TGUILabel
do
1844 FWindow
:= Self
.FWindow
;
1845 FColor
:= MENU_ITEMSCTRL_COLOR
;
1848 Text := TGUILabel
.Create(fText
, FBigFont
);
1851 FColor
:= MENU_ITEMSTEXT_COLOR
;
1854 ControlType
:= TGUILabel
;
1856 Result
:= (Control
as TGUILabel
);
1859 if FIndex
= -1 then FIndex
:= i
;
1864 function TGUIMenu
.AddMemo(fText
: string; Width
, Height
: Word): TGUIMemo
;
1871 Control
:= TGUIMemo
.Create(FBigFont
, Width
, Height
);
1872 with Control
as TGUIMemo
do
1874 FWindow
:= Self
.FWindow
;
1875 FColor
:= MENU_ITEMSTEXT_COLOR
;
1878 if fText
= '' then Text := nil else
1880 Text := TGUILabel
.Create(fText
, FBigFont
);
1881 Text.FColor
:= MENU_ITEMSTEXT_COLOR
;
1884 ControlType
:= TGUIMemo
;
1886 Result
:= (Control
as TGUIMemo
);
1889 if FIndex
= -1 then FIndex
:= i
;
1894 procedure TGUIMenu
.UpdateIndex();
1902 if (FIndex
< 0) or (FIndex
> High(FItems
)) then
1908 if FItems
[FIndex
].Control
.Enabled
then
1917 constructor TGUIScroll
.Create
;
1922 FOnChangeEvent
:= nil;
1925 procedure TGUIScroll
.FSetValue(a
: Integer);
1927 if a
> FMax
then FValue
:= FMax
else FValue
:= a
;
1930 procedure TGUIScroll
.OnMessage(var Msg
: TMessage
);
1932 if not FEnabled
then Exit
;
1940 IK_LEFT
, IK_KPLEFT
, VK_LEFT
, JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
:
1944 g_Sound_PlayEx(SCROLL_SUBSOUND
);
1945 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
1947 IK_RIGHT
, IK_KPRIGHT
, VK_RIGHT
, JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
1948 if FValue
< FMax
then
1951 g_Sound_PlayEx(SCROLL_ADDSOUND
);
1952 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
1959 procedure TGUIScroll
.Update
;
1967 procedure TGUISwitch
.AddItem(Item
: string);
1969 SetLength(FItems
, Length(FItems
)+1);
1970 FItems
[High(FItems
)] := Item
;
1972 if FIndex
= -1 then FIndex
:= 0;
1975 constructor TGUISwitch
.Create(BigFont
: Boolean);
1981 FBigFont
:= BigFont
;
1984 function TGUISwitch
.GetText
: string;
1986 if FIndex
<> -1 then Result
:= FItems
[FIndex
]
1990 procedure TGUISwitch
.OnMessage(var Msg
: TMessage
);
1992 if not FEnabled
then Exit
;
1996 if FItems
= nil then Exit
;
2001 IK_RETURN
, IK_RIGHT
, IK_KPRETURN
, IK_KPRIGHT
, VK_FIRE
, VK_OPEN
, VK_RIGHT
,
2002 JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
,
2003 JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
2005 if FIndex
< High(FItems
) then
2010 g_Sound_PlayEx(SCROLL_ADDSOUND
);
2012 if @FOnChangeEvent
<> nil then
2013 FOnChangeEvent(Self
);
2016 IK_LEFT
, IK_KPLEFT
, VK_LEFT
,
2017 JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
:
2022 FIndex
:= High(FItems
);
2024 g_Sound_PlayEx(SCROLL_SUBSOUND
);
2026 if @FOnChangeEvent
<> nil then
2027 FOnChangeEvent(Self
);
2033 procedure TGUISwitch
.Update
;
2041 constructor TGUIEdit
.Create(BigFont
: Boolean);
2045 FBigFont
:= BigFont
;
2051 procedure TGUIEdit
.OnMessage(var Msg
: TMessage
);
2053 if not FEnabled
then Exit
;
2062 if (wParam
in [48..57]) and (Chr(wParam
) <> '`') then
2063 if Length(Text) < FMaxLength
then
2065 Insert(Chr(wParam
), FText
, FCaretPos
+ 1);
2071 if (wParam
in [32..255]) and (Chr(wParam
) <> '`') then
2072 if Length(Text) < FMaxLength
then
2074 Insert(Chr(wParam
), FText
, FCaretPos
+ 1);
2082 Delete(FText
, FCaretPos
, 1);
2083 if FCaretPos
> 0 then Dec(FCaretPos
);
2085 IK_DELETE
: Delete(FText
, FCaretPos
+ 1, 1);
2086 IK_END
, IK_KPEND
: FCaretPos
:= Length(FText
);
2087 IK_HOME
, IK_KPHOME
: FCaretPos
:= 0;
2088 IK_LEFT
, IK_KPLEFT
, VK_LEFT
, JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
: if FCaretPos
> 0 then Dec(FCaretPos
);
2089 IK_RIGHT
, IK_KPRIGHT
, VK_RIGHT
, JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
: if FCaretPos
< Length(FText
) then Inc(FCaretPos
);
2090 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
2093 if FActiveControl
<> Self
then
2096 if @FOnEnterEvent
<> nil then FOnEnterEvent(Self
);
2100 if FDefControl
<> '' then SetActive(GetControl(FDefControl
))
2101 else SetActive(nil);
2102 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2108 g_GUIGrabInput
:= (@FOnEnterEvent
= nil) and (FWindow
.FActiveControl
= Self
);
2110 {$IFDEF ENABLE_TOUCH}
2111 sys_ShowKeyboard(g_GUIGrabInput
)
2115 procedure TGUIEdit
.SetText(Text: string);
2117 if Length(Text) > FMaxLength
then SetLength(Text, FMaxLength
);
2119 FCaretPos
:= Length(FText
);
2122 procedure TGUIEdit
.Update
;
2129 constructor TGUIKeyRead
.Create(BigFont
: Boolean);
2134 FBigFont
:= BigFont
;
2137 function TGUIKeyRead
.WantActivationKey (key
: LongInt): Boolean;
2140 (key
= IK_BACKSPACE
) or
2144 procedure TGUIKeyRead
.OnMessage(var Msg
: TMessage
);
2145 procedure actDefCtl ();
2148 if FDefControl
<> '' then
2149 SetActive(GetControl(FDefControl
))
2157 if not FEnabled
then
2166 if FIsQuery
then actDefCtl();
2169 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
2171 if not FIsQuery
then
2174 if FActiveControl
<> Self
then
2179 else if (wParam
< VK_FIRSTKEY
) and (wParam
> VK_LASTKEY
) then
2181 // FKey := IK_ENTER; // <Enter>
2187 IK_BACKSPACE
: // clear keybinding if we aren't waiting for a key
2189 if not FIsQuery
then
2199 if not FIsQuery
and (wParam
= IK_BACKSPACE
) then
2204 else if FIsQuery
then
2207 IK_ENTER
, IK_KPRETURN
, VK_FIRSTKEY
..VK_LASTKEY (*, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK*): // Not <Enter
2209 if e_KeyNames
[wParam
] <> '' then
2218 g_GUIGrabInput
:= FIsQuery
2223 constructor TGUIKeyRead2
.Create(BigFont
: Boolean);
2224 {$IFDEF ENABLE_RENDER}
2225 var a
: Byte; w
, h
: Integer;
2235 FBigFont
:= BigFont
;
2237 FMaxKeyNameWdt
:= 0;
2239 {$IFDEF ENABLE_RENDER}
2240 for a
:= 0 to 255 do
2242 r_GUI_GetStringSize(BigFont
, e_KeyNames
[a
], w
, h
);
2243 FMaxKeyNameWdt
:= Max(FMaxKeyNameWdt
, w
);
2245 FMaxKeyNameWdt
:= FMaxKeyNameWdt
-(FMaxKeyNameWdt
div 3);
2246 r_GUI_GetStringSize(BigFont
, KEYREAD_QUERY
, w
, h
);
2247 if w
> FMaxKeyNameWdt
then FMaxKeyNameWdt
:= w
;
2248 r_GUI_GetStringSize(BigFont
, KEYREAD_CLEAR
, w
, h
);
2249 if w
> FMaxKeyNameWdt
then FMaxKeyNameWdt
:= w
;
2253 function TGUIKeyRead2
.WantActivationKey (key
: LongInt): Boolean;
2256 IK_BACKSPACE
, IK_LEFT
, IK_RIGHT
, IK_KPLEFT
, IK_KPRIGHT
, VK_LEFT
, VK_RIGHT
,
2257 JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
,
2258 JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
2265 procedure TGUIKeyRead2
.OnMessage(var Msg
: TMessage
);
2266 procedure actDefCtl ();
2269 if FDefControl
<> '' then
2270 SetActive(GetControl(FDefControl
))
2278 if not FEnabled
then
2287 if FIsQuery
then actDefCtl();
2290 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
2292 if not FIsQuery
then
2295 if FActiveControl
<> Self
then
2300 else if (wParam
< VK_FIRSTKEY
) and (wParam
> VK_LASTKEY
) then
2302 // if (FKeyIdx = 0) then FKey0 := IK_ENTER else FKey1 := IK_ENTER; // <Enter>
2303 if (FKeyIdx
= 0) then FKey0
:= wParam
else FKey1
:= wParam
;
2308 IK_BACKSPACE
: // clear keybinding if we aren't waiting for a key
2310 if not FIsQuery
then
2312 if (FKeyIdx
= 0) then FKey0
:= 0 else FKey1
:= 0;
2316 IK_LEFT
, IK_KPLEFT
, VK_LEFT
, JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
:
2317 if not FIsQuery
then
2322 IK_RIGHT
, IK_KPRIGHT
, VK_RIGHT
, JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
2323 if not FIsQuery
then
2332 if not FIsQuery
and (wParam
= IK_BACKSPACE
) then
2334 if (FKeyIdx
= 0) then FKey0
:= 0 else FKey1
:= 0;
2337 else if FIsQuery
then
2340 IK_ENTER
, IK_KPRETURN
, VK_FIRSTKEY
..VK_LASTKEY (*, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK*): // Not <Enter
2342 if e_KeyNames
[wParam
] <> '' then
2344 if (FKeyIdx
= 0) then FKey0
:= wParam
else FKey1
:= wParam
;
2353 g_GUIGrabInput
:= FIsQuery
2359 constructor TGUIModelView
.Create
;
2366 destructor TGUIModelView
.Destroy
;
2373 procedure TGUIModelView
.NextAnim();
2375 if FModel
= nil then
2378 if FModel
.Animation
< A_PAIN
then
2379 FModel
.ChangeAnimation(FModel
.Animation
+1, True)
2381 FModel
.ChangeAnimation(A_STAND
, True);
2384 procedure TGUIModelView
.NextWeapon();
2386 if FModel
= nil then
2389 if FModel
.Weapon
< WP_LAST
then
2390 FModel
.SetWeapon(FModel
.Weapon
+1)
2392 FModel
.SetWeapon(WEAPON_KASTET
);
2395 procedure TGUIModelView
.OnMessage(var Msg
: TMessage
);
2401 procedure TGUIModelView
.SetColor(Red
, Green
, Blue
: Byte);
2403 if FModel
<> nil then FModel
.SetColor(Red
, Green
, Blue
);
2406 procedure TGUIModelView
.SetModel(ModelName
: string);
2410 FModel
:= g_PlayerModel_Get(ModelName
);
2413 procedure TGUIModelView
.Update
;
2420 if FModel
<> nil then FModel
.Update
;
2425 constructor TGUIMapPreview
.Create();
2431 destructor TGUIMapPreview
.Destroy();
2437 procedure TGUIMapPreview
.OnMessage(var Msg
: TMessage
);
2443 procedure TGUIMapPreview
.SetMap(Res
: string);
2448 //header: TMapHeaderRec_1;
2453 map
: TDynRecord
= nil;
2460 FileName
:= g_ExtractWadName(Res
);
2462 WAD
:= TWADFile
.Create();
2463 if not WAD
.ReadFile(FileName
) then
2469 //k8: ignores path again
2470 if not WAD
.GetMapResource(g_ExtractFileName(Res
), Data
, Len
) then
2479 map
:= g_Map_ParseMap(Data
, Len
);
2489 if (map
= nil) then exit
;
2492 panlist
:= map
.field
['panel'];
2493 //header := GetMapHeader(map);
2495 FMapSize
.X
:= map
.Width
div 16;
2496 FMapSize
.Y
:= map
.Height
div 16;
2498 rX
:= Ceil(map
.Width
/ (MAPPREVIEW_WIDTH
*256.0));
2499 rY
:= Ceil(map
.Height
/ (MAPPREVIEW_HEIGHT
*256.0));
2500 FScale
:= max(rX
, rY
);
2504 if (panlist
<> nil) then
2506 for pan
in panlist
do
2508 if (pan
.PanelType
and (PANEL_WALL
or PANEL_CLOSEDOOR
or
2509 PANEL_STEP
or PANEL_WATER
or
2510 PANEL_ACID1
or PANEL_ACID2
)) <> 0 then
2512 SetLength(FMapData
, Length(FMapData
)+1);
2513 with FMapData
[High(FMapData
)] do
2518 X2
:= (pan
.X
+ pan
.Width
) div 16;
2519 Y2
:= (pan
.Y
+ pan
.Height
) div 16;
2521 X1
:= Trunc(X1
/FScale
+ 0.5);
2522 Y1
:= Trunc(Y1
/FScale
+ 0.5);
2523 X2
:= Trunc(X2
/FScale
+ 0.5);
2524 Y2
:= Trunc(Y2
/FScale
+ 0.5);
2526 if (X1
<> X2
) or (Y1
<> Y2
) then
2534 PanelType
:= pan
.PanelType
;
2540 //writeln('freeing map');
2545 procedure TGUIMapPreview
.ClearMap();
2547 SetLength(FMapData
, 0);
2554 procedure TGUIMapPreview
.Update();
2560 function TGUIMapPreview
.GetScaleStr(): String;
2562 if FScale
> 0.0 then
2564 Result
:= FloatToStrF(FScale
*16.0, ffFixed
, 3, 3);
2565 while (Result
[Length(Result
)] = '0') do
2566 Delete(Result
, Length(Result
), 1);
2567 if (Result
[Length(Result
)] = ',') or (Result
[Length(Result
)] = '.') then
2568 Delete(Result
, Length(Result
), 1);
2569 Result
:= '1 : ' + Result
;
2577 procedure TGUIListBox
.AddItem(Item
: string);
2579 SetLength(FItems
, Length(FItems
)+1);
2580 FItems
[High(FItems
)] := Item
;
2582 if FSort
then g_gui
.Sort(FItems
);
2585 function TGUIListBox
.ItemExists (item
: String): Boolean;
2589 while (i
<= High(FItems
)) and (FItems
[i
] <> item
) do Inc(i
);
2590 result
:= i
<= High(FItems
)
2593 procedure TGUIListBox
.Clear
;
2601 constructor TGUIListBox
.Create(BigFont
: Boolean; Width
, Height
: Word);
2605 FBigFont
:= BigFont
;
2609 FOnChangeEvent
:= nil;
2611 FDrawScroll
:= True;
2614 procedure TGUIListBox
.OnMessage(var Msg
: TMessage
);
2618 if not FEnabled
then Exit
;
2622 if FItems
= nil then Exit
;
2635 FIndex
:= High(FItems
);
2636 FStartLine
:= Max(High(FItems
)-FHeight
+1, 0);
2638 IK_UP
, IK_LEFT
, IK_KPUP
, IK_KPLEFT
, VK_LEFT
, JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
:
2642 if FIndex
< FStartLine
then Dec(FStartLine
);
2643 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2645 IK_DOWN
, IK_RIGHT
, IK_KPDOWN
, IK_KPRIGHT
, VK_RIGHT
, JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
2646 if FIndex
< High(FItems
) then
2649 if FIndex
> FStartLine
+FHeight
-1 then Inc(FStartLine
);
2650 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2652 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
2655 if FActiveControl
<> Self
then SetActive(Self
)
2657 if FDefControl
<> '' then SetActive(GetControl(FDefControl
))
2658 else SetActive(nil);
2662 for a
:= 0 to High(FItems
) do
2663 if (Length(FItems
[a
]) > 0) and (LowerCase(FItems
[a
][1]) = LowerCase(Chr(wParam
))) then
2666 FStartLine
:= Min(Max(FIndex
-1, 0), Length(FItems
)-FHeight
);
2667 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2673 function TGUIListBox
.SelectedItem(): String;
2677 if (FIndex
< 0) or (FItems
= nil) or
2678 (FIndex
> High(FItems
)) then
2681 Result
:= FItems
[FIndex
];
2684 procedure TGUIListBox
.FSetItems(Items
: SSArray
);
2686 if FItems
<> nil then
2694 if FSort
then g_gui
.Sort(FItems
);
2697 procedure TGUIListBox
.SelectItem(Item
: String);
2701 if FItems
= nil then
2705 Item
:= LowerCase(Item
);
2707 for a
:= 0 to High(FItems
) do
2708 if LowerCase(FItems
[a
]) = Item
then
2714 if FIndex
< FHeight
then
2717 FStartLine
:= Min(FIndex
, Length(FItems
)-FHeight
);
2720 procedure TGUIListBox
.FSetIndex(aIndex
: Integer);
2722 if FItems
= nil then
2725 if (aIndex
< 0) or (aIndex
> High(FItems
)) then
2730 if FIndex
<= FHeight
then
2733 FStartLine
:= Min(FIndex
, Length(FItems
)-FHeight
);
2738 procedure TGUIFileListBox
.OnMessage(var Msg
: TMessage
);
2740 a
, b
: Integer; s
: AnsiString;
2742 if not FEnabled
then
2745 if FItems
= nil then
2756 if @FOnChangeEvent
<> nil then
2757 FOnChangeEvent(Self
);
2762 FIndex
:= High(FItems
);
2763 FStartLine
:= Max(High(FItems
)-FHeight
+1, 0);
2764 if @FOnChangeEvent
<> nil then
2765 FOnChangeEvent(Self
);
2768 IK_PAGEUP
, IK_KPPAGEUP
:
2770 if FIndex
> FHeight
then
2771 FIndex
:= FIndex
-FHeight
2775 if FStartLine
> FHeight
then
2776 FStartLine
:= FStartLine
-FHeight
2781 IK_PAGEDN
, IK_KPPAGEDN
:
2783 if FIndex
< High(FItems
)-FHeight
then
2784 FIndex
:= FIndex
+FHeight
2786 FIndex
:= High(FItems
);
2788 if FStartLine
< High(FItems
)-FHeight
then
2789 FStartLine
:= FStartLine
+FHeight
2791 FStartLine
:= High(FItems
)-FHeight
+1;
2794 IK_UP
, IK_LEFT
, IK_KPUP
, IK_KPLEFT
, VK_UP
, VK_LEFT
, JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
:
2798 if FIndex
< FStartLine
then
2800 if @FOnChangeEvent
<> nil then
2801 FOnChangeEvent(Self
);
2804 IK_DOWN
, IK_RIGHT
, IK_KPDOWN
, IK_KPRIGHT
, VK_DOWN
, VK_RIGHT
, JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
2805 if FIndex
< High(FItems
) then
2808 if FIndex
> FStartLine
+FHeight
-1 then
2810 if @FOnChangeEvent
<> nil then
2811 FOnChangeEvent(Self
);
2814 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
2817 if FActiveControl
<> Self
then
2821 if FItems
[FIndex
][1] = #29 then // Ïàïêà
2823 if FItems
[FIndex
] = #29 + '..' then
2825 e_LogWritefln('TGUIFileListBox: Upper dir "%s" -> "%s"', [FSubPath
, e_UpperDir(FSubPath
)]);
2826 FSubPath
:= e_UpperDir(FSubPath
)
2830 s
:= Copy(AnsiString(FItems
[FIndex
]), 2);
2831 e_LogWritefln('TGUIFileListBox: Enter dir "%s" -> "%s"', [FSubPath
, e_CatPath(FSubPath
, s
)]);
2832 FSubPath
:= e_CatPath(FSubPath
, s
);
2839 if FDefControl
<> '' then
2840 SetActive(GetControl(FDefControl
))
2848 for b
:= FIndex
+ 1 to High(FItems
) + FIndex
do
2850 a
:= b
mod Length(FItems
);
2851 if ( (Length(FItems
[a
]) > 0) and
2852 (LowerCase(FItems
[a
][1]) = LowerCase(Chr(wParam
))) ) or
2853 ( (Length(FItems
[a
]) > 1) and
2854 (FItems
[a
][1] = #29) and // Ïàïêà
2855 (LowerCase(FItems
[a
][2]) = LowerCase(Chr(wParam
))) ) then
2858 FStartLine
:= Min(Max(FIndex
-1, 0), Length(FItems
)-FHeight
);
2859 if @FOnChangeEvent
<> nil then
2860 FOnChangeEvent(Self
);
2867 procedure TGUIFileListBox
.ScanDirs
;
2868 var i
, j
: Integer; path
: AnsiString; SR
: TSearchRec
; sm
, sc
: String;
2872 i
:= High(FBaseList
);
2875 path
:= e_CatPath(FBaseList
[i
], FSubPath
);
2878 if FindFirst(path
+ '/' + '*', faDirectory
, SR
) = 0 then
2881 if LongBool(SR
.Attr
and faDirectory
) then
2882 if (SR
.Name
<> '.') and ((FSubPath
<> '') or (SR
.Name
<> '..')) then
2883 if Self
.ItemExists(#1 + SR
.Name
) = false then
2884 Self
.AddItem(#1 + SR
.Name
)
2885 until FindNext(SR
) <> 0
2892 i
:= High(FBaseList
);
2895 path
:= e_CatPath(FBaseList
[i
], FSubPath
);
2901 j
:= length(sm
) + 1;
2902 sc
:= Copy(sm
, 1, j
- 1);
2904 if FindFirst(path
+ '/' + sc
, faAnyFile
, SR
) = 0 then
2907 if Self
.ItemExists(SR
.Name
) = false then
2909 until FindNext(SR
) <> 0
2916 for i
:= 0 to High(FItems
) do
2917 if FItems
[i
][1] = #1 then
2918 FItems
[i
][1] := #29;
2921 procedure TGUIFileListBox
.SetBase (dirs
: SSArray
; path
: String = '');
2928 function TGUIFileListBox
.SelectedItem (): String;
2932 if (FIndex
>= 0) and (FIndex
<= High(FItems
)) and (FItems
[FIndex
][1] <> '/') and (FItems
[FIndex
][1] <> '\') then
2934 s
:= e_CatPath(FSubPath
, FItems
[FIndex
]);
2935 if e_FindResource(FBaseList
, s
) = true then
2936 result
:= ExpandFileName(s
)
2938 e_LogWritefln('TGUIFileListBox.SelectedItem -> "%s"', [result
]);
2941 procedure TGUIFileListBox
.UpdateFileList();
2945 if (FIndex
= -1) or (FItems
= nil) or
2946 (FIndex
> High(FItems
)) or
2947 (FItems
[FIndex
][1] = '/') or
2948 (FItems
[FIndex
][1] = '\') then
2951 fn
:= FItems
[FIndex
];
2962 procedure TGUIMemo
.Clear
;
2968 constructor TGUIMemo
.Create(BigFont
: Boolean; Width
, Height
: Word);
2972 FBigFont
:= BigFont
;
2976 FDrawScroll
:= True;
2979 procedure TGUIMemo
.OnMessage(var Msg
: TMessage
);
2981 if not FEnabled
then Exit
;
2985 if FLines
= nil then Exit
;
2991 IK_UP
, IK_LEFT
, IK_KPUP
, IK_KPLEFT
, VK_UP
, VK_LEFT
, JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
:
2992 if FStartLine
> 0 then
2994 IK_DOWN
, IK_RIGHT
, IK_KPDOWN
, IK_KPRIGHT
, VK_DOWN
, VK_RIGHT
, JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
2995 if FStartLine
< Length(FLines
)-FHeight
then
2997 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
3000 if FActiveControl
<> Self
then
3006 if FDefControl
<> '' then SetActive(GetControl(FDefControl
))
3007 else SetActive(nil);
3013 procedure TGUIMemo
.SetText(Text: string);
3016 FLines
:= GetLines(Text, FBigFont
, FWidth
* 16);
3021 procedure TGUIimage
.ClearImage();
3026 constructor TGUIimage
.Create();
3033 destructor TGUIimage
.Destroy();
3038 procedure TGUIimage
.OnMessage(var Msg
: TMessage
);
3043 procedure TGUIimage
.SetImage(Res
: string);
3048 procedure TGUIimage
.Update();