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;
78 TFontType
= (Texture
, Character
);
80 TFont
= class{$IFDEF USE_MEMPOOL}(TPoolObject
){$ENDIF}
86 constructor Create(FontID
: DWORD
; FontType
: TFontType
);
87 destructor Destroy
; override;
88 procedure Draw(X
, Y
: Integer; Text: string; R
, G
, B
: Byte);
89 procedure GetTextSize(Text: string; var w
, h
: Word);
90 property Scale
: Single read FScale write FScale
;
91 property ID
: DWORD read FID
;
97 TOnKeyDownEvent
= procedure(Key
: Byte);
98 TOnKeyDownEventEx
= procedure(win
: TGUIWindow
; Key
: Byte);
99 TOnCloseEvent
= procedure;
100 TOnShowEvent
= procedure;
101 TOnClickEvent
= procedure;
102 TOnChangeEvent
= procedure(Sender
: TGUIControl
);
103 TOnEnterEvent
= procedure(Sender
: TGUIControl
);
105 TGUIControl
= class{$IFDEF USE_MEMPOOL}(TPoolObject
){$ENDIF}
109 FWindow
: TGUIWindow
;
112 FRightAlign
: Boolean; //HACK! this works only for "normal" menus, only for menu text labels, and generally sux. sorry.
113 FMaxWidth
: Integer; //HACK! used for right-aligning labels
116 procedure OnMessage(var Msg
: TMessage
); virtual;
117 procedure Update
; virtual;
118 function GetWidth(): Integer; virtual;
119 function GetHeight(): Integer; virtual;
120 function WantActivationKey (key
: LongInt): Boolean; virtual;
121 property X
: Integer read FX write FX
;
122 property Y
: Integer read FY write FY
;
123 property Enabled
: Boolean read FEnabled write FEnabled
;
124 property Name
: string read FName write FName
;
125 property UserData
: Pointer read FUserData write FUserData
;
126 property RightAlign
: Boolean read FRightAlign write FRightAlign
; // for menu
127 property CMaxWidth
: Integer read FMaxWidth
;
129 property Window
: TGUIWindow read FWindow
;
132 TGUIWindow
= class{$IFDEF USE_MEMPOOL}(TPoolObject
){$ENDIF}
134 FActiveControl
: TGUIControl
;
136 FPrevWindow
: TGUIWindow
;
138 FBackTexture
: string;
139 FMainWindow
: Boolean;
140 FOnKeyDown
: TOnKeyDownEvent
;
141 FOnKeyDownEx
: TOnKeyDownEventEx
;
142 FOnCloseEvent
: TOnCloseEvent
;
143 FOnShowEvent
: TOnShowEvent
;
146 Childs
: array of TGUIControl
;
147 constructor Create(Name
: string);
148 destructor Destroy
; override;
149 function AddChild(Child
: TGUIControl
): TGUIControl
;
150 procedure OnMessage(var Msg
: TMessage
);
152 procedure SetActive(Control
: TGUIControl
);
153 function GetControl(Name
: string): TGUIControl
;
154 property OnKeyDown
: TOnKeyDownEvent read FOnKeyDown write FOnKeyDown
;
155 property OnKeyDownEx
: TOnKeyDownEventEx read FOnKeyDownEx write FOnKeyDownEx
;
156 property OnClose
: TOnCloseEvent read FOnCloseEvent write FOnCloseEvent
;
157 property OnShow
: TOnShowEvent read FOnShowEvent write FOnShowEvent
;
158 property Name
: string read FName
;
159 property DefControl
: string read FDefControl write FDefControl
;
160 property BackTexture
: string read FBackTexture write FBackTexture
;
161 property MainWindow
: Boolean read FMainWindow write FMainWindow
;
162 property UserData
: Pointer read FUserData write FUserData
;
164 property ActiveControl
: TGUIControl read FActiveControl
;
167 TGUITextButton
= class(TGUIControl
)
176 ProcEx
: procedure (sender
: TGUITextButton
);
177 constructor Create(aProc
: Pointer; FontID
: DWORD
; Text: string);
178 destructor Destroy(); override;
179 procedure OnMessage(var Msg
: TMessage
); override;
180 procedure Update(); override;
181 procedure Click(Silent
: Boolean = False);
182 property Caption
: string read FText write FText
;
183 property Color
: TRGB read FColor write FColor
;
184 property Font
: TFont read FFont write FFont
;
185 property ShowWindow
: string read FShowWindow write FShowWindow
;
188 TGUILabel
= class(TGUIControl
)
194 FOnClickEvent
: TOnClickEvent
;
196 constructor Create(Text: string; FontID
: DWORD
);
197 procedure OnMessage(var Msg
: TMessage
); override;
198 property OnClick
: TOnClickEvent read FOnClickEvent write FOnClickEvent
;
199 property FixedLength
: Word read FFixedLen write FFixedLen
;
200 property Text: string read FText write FText
;
201 property Color
: TRGB read FColor write FColor
;
202 property Font
: TFont read FFont write FFont
;
205 TGUIScroll
= class(TGUIControl
)
209 FOnChangeEvent
: TOnChangeEvent
;
210 procedure FSetValue(a
: Integer);
212 constructor Create();
213 procedure OnMessage(var Msg
: TMessage
); override;
214 procedure Update
; override;
215 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
216 property Max
: Word read FMax write FMax
;
217 property Value
: Integer read FValue write FSetValue
;
220 TGUIItemsList
= array of string;
222 TGUISwitch
= class(TGUIControl
)
225 FItems
: TGUIItemsList
;
228 FOnChangeEvent
: TOnChangeEvent
;
230 constructor Create(FontID
: DWORD
);
231 procedure OnMessage(var Msg
: TMessage
); override;
232 procedure AddItem(Item
: string);
233 procedure Update
; override;
234 function GetText
: string;
235 property ItemIndex
: Integer read FIndex write FIndex
;
236 property Color
: TRGB read FColor write FColor
;
237 property Font
: TFont read FFont write FFont
;
238 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
239 property Items
: TGUIItemsList read FItems
;
242 TGUIEdit
= class(TGUIControl
)
250 FOnlyDigits
: Boolean;
251 FOnChangeEvent
: TOnChangeEvent
;
252 FOnEnterEvent
: TOnEnterEvent
;
254 procedure SetText(Text: string);
256 constructor Create(FontID
: DWORD
);
257 procedure OnMessage(var Msg
: TMessage
); override;
258 procedure Update
; override;
259 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
260 property OnEnter
: TOnEnterEvent read FOnEnterEvent write FOnEnterEvent
;
261 property Width
: Word read FWidth write FWidth
;
262 property MaxLength
: Word read FMaxLength write FMaxLength
;
263 property OnlyDigits
: Boolean read FOnlyDigits write FOnlyDigits
;
264 property Text: string read FText write SetText
;
265 property Color
: TRGB read FColor write FColor
;
266 property Font
: TFont read FFont write FFont
;
267 property Invalid
: Boolean read FInvalid write FInvalid
;
269 property CaretPos
: Integer read FCaretPos
;
272 TGUIKeyRead
= class(TGUIControl
)
279 constructor Create(FontID
: DWORD
);
280 procedure OnMessage(var Msg
: TMessage
); override;
281 function WantActivationKey (key
: LongInt): Boolean; override;
282 property Key
: Word read FKey write FKey
;
283 property Color
: TRGB read FColor write FColor
;
284 property Font
: TFont read FFont write FFont
;
286 property IsQuery
: Boolean read FIsQuery
;
290 TGUIKeyRead2
= class(TGUIControl
)
295 FKey0
, FKey1
: Word; // this should be an array. sorry.
298 FMaxKeyNameWdt
: Integer;
300 constructor Create(FontID
: DWORD
);
301 procedure OnMessage(var Msg
: TMessage
); override;
302 function WantActivationKey (key
: LongInt): Boolean; override;
303 property Key0
: Word read FKey0 write FKey0
;
304 property Key1
: Word read FKey1 write FKey1
;
305 property Color
: TRGB read FColor write FColor
;
306 property Font
: TFont read FFont write FFont
;
308 property IsQuery
: Boolean read FIsQuery
;
309 property MaxKeyNameWdt
: Integer read FMaxKeyNameWdt
;
310 property KeyIdx
: Integer read FKeyIdx
;
313 TGUIModelView
= class(TGUIControl
)
315 FModel
: TPlayerModel
;
319 destructor Destroy
; override;
320 procedure OnMessage(var Msg
: TMessage
); override;
321 procedure SetModel(ModelName
: string);
322 procedure SetColor(Red
, Green
, Blue
: Byte);
323 procedure NextAnim();
324 procedure NextWeapon();
325 procedure Update
; override;
326 property Model
: TPlayerModel read FModel
;
329 TPreviewPanel
= record
330 X1
, Y1
, X2
, Y2
: Integer;
334 TPreviewPanelArray
= array of TPreviewPanel
;
336 TGUIMapPreview
= class(TGUIControl
)
338 FMapData
: TPreviewPanelArray
;
342 constructor Create();
343 destructor Destroy(); override;
344 procedure OnMessage(var Msg
: TMessage
); override;
345 procedure SetMap(Res
: string);
346 procedure ClearMap();
347 procedure Update(); override;
348 function GetScaleStr
: String;
350 property MapData
: TPreviewPanelArray read FMapData
;
351 property MapSize
: TDFPoint read FMapSize
;
352 property Scale
: Single read FScale
;
355 TGUIImage
= class(TGUIControl
)
360 constructor Create();
361 destructor Destroy(); override;
362 procedure OnMessage(var Msg
: TMessage
); override;
363 procedure SetImage(Res
: string);
364 procedure ClearImage();
365 procedure Update(); override;
367 property DefaultRes
: string read FDefaultRes write FDefaultRes
;
368 property ImageRes
: string read FImageRes
;
371 TGUIListBox
= class(TGUIControl
)
375 FUnActiveColor
: TRGB
;
383 FDrawScroll
: Boolean;
384 FOnChangeEvent
: TOnChangeEvent
;
386 procedure FSetItems(Items
: SSArray
);
387 procedure FSetIndex(aIndex
: Integer);
390 constructor Create(FontID
: DWORD
; Width
, Height
: Word);
391 procedure OnMessage(var Msg
: TMessage
); override;
392 procedure AddItem(Item
: String);
393 function ItemExists (item
: String): Boolean;
394 procedure SelectItem(Item
: String);
396 function SelectedItem(): String;
398 property OnChange
: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent
;
399 property Sort
: Boolean read FSort write FSort
;
400 property ItemIndex
: Integer read FIndex write FSetIndex
;
401 property Items
: SSArray read FItems write FSetItems
;
402 property DrawBack
: Boolean read FDrawBack write FDrawBack
;
403 property DrawScrollBar
: Boolean read FDrawScroll write FDrawScroll
;
404 property ActiveColor
: TRGB read FActiveColor write FActiveColor
;
405 property UnActiveColor
: TRGB read FUnActiveColor write FUnActiveColor
;
406 property Font
: TFont read FFont write FFont
;
408 property Width
: Word read FWidth
;
409 property Height
: Word read FHeight
;
410 property StartLine
: Integer read FStartLine
;
413 TGUIFileListBox
= class(TGUIListBox
)
418 FBaseList
: SSArray
; // highter index have highter priority
423 procedure OnMessage (var Msg
: TMessage
); override;
424 procedure SetBase (dirs
: SSArray
; path
: String = '');
425 function SelectedItem(): String;
426 procedure UpdateFileList
;
428 property Dirs
: Boolean read FDirs write FDirs
;
429 property FileMask
: String read FFileMask write FFileMask
;
432 TGUIMemo
= class(TGUIControl
)
441 FDrawScroll
: Boolean;
443 constructor Create(FontID
: DWORD
; Width
, Height
: Word);
444 procedure OnMessage(var Msg
: TMessage
); override;
446 procedure SetText(Text: string);
447 property DrawBack
: Boolean read FDrawBack write FDrawBack
;
448 property DrawScrollBar
: Boolean read FDrawScroll write FDrawScroll
;
449 property Color
: TRGB read FColor write FColor
;
450 property Font
: TFont read FFont write FFont
;
452 property Width
: Word read FWidth
;
453 property Height
: Word read FHeight
;
454 property StartLine
: Integer read FStartLine
;
455 property Lines
: SSArray read FLines
;
458 TGUITextButtonList
= array of TGUITextButton
;
460 TGUIMainMenu
= class(TGUIControl
)
462 FButtons
: TGUITextButtonList
;
466 FCounter
: Byte; // !!! update it within render
468 constructor Create(FontID
: DWORD
; Header
: string);
469 destructor Destroy
; override;
470 procedure OnMessage(var Msg
: TMessage
); override;
471 function AddButton(fProc
: Pointer; Caption
: string; ShowWindow
: string = ''): TGUITextButton
;
472 function GetButton(aName
: string): TGUITextButton
;
473 procedure EnableButton(aName
: string; e
: Boolean);
474 procedure AddSpace();
475 procedure Update
; override;
477 property Header
: TGUILabel read FHeader
;
478 property Buttons
: TGUITextButtonList read FButtons
;
479 property Index
: Integer read FIndex
;
480 property Counter
: Byte read FCounter
;
483 TControlType
= class of TGUIControl
;
485 PMenuItem
= ^TMenuItem
;
488 ControlType
: TControlType
;
489 Control
: TGUIControl
;
491 TMenuItemList
= array of TMenuItem
;
493 TGUIMenu
= class(TGUIControl
)
495 FItems
: TMenuItemList
;
503 function NewItem(): Integer;
505 constructor Create(HeaderFont
, ItemsFont
: DWORD
; Header
: string);
506 destructor Destroy
; override;
507 procedure OnMessage(var Msg
: TMessage
); override;
508 procedure AddSpace();
509 procedure AddLine(fText
: string);
510 procedure AddText(fText
: string; MaxWidth
: Word);
511 function AddLabel(fText
: string): TGUILabel
;
512 function AddButton(Proc
: Pointer; fText
: string; _ShowWindow
: string = ''): TGUITextButton
;
513 function AddScroll(fText
: string): TGUIScroll
;
514 function AddSwitch(fText
: string): TGUISwitch
;
515 function AddEdit(fText
: string): TGUIEdit
;
516 function AddKeyRead(fText
: string): TGUIKeyRead
;
517 function AddKeyRead2(fText
: string): TGUIKeyRead2
;
518 function AddList(fText
: string; Width
, Height
: Word): TGUIListBox
;
519 function AddFileList(fText
: string; Width
, Height
: Word): TGUIFileListBox
;
520 function AddMemo(fText
: string; Width
, Height
: Word): TGUIMemo
;
522 function GetControl(aName
: string): TGUIControl
;
523 function GetControlsText(aName
: string): TGUILabel
;
524 procedure Update
; override;
525 procedure UpdateIndex();
526 property Align
: Boolean read FAlign write FAlign
;
527 property Left
: Integer read FLeft write FLeft
;
528 property YesNo
: Boolean read FYesNo write FYesNo
;
530 property Header
: TGUILabel read FHeader
;
531 property Counter
: Byte read FCounter
;
532 property Index
: Integer read FIndex
;
533 property Items
: TMenuItemList read FItems
;
534 property FontID
: DWORD read FFontID
;
538 g_GUIWindows
: array of TGUIWindow
;
539 g_ActiveWindow
: TGUIWindow
= nil;
540 g_GUIGrabInput
: Boolean = False;
542 function g_GUI_AddWindow(Window
: TGUIWindow
): TGUIWindow
;
543 function g_GUI_GetWindow(Name
: string): TGUIWindow
;
544 procedure g_GUI_ShowWindow(Name
: string);
545 procedure g_GUI_HideWindow(PlaySound
: Boolean = True);
546 function g_GUI_Destroy(): Boolean;
547 procedure g_GUI_SaveMenuPos();
548 procedure g_GUI_LoadMenuPos();
554 {$IFDEF ENABLE_TOUCH}
557 {$IFDEF ENABLE_RENDER}
558 r_gui
, r_textures
, r_graphics
,
560 g_sound
, SysUtils
, e_res
,
561 g_game
, Math
, StrUtils
, g_player
, g_options
,
562 g_map
, g_weapons
, xdynrec
, wadreader
;
566 Saved_Windows
: SSArray
;
568 function GetLines (Text: string; FontID
: DWORD
; MaxWidth
: Word): SSArray
;
569 var i
, j
, len
, lines
: Integer;
571 function GetLine (j
, i
: Integer): String;
573 result
:= Copy(text, j
, i
- j
+ 1);
576 function GetWidth (j
, i
: Integer): Integer;
579 e_CharFont_GetSize(FontID
, GetLine(j
, i
), w
, h
);
584 result
:= nil; lines
:= 0;
585 j
:= 1; i
:= 1; len
:= Length(Text);
586 // e_LogWritefln('GetLines @%s len=%s [%s]', [MaxWidth, len, Text]);
589 (* --- Get longest possible sequence --- *)
590 while (i
+ 1 <= len
) and (GetWidth(j
, i
+ 1) <= MaxWidth
) do Inc(i
);
591 (* --- Do not include part of word --- *)
592 if (i
< len
) and (text[i
] <> ' ') then
593 while (i
>= j
) and (text[i
] <> ' ') do Dec(i
);
594 (* --- Do not include spaces --- *)
595 while (i
>= j
) and (text[i
] = ' ') do Dec(i
);
596 (* --- Add line --- *)
597 SetLength(result
, lines
+ 1);
598 result
[lines
] := GetLine(j
, i
);
599 // e_LogWritefln(' -> (%s:%s::%s) [%s]', [j, i, GetWidth(j, i), result[lines]]);
601 (* --- Skip spaces --- *)
602 while (i
<= len
) and (text[i
] = ' ') do Inc(i
);
607 procedure Sort (var a
: SSArray
);
608 var i
, j
: Integer; s
: string;
610 if a
= nil then Exit
;
612 for i
:= High(a
) downto Low(a
) do
613 for j
:= Low(a
) to High(a
) - 1 do
614 if LowerCase(a
[j
]) > LowerCase(a
[j
+ 1]) then
622 function g_GUI_Destroy(): Boolean;
626 Result
:= (Length(g_GUIWindows
) > 0);
628 for i
:= 0 to High(g_GUIWindows
) do
629 g_GUIWindows
[i
].Free();
632 g_ActiveWindow
:= nil;
635 function g_GUI_AddWindow(Window
: TGUIWindow
): TGUIWindow
;
637 SetLength(g_GUIWindows
, Length(g_GUIWindows
)+1);
638 g_GUIWindows
[High(g_GUIWindows
)] := Window
;
643 function g_GUI_GetWindow(Name
: string): TGUIWindow
;
649 if g_GUIWindows
<> nil then
650 for i
:= 0 to High(g_GUIWindows
) do
651 if g_GUIWindows
[i
].FName
= Name
then
653 Result
:= g_GUIWindows
[i
];
657 Assert(Result
<> nil, 'GUI_Window "'+Name
+'" not found');
660 procedure g_GUI_ShowWindow(Name
: string);
664 if g_GUIWindows
= nil then
667 for i
:= 0 to High(g_GUIWindows
) do
668 if g_GUIWindows
[i
].FName
= Name
then
670 g_GUIWindows
[i
].FPrevWindow
:= g_ActiveWindow
;
671 g_ActiveWindow
:= g_GUIWindows
[i
];
673 if g_ActiveWindow
.MainWindow
then
674 g_ActiveWindow
.FPrevWindow
:= nil;
676 if g_ActiveWindow
.FDefControl
<> '' then
677 g_ActiveWindow
.SetActive(g_ActiveWindow
.GetControl(g_ActiveWindow
.FDefControl
))
679 g_ActiveWindow
.SetActive(nil);
681 if @g_ActiveWindow
.FOnShowEvent
<> nil then
682 g_ActiveWindow
.FOnShowEvent();
688 procedure g_GUI_HideWindow(PlaySound
: Boolean = True);
690 if g_ActiveWindow
<> nil then
692 if @g_ActiveWindow
.OnClose
<> nil then
693 g_ActiveWindow
.OnClose();
694 g_ActiveWindow
:= g_ActiveWindow
.FPrevWindow
;
696 g_Sound_PlayEx(WINDOW_CLOSESOUND
);
700 procedure g_GUI_SaveMenuPos();
705 SetLength(Saved_Windows
, 0);
706 win
:= g_ActiveWindow
;
710 len
:= Length(Saved_Windows
);
711 SetLength(Saved_Windows
, len
+ 1);
713 Saved_Windows
[len
] := win
.Name
;
715 if win
.MainWindow
then
718 win
:= win
.FPrevWindow
;
722 procedure g_GUI_LoadMenuPos();
724 i
, j
, k
, len
: Integer;
727 g_ActiveWindow
:= nil;
728 len
:= Length(Saved_Windows
);
733 // Îêíî ñ ãëàâíûì ìåíþ:
734 g_GUI_ShowWindow(Saved_Windows
[len
-1]);
736 // Íå ïåðåêëþ÷èëîñü (èëè íåêóäà äàëüøå):
737 if (len
= 1) or (g_ActiveWindow
= nil) then
740 // Èùåì êíîïêè â îñòàëüíûõ îêíàõ:
741 for k
:= len
-1 downto 1 do
745 for i
:= 0 to Length(g_ActiveWindow
.Childs
)-1 do
747 if g_ActiveWindow
.Childs
[i
] is TGUIMainMenu
then
748 begin // GUI_MainMenu
749 with TGUIMainMenu(g_ActiveWindow
.Childs
[i
]) do
750 for j
:= 0 to Length(FButtons
)-1 do
751 if FButtons
[j
].ShowWindow
= Saved_Windows
[k
-1] then
753 FButtons
[j
].Click(True);
759 if g_ActiveWindow
.Childs
[i
] is TGUIMenu
then
760 with TGUIMenu(g_ActiveWindow
.Childs
[i
]) do
761 for j
:= 0 to Length(FItems
)-1 do
762 if FItems
[j
].ControlType
= TGUITextButton
then
763 if TGUITextButton(FItems
[j
].Control
).ShowWindow
= Saved_Windows
[k
-1] then
765 TGUITextButton(FItems
[j
].Control
).Click(True);
776 (g_ActiveWindow
.Name
= Saved_Windows
[k
]) then
783 constructor TGUIWindow
.Create(Name
: string);
786 FActiveControl
:= nil;
790 FOnCloseEvent
:= nil;
794 destructor TGUIWindow
.Destroy
;
801 for i
:= 0 to High(Childs
) do
805 function TGUIWindow
.AddChild(Child
: TGUIControl
): TGUIControl
;
807 Child
.FWindow
:= Self
;
809 SetLength(Childs
, Length(Childs
) + 1);
810 Childs
[High(Childs
)] := Child
;
815 procedure TGUIWindow
.Update
;
819 for i
:= 0 to High(Childs
) do
820 if Childs
[i
] <> nil then Childs
[i
].Update
;
823 procedure TGUIWindow
.OnMessage(var Msg
: TMessage
);
825 if FActiveControl
<> nil then FActiveControl
.OnMessage(Msg
);
826 if @FOnKeyDown
<> nil then FOnKeyDown(Msg
.wParam
);
827 if @FOnKeyDownEx
<> nil then FOnKeyDownEx(self
, Msg
.wParam
);
829 if Msg
.Msg
= WM_KEYDOWN
then
841 procedure TGUIWindow
.SetActive(Control
: TGUIControl
);
843 FActiveControl
:= Control
;
846 function TGUIWindow
.GetControl(Name
: String): TGUIControl
;
852 if Childs
<> nil then
853 for i
:= 0 to High(Childs
) do
854 if Childs
[i
] <> nil then
855 if LowerCase(Childs
[i
].FName
) = LowerCase(Name
) then
861 Assert(Result
<> nil, 'Window Control "'+Name
+'" not Found!');
866 constructor TGUIControl
.Create();
872 FRightAlign
:= false;
876 procedure TGUIControl
.OnMessage(var Msg
: TMessage
);
882 procedure TGUIControl
.Update();
886 function TGUIControl
.WantActivationKey (key
: LongInt): Boolean;
891 function TGUIControl
.GetWidth (): Integer;
892 {$IFDEF ENABLE_RENDER}
896 {$IFDEF ENABLE_RENDER}
897 r_GUI_GetSize(Self
, Result
, h
);
903 function TGUIControl
.GetHeight (): Integer;
904 {$IFDEF ENABLE_RENDER}
908 {$IFDEF ENABLE_RENDER}
909 r_GUI_GetSize(Self
, w
, Result
);
917 procedure TGUITextButton
.Click(Silent
: Boolean = False);
919 if (FSound
<> '') and (not Silent
) then g_Sound_PlayEx(FSound
);
921 if @Proc
<> nil then Proc();
922 if @ProcEx
<> nil then ProcEx(self
);
924 if FShowWindow
<> '' then g_GUI_ShowWindow(FShowWindow
);
927 constructor TGUITextButton
.Create(aProc
: Pointer; FontID
: DWORD
; Text: string);
934 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
939 destructor TGUITextButton
.Destroy
;
945 procedure TGUITextButton
.OnMessage(var Msg
: TMessage
);
947 if not FEnabled
then Exit
;
954 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
: Click();
959 procedure TGUITextButton
.Update
;
966 constructor TFont
.Create(FontID
: DWORD
; FontType
: TFontType
);
970 FFontType
:= FontType
;
973 destructor TFont
.Destroy
;
979 procedure TFont
.Draw(X
, Y
: Integer; Text: string; R
, G
, B
: Byte);
981 if FFontType
= TFontType
.Character
then e_CharFont_PrintEx(ID
, X
, Y
, Text, _RGB(R
, G
, B
), FScale
)
982 else e_TextureFontPrintEx(X
, Y
, Text, ID
, R
, G
, B
, FScale
);
985 procedure TFont
.GetTextSize(Text: string; var w
, h
: Word);
989 if FFontType
= TFontType
.Character
then e_CharFont_GetSize(ID
, Text, w
, h
)
992 e_TextureFontGetSize(ID
, cw
, ch
);
993 w
:= cw
*Length(Text);
997 w
:= Round(w
*FScale
);
998 h
:= Round(h
*FScale
);
1003 function TGUIMainMenu
.AddButton(fProc
: Pointer; Caption
: string; ShowWindow
: string = ''): TGUITextButton
;
1012 SetLength(FButtons
, Length(FButtons
)+1);
1013 FButtons
[High(FButtons
)] := TGUITextButton
.Create(fProc
, FFontID
, Caption
);
1014 FButtons
[High(FButtons
)].ShowWindow
:= ShowWindow
;
1015 with FButtons
[High(FButtons
)] do
1017 if (fProc
<> nil) or (ShowWindow
<> '') then FColor
:= MAINMENU_ITEMS_COLOR
1018 else FColor
:= MAINMENU_UNACTIVEITEMS_COLOR
;
1019 FSound
:= MAINMENU_CLICKSOUND
;
1022 _x
:= gScreenWidth
div 2;
1024 for a
:= 0 to High(FButtons
) do
1025 if FButtons
[a
] <> nil then
1026 _x
:= Min(_x
, (gScreenWidth
div 2)-(FButtons
[a
].GetWidth
div 2));
1028 if FHeader
= nil then
1029 r_GUI_GetLogoSize(lw
, lh
);
1030 hh
:= FButtons
[High(FButtons
)].GetHeight
;
1032 if FHeader
= nil then h
:= lh
+ hh
* (1 + Length(FButtons
)) + MAINMENU_SPACE
* (Length(FButtons
) - 1)
1033 else h
:= hh
* (2 + Length(FButtons
)) + MAINMENU_SPACE
* (Length(FButtons
) - 1);
1034 h
:= (gScreenHeight
div 2) - (h
div 2);
1036 if FHeader
<> nil then with FHeader
do
1042 if FHeader
= nil then Inc(h
, lh
)
1045 for a
:= 0 to High(FButtons
) do
1047 if FButtons
[a
] <> nil then
1054 Inc(h
, hh
+MAINMENU_SPACE
);
1057 Result
:= FButtons
[High(FButtons
)];
1060 procedure TGUIMainMenu
.AddSpace
;
1062 SetLength(FButtons
, Length(FButtons
)+1);
1063 FButtons
[High(FButtons
)] := nil;
1066 constructor TGUIMainMenu
.Create(FontID
: DWORD
; Header
: string);
1072 FCounter
:= MAINMENU_MARKERDELAY
;
1074 if Header
<> '' then
1076 FHeader
:= TGUILabel
.Create(Header
, FFontID
);
1079 FColor
:= MAINMENU_HEADER_COLOR
;
1080 FX
:= (gScreenWidth
div 2)-(GetWidth
div 2);
1081 FY
:= (gScreenHeight
div 2)-(GetHeight
div 2);
1086 destructor TGUIMainMenu
.Destroy
;
1090 if FButtons
<> nil then
1091 for a
:= 0 to High(FButtons
) do
1099 procedure TGUIMainMenu
.EnableButton(aName
: string; e
: Boolean);
1103 if FButtons
= nil then Exit
;
1105 for a
:= 0 to High(FButtons
) do
1106 if (FButtons
[a
] <> nil) and (FButtons
[a
].Name
= aName
) then
1108 if e
then FButtons
[a
].FColor
:= MAINMENU_ITEMS_COLOR
1109 else FButtons
[a
].FColor
:= MAINMENU_UNACTIVEITEMS_COLOR
;
1110 FButtons
[a
].Enabled
:= e
;
1115 function TGUIMainMenu
.GetButton(aName
: string): TGUITextButton
;
1121 if FButtons
= nil then Exit
;
1123 for a
:= 0 to High(FButtons
) do
1124 if (FButtons
[a
] <> nil) and (FButtons
[a
].Name
= aName
) then
1126 Result
:= FButtons
[a
];
1131 procedure TGUIMainMenu
.OnMessage(var Msg
: TMessage
);
1136 if not FEnabled
then Exit
;
1140 if FButtons
= nil then Exit
;
1143 for a
:= 0 to High(FButtons
) do
1144 if FButtons
[a
] <> nil then
1150 if not ok
then Exit
;
1155 IK_UP
, IK_KPUP
, VK_UP
, JOY0_UP
, JOY1_UP
, JOY2_UP
, JOY3_UP
:
1159 if FIndex
< 0 then FIndex
:= High(FButtons
);
1160 until FButtons
[FIndex
] <> nil;
1162 g_Sound_PlayEx(MENU_CHANGESOUND
);
1164 IK_DOWN
, IK_KPDOWN
, VK_DOWN
, JOY0_DOWN
, JOY1_DOWN
, JOY2_DOWN
, JOY3_DOWN
:
1168 if FIndex
> High(FButtons
) then FIndex
:= 0;
1169 until FButtons
[FIndex
] <> nil;
1171 g_Sound_PlayEx(MENU_CHANGESOUND
);
1173 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
;
1178 procedure TGUIMainMenu
.Update
;
1181 FCounter
:= (FCounter
+ 1) MOD (2 * MAINMENU_MARKERDELAY
)
1186 constructor TGUILabel
.Create(Text: string; FontID
: DWORD
);
1190 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
1194 FOnClickEvent
:= nil;
1197 procedure TGUILabel
.OnMessage(var Msg
: TMessage
);
1199 if not FEnabled
then Exit
;
1206 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
: if @FOnClickEvent
<> nil then FOnClickEvent();
1213 function TGUIMenu
.AddButton(Proc
: Pointer; fText
: string; _ShowWindow
: string = ''): TGUITextButton
;
1220 Control
:= TGUITextButton
.Create(Proc
, FFontID
, fText
);
1221 with Control
as TGUITextButton
do
1223 ShowWindow
:= _ShowWindow
;
1224 FColor
:= MENU_ITEMSCTRL_COLOR
;
1228 ControlType
:= TGUITextButton
;
1230 Result
:= (Control
as TGUITextButton
);
1233 if FIndex
= -1 then FIndex
:= i
;
1238 procedure TGUIMenu
.AddLine(fText
: string);
1245 Text := TGUILabel
.Create(fText
, FFontID
);
1248 FColor
:= MENU_ITEMSTEXT_COLOR
;
1257 procedure TGUIMenu
.AddText(fText
: string; MaxWidth
: Word);
1262 l
:= GetLines(fText
, FFontID
, MaxWidth
);
1264 if l
= nil then Exit
;
1266 for a
:= 0 to High(l
) do
1271 Text := TGUILabel
.Create(l
[a
], FFontID
);
1274 with Text do begin FColor
:= _RGB(255, 0, 0); end;
1278 with Text do begin FColor
:= MENU_ITEMSTEXT_COLOR
; end;
1288 procedure TGUIMenu
.AddSpace
;
1302 constructor TGUIMenu
.Create(HeaderFont
, ItemsFont
: DWORD
; Header
: string);
1308 FFontID
:= ItemsFont
;
1309 FCounter
:= MENU_MARKERDELAY
;
1313 FHeader
:= TGUILabel
.Create(Header
, HeaderFont
);
1316 FX
:= (gScreenWidth
div 2)-(GetWidth
div 2);
1318 FColor
:= MAINMENU_HEADER_COLOR
;
1322 destructor TGUIMenu
.Destroy
;
1326 if FItems
<> nil then
1327 for a
:= 0 to High(FItems
) do
1341 function TGUIMenu
.GetControl(aName
: String): TGUIControl
;
1347 if FItems
<> nil then
1348 for a
:= 0 to High(FItems
) do
1349 if FItems
[a
].Control
<> nil then
1350 if LowerCase(FItems
[a
].Control
.Name
) = LowerCase(aName
) then
1352 Result
:= FItems
[a
].Control
;
1356 Assert(Result
<> nil, 'GUI control "'+aName
+'" not found!');
1359 function TGUIMenu
.GetControlsText(aName
: String): TGUILabel
;
1365 if FItems
<> nil then
1366 for a
:= 0 to High(FItems
) do
1367 if FItems
[a
].Control
<> nil then
1368 if LowerCase(FItems
[a
].Control
.Name
) = LowerCase(aName
) then
1370 Result
:= FItems
[a
].Text;
1374 Assert(Result
<> nil, 'GUI control''s text "'+aName
+'" not found!');
1377 function TGUIMenu
.NewItem
: Integer;
1379 SetLength(FItems
, Length(FItems
)+1);
1380 Result
:= High(FItems
);
1383 procedure TGUIMenu
.OnMessage(var Msg
: TMessage
);
1388 if not FEnabled
then Exit
;
1392 if FItems
= nil then Exit
;
1395 for a
:= 0 to High(FItems
) do
1396 if FItems
[a
].Control
<> nil then
1402 if not ok
then Exit
;
1404 if (Msg
.Msg
= WM_KEYDOWN
) and (FIndex
<> -1) and (FItems
[FIndex
].Control
<> nil) and
1405 (FItems
[FIndex
].Control
.WantActivationKey(Msg
.wParam
)) then
1407 FItems
[FIndex
].Control
.OnMessage(Msg
);
1408 g_Sound_PlayEx(MENU_CLICKSOUND
);
1416 IK_UP
, IK_KPUP
, VK_UP
,JOY0_UP
, JOY1_UP
, JOY2_UP
, JOY3_UP
:
1421 if c
> Length(FItems
) then
1428 if FIndex
< 0 then FIndex
:= High(FItems
);
1429 until (FItems
[FIndex
].Control
<> nil) and
1430 (FItems
[FIndex
].Control
.Enabled
);
1434 g_Sound_PlayEx(MENU_CHANGESOUND
);
1437 IK_DOWN
, IK_KPDOWN
, VK_DOWN
, JOY0_DOWN
, JOY1_DOWN
, JOY2_DOWN
, JOY3_DOWN
:
1442 if c
> Length(FItems
) then
1449 if FIndex
> High(FItems
) then FIndex
:= 0;
1450 until (FItems
[FIndex
].Control
<> nil) and
1451 (FItems
[FIndex
].Control
.Enabled
);
1455 g_Sound_PlayEx(MENU_CHANGESOUND
);
1458 IK_LEFT
, IK_RIGHT
, IK_KPLEFT
, IK_KPRIGHT
, VK_LEFT
, VK_RIGHT
,
1459 JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
,
1460 JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
1462 if FIndex
<> -1 then
1463 if FItems
[FIndex
].Control
<> nil then
1464 FItems
[FIndex
].Control
.OnMessage(Msg
);
1466 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
1468 if FIndex
<> -1 then
1470 if FItems
[FIndex
].Control
<> nil then FItems
[FIndex
].Control
.OnMessage(Msg
);
1472 g_Sound_PlayEx(MENU_CLICKSOUND
);
1476 if FYesNo
and (length(FItems
) > 1) then
1478 Msg
.wParam
:= IK_RETURN
; // to register keypress
1479 FIndex
:= High(FItems
)-1;
1480 if FItems
[FIndex
].Control
<> nil then FItems
[FIndex
].Control
.OnMessage(Msg
);
1483 if FYesNo
and (length(FItems
) > 1) then
1485 Msg
.wParam
:= IK_RETURN
; // to register keypress
1486 FIndex
:= High(FItems
);
1487 if FItems
[FIndex
].Control
<> nil then FItems
[FIndex
].Control
.OnMessage(Msg
);
1494 procedure TGUIMenu
.ReAlign();
1496 a
, tx
, cx
, w
, h
: Integer;
1497 cww
: array of Integer; // cached widths
1500 if FItems
= nil then Exit
;
1502 SetLength(cww
, length(FItems
));
1504 for a
:= 0 to High(FItems
) do
1506 if FItems
[a
].Text <> nil then
1508 cww
[a
] := FItems
[a
].Text.GetWidth
;
1509 if maxcww
< cww
[a
] then maxcww
:= cww
[a
];
1520 for a
:= 0 to High(FItems
) do
1523 if FItems
[a
].Text <> nil then w
:= FItems
[a
].Text.GetWidth
;
1524 if FItems
[a
].Control
<> nil then
1527 if FItems
[a
].ControlType
= TGUILabel
then w
:= w
+(FItems
[a
].Control
as TGUILabel
).GetWidth
1528 else if FItems
[a
].ControlType
= TGUITextButton
then w
:= w
+(FItems
[a
].Control
as TGUITextButton
).GetWidth
1529 else if FItems
[a
].ControlType
= TGUIScroll
then w
:= w
+(FItems
[a
].Control
as TGUIScroll
).GetWidth
1530 else if FItems
[a
].ControlType
= TGUISwitch
then w
:= w
+(FItems
[a
].Control
as TGUISwitch
).GetWidth
1531 else if FItems
[a
].ControlType
= TGUIEdit
then w
:= w
+(FItems
[a
].Control
as TGUIEdit
).GetWidth
1532 else if FItems
[a
].ControlType
= TGUIKeyRead
then w
:= w
+(FItems
[a
].Control
as TGUIKeyRead
).GetWidth
1533 else if FItems
[a
].ControlType
= TGUIKeyRead2
then w
:= w
+(FItems
[a
].Control
as TGUIKeyRead2
).GetWidth
1534 else if FItems
[a
].ControlType
= TGUIListBox
then w
:= w
+(FItems
[a
].Control
as TGUIListBox
).GetWidth
1535 else if FItems
[a
].ControlType
= TGUIFileListBox
then w
:= w
+(FItems
[a
].Control
as TGUIFileListBox
).GetWidth
1536 else if FItems
[a
].ControlType
= TGUIMemo
then w
:= w
+(FItems
[a
].Control
as TGUIMemo
).GetWidth
;
1538 tx
:= Min(tx
, (gScreenWidth
div 2)-(w
div 2));
1543 for a
:= 0 to High(FItems
) do
1547 if (Text <> nil) and (Control
= nil) then Continue
;
1549 if Text <> nil then w
:= tx
+Text.GetWidth
;
1550 if w
> cx
then cx
:= w
;
1554 cx
:= cx
+MENU_HSPACE
;
1556 h
:= FHeader
.GetHeight
*2+MENU_VSPACE
*(Length(FItems
)-1);
1558 for a
:= 0 to High(FItems
) do
1562 if (ControlType
= TGUIListBox
) or (ControlType
= TGUIFileListBox
) then
1563 h
:= h
+(FItems
[a
].Control
as TGUIListBox
).GetHeight()
1565 h
:= h
+e_CharFont_GetMaxHeight(FFontID
);
1569 h
:= (gScreenHeight
div 2)-(h
div 2);
1573 FX
:= (gScreenWidth
div 2)-(GetWidth
div 2);
1576 Inc(h
, GetHeight
*2);
1579 for a
:= 0 to High(FItems
) do
1591 if Text.RightAlign
and (length(cww
) > a
) then
1593 //Text.FX := Text.FX+maxcww;
1594 Text.FMaxWidth
:= maxcww
;
1598 if Control
<> nil then
1615 if (ControlType
= TGUIListBox
) or (ControlType
= TGUIFileListBox
) then Inc(h
, (Control
as TGUIListBox
).GetHeight
+MENU_VSPACE
)
1616 else if ControlType
= TGUIMemo
then Inc(h
, (Control
as TGUIMemo
).GetHeight
+MENU_VSPACE
)
1617 else Inc(h
, e_CharFont_GetMaxHeight(FFontID
)+MENU_VSPACE
);
1621 // another ugly hack
1622 if FYesNo
and (length(FItems
) > 1) then
1625 for a
:= High(FItems
)-1 to High(FItems
) do
1627 if (FItems
[a
].Control
<> nil) and (FItems
[a
].ControlType
= TGUITextButton
) then
1629 cx
:= (FItems
[a
].Control
as TGUITextButton
).GetWidth
;
1630 if cx
> w
then w
:= cx
;
1635 for a
:= High(FItems
)-1 to High(FItems
) do
1637 if (FItems
[a
].Control
<> nil) and (FItems
[a
].ControlType
= TGUITextButton
) then
1639 FItems
[a
].Control
.FX
:= (gScreenWidth
-w
) div 2;
1646 function TGUIMenu
.AddScroll(fText
: string): TGUIScroll
;
1653 Control
:= TGUIScroll
.Create();
1655 Text := TGUILabel
.Create(fText
, FFontID
);
1658 FColor
:= MENU_ITEMSTEXT_COLOR
;
1661 ControlType
:= TGUIScroll
;
1663 Result
:= (Control
as TGUIScroll
);
1666 if FIndex
= -1 then FIndex
:= i
;
1671 function TGUIMenu
.AddSwitch(fText
: string): TGUISwitch
;
1678 Control
:= TGUISwitch
.Create(FFontID
);
1679 (Control
as TGUISwitch
).FColor
:= MENU_ITEMSCTRL_COLOR
;
1681 Text := TGUILabel
.Create(fText
, FFontID
);
1684 FColor
:= MENU_ITEMSTEXT_COLOR
;
1687 ControlType
:= TGUISwitch
;
1689 Result
:= (Control
as TGUISwitch
);
1692 if FIndex
= -1 then FIndex
:= i
;
1697 function TGUIMenu
.AddEdit(fText
: string): TGUIEdit
;
1704 Control
:= TGUIEdit
.Create(FFontID
);
1705 with Control
as TGUIEdit
do
1707 FWindow
:= Self
.FWindow
;
1708 FColor
:= MENU_ITEMSCTRL_COLOR
;
1711 if fText
= '' then Text := nil else
1713 Text := TGUILabel
.Create(fText
, FFontID
);
1714 Text.FColor
:= MENU_ITEMSTEXT_COLOR
;
1717 ControlType
:= TGUIEdit
;
1719 Result
:= (Control
as TGUIEdit
);
1722 if FIndex
= -1 then FIndex
:= i
;
1727 procedure TGUIMenu
.Update
;
1733 if FCounter
= 0 then FCounter
:= MENU_MARKERDELAY
else Dec(FCounter
);
1735 if FItems
<> nil then
1736 for a
:= 0 to High(FItems
) do
1737 if FItems
[a
].Control
<> nil then
1738 (FItems
[a
].Control
as FItems
[a
].ControlType
).Update
;
1741 function TGUIMenu
.AddKeyRead(fText
: string): TGUIKeyRead
;
1748 Control
:= TGUIKeyRead
.Create(FFontID
);
1749 with Control
as TGUIKeyRead
do
1751 FWindow
:= Self
.FWindow
;
1752 FColor
:= MENU_ITEMSCTRL_COLOR
;
1755 Text := TGUILabel
.Create(fText
, FFontID
);
1758 FColor
:= MENU_ITEMSTEXT_COLOR
;
1761 ControlType
:= TGUIKeyRead
;
1763 Result
:= (Control
as TGUIKeyRead
);
1766 if FIndex
= -1 then FIndex
:= i
;
1771 function TGUIMenu
.AddKeyRead2(fText
: string): TGUIKeyRead2
;
1778 Control
:= TGUIKeyRead2
.Create(FFontID
);
1779 with Control
as TGUIKeyRead2
do
1781 FWindow
:= Self
.FWindow
;
1782 FColor
:= MENU_ITEMSCTRL_COLOR
;
1785 Text := TGUILabel
.Create(fText
, FFontID
);
1788 FColor
:= MENU_ITEMSCTRL_COLOR
; //MENU_ITEMSTEXT_COLOR;
1792 ControlType
:= TGUIKeyRead2
;
1794 Result
:= (Control
as TGUIKeyRead2
);
1797 if FIndex
= -1 then FIndex
:= i
;
1802 function TGUIMenu
.AddList(fText
: string; Width
, Height
: Word): TGUIListBox
;
1809 Control
:= TGUIListBox
.Create(FFontID
, Width
, Height
);
1810 with Control
as TGUIListBox
do
1812 FWindow
:= Self
.FWindow
;
1813 FActiveColor
:= MENU_ITEMSCTRL_COLOR
;
1814 FUnActiveColor
:= MENU_ITEMSTEXT_COLOR
;
1817 Text := TGUILabel
.Create(fText
, FFontID
);
1820 FColor
:= MENU_ITEMSTEXT_COLOR
;
1823 ControlType
:= TGUIListBox
;
1825 Result
:= (Control
as TGUIListBox
);
1828 if FIndex
= -1 then FIndex
:= i
;
1833 function TGUIMenu
.AddFileList(fText
: string; Width
, Height
: Word): TGUIFileListBox
;
1840 Control
:= TGUIFileListBox
.Create(FFontID
, Width
, Height
);
1841 with Control
as TGUIFileListBox
do
1843 FWindow
:= Self
.FWindow
;
1844 FActiveColor
:= MENU_ITEMSCTRL_COLOR
;
1845 FUnActiveColor
:= MENU_ITEMSTEXT_COLOR
;
1848 if fText
= '' then Text := nil else
1850 Text := TGUILabel
.Create(fText
, FFontID
);
1851 Text.FColor
:= MENU_ITEMSTEXT_COLOR
;
1854 ControlType
:= TGUIFileListBox
;
1856 Result
:= (Control
as TGUIFileListBox
);
1859 if FIndex
= -1 then FIndex
:= i
;
1864 function TGUIMenu
.AddLabel(fText
: string): TGUILabel
;
1871 Control
:= TGUILabel
.Create('', FFontID
);
1872 with Control
as TGUILabel
do
1874 FWindow
:= Self
.FWindow
;
1875 FColor
:= MENU_ITEMSCTRL_COLOR
;
1878 Text := TGUILabel
.Create(fText
, FFontID
);
1881 FColor
:= MENU_ITEMSTEXT_COLOR
;
1884 ControlType
:= TGUILabel
;
1886 Result
:= (Control
as TGUILabel
);
1889 if FIndex
= -1 then FIndex
:= i
;
1894 function TGUIMenu
.AddMemo(fText
: string; Width
, Height
: Word): TGUIMemo
;
1901 Control
:= TGUIMemo
.Create(FFontID
, Width
, Height
);
1902 with Control
as TGUIMemo
do
1904 FWindow
:= Self
.FWindow
;
1905 FColor
:= MENU_ITEMSTEXT_COLOR
;
1908 if fText
= '' then Text := nil else
1910 Text := TGUILabel
.Create(fText
, FFontID
);
1911 Text.FColor
:= MENU_ITEMSTEXT_COLOR
;
1914 ControlType
:= TGUIMemo
;
1916 Result
:= (Control
as TGUIMemo
);
1919 if FIndex
= -1 then FIndex
:= i
;
1924 procedure TGUIMenu
.UpdateIndex();
1932 if (FIndex
< 0) or (FIndex
> High(FItems
)) then
1938 if FItems
[FIndex
].Control
.Enabled
then
1947 constructor TGUIScroll
.Create
;
1952 FOnChangeEvent
:= nil;
1955 procedure TGUIScroll
.FSetValue(a
: Integer);
1957 if a
> FMax
then FValue
:= FMax
else FValue
:= a
;
1960 procedure TGUIScroll
.OnMessage(var Msg
: TMessage
);
1962 if not FEnabled
then Exit
;
1970 IK_LEFT
, IK_KPLEFT
, VK_LEFT
, JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
:
1974 g_Sound_PlayEx(SCROLL_SUBSOUND
);
1975 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
1977 IK_RIGHT
, IK_KPRIGHT
, VK_RIGHT
, JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
1978 if FValue
< FMax
then
1981 g_Sound_PlayEx(SCROLL_ADDSOUND
);
1982 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
1989 procedure TGUIScroll
.Update
;
1997 procedure TGUISwitch
.AddItem(Item
: string);
1999 SetLength(FItems
, Length(FItems
)+1);
2000 FItems
[High(FItems
)] := Item
;
2002 if FIndex
= -1 then FIndex
:= 0;
2005 constructor TGUISwitch
.Create(FontID
: DWORD
);
2011 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
2014 function TGUISwitch
.GetText
: string;
2016 if FIndex
<> -1 then Result
:= FItems
[FIndex
]
2020 procedure TGUISwitch
.OnMessage(var Msg
: TMessage
);
2022 if not FEnabled
then Exit
;
2026 if FItems
= nil then Exit
;
2031 IK_RETURN
, IK_RIGHT
, IK_KPRETURN
, IK_KPRIGHT
, VK_FIRE
, VK_OPEN
, VK_RIGHT
,
2032 JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
,
2033 JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
2035 if FIndex
< High(FItems
) then
2040 g_Sound_PlayEx(SCROLL_ADDSOUND
);
2042 if @FOnChangeEvent
<> nil then
2043 FOnChangeEvent(Self
);
2046 IK_LEFT
, IK_KPLEFT
, VK_LEFT
,
2047 JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
:
2052 FIndex
:= High(FItems
);
2054 g_Sound_PlayEx(SCROLL_SUBSOUND
);
2056 if @FOnChangeEvent
<> nil then
2057 FOnChangeEvent(Self
);
2063 procedure TGUISwitch
.Update
;
2071 constructor TGUIEdit
.Create(FontID
: DWORD
);
2075 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
2082 procedure TGUIEdit
.OnMessage(var Msg
: TMessage
);
2084 if not FEnabled
then Exit
;
2093 if (wParam
in [48..57]) and (Chr(wParam
) <> '`') then
2094 if Length(Text) < FMaxLength
then
2096 Insert(Chr(wParam
), FText
, FCaretPos
+ 1);
2102 if (wParam
in [32..255]) and (Chr(wParam
) <> '`') then
2103 if Length(Text) < FMaxLength
then
2105 Insert(Chr(wParam
), FText
, FCaretPos
+ 1);
2113 Delete(FText
, FCaretPos
, 1);
2114 if FCaretPos
> 0 then Dec(FCaretPos
);
2116 IK_DELETE
: Delete(FText
, FCaretPos
+ 1, 1);
2117 IK_END
, IK_KPEND
: FCaretPos
:= Length(FText
);
2118 IK_HOME
, IK_KPHOME
: FCaretPos
:= 0;
2119 IK_LEFT
, IK_KPLEFT
, VK_LEFT
, JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
: if FCaretPos
> 0 then Dec(FCaretPos
);
2120 IK_RIGHT
, IK_KPRIGHT
, VK_RIGHT
, JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
: if FCaretPos
< Length(FText
) then Inc(FCaretPos
);
2121 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
2124 if FActiveControl
<> Self
then
2127 if @FOnEnterEvent
<> nil then FOnEnterEvent(Self
);
2131 if FDefControl
<> '' then SetActive(GetControl(FDefControl
))
2132 else SetActive(nil);
2133 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2139 g_GUIGrabInput
:= (@FOnEnterEvent
= nil) and (FWindow
.FActiveControl
= Self
);
2141 {$IFDEF ENABLE_TOUCH}
2142 sys_ShowKeyboard(g_GUIGrabInput
)
2146 procedure TGUIEdit
.SetText(Text: string);
2148 if Length(Text) > FMaxLength
then SetLength(Text, FMaxLength
);
2150 FCaretPos
:= Length(FText
);
2153 procedure TGUIEdit
.Update
;
2160 constructor TGUIKeyRead
.Create(FontID
: DWORD
);
2166 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
2169 function TGUIKeyRead
.WantActivationKey (key
: LongInt): Boolean;
2172 (key
= IK_BACKSPACE
) or
2176 procedure TGUIKeyRead
.OnMessage(var Msg
: TMessage
);
2177 procedure actDefCtl ();
2180 if FDefControl
<> '' then
2181 SetActive(GetControl(FDefControl
))
2189 if not FEnabled
then
2198 if FIsQuery
then actDefCtl();
2201 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
2203 if not FIsQuery
then
2206 if FActiveControl
<> Self
then
2211 else if (wParam
< VK_FIRSTKEY
) and (wParam
> VK_LASTKEY
) then
2213 // FKey := IK_ENTER; // <Enter>
2219 IK_BACKSPACE
: // clear keybinding if we aren't waiting for a key
2221 if not FIsQuery
then
2231 if not FIsQuery
and (wParam
= IK_BACKSPACE
) then
2236 else if FIsQuery
then
2239 IK_ENTER
, IK_KPRETURN
, VK_FIRSTKEY
..VK_LASTKEY (*, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK*): // Not <Enter
2241 if e_KeyNames
[wParam
] <> '' then
2250 g_GUIGrabInput
:= FIsQuery
2255 constructor TGUIKeyRead2
.Create(FontID
: DWORD
);
2268 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
2270 FMaxKeyNameWdt
:= 0;
2271 for a
:= 0 to 255 do
2273 FFont
.GetTextSize(e_KeyNames
[a
], w
, h
);
2274 FMaxKeyNameWdt
:= Max(FMaxKeyNameWdt
, w
);
2277 FMaxKeyNameWdt
:= FMaxKeyNameWdt
-(FMaxKeyNameWdt
div 3);
2279 FFont
.GetTextSize(KEYREAD_QUERY
, w
, h
);
2280 if w
> FMaxKeyNameWdt
then FMaxKeyNameWdt
:= w
;
2282 FFont
.GetTextSize(KEYREAD_CLEAR
, w
, h
);
2283 if w
> FMaxKeyNameWdt
then FMaxKeyNameWdt
:= w
;
2286 function TGUIKeyRead2
.WantActivationKey (key
: LongInt): Boolean;
2289 IK_BACKSPACE
, IK_LEFT
, IK_RIGHT
, IK_KPLEFT
, IK_KPRIGHT
, VK_LEFT
, VK_RIGHT
,
2290 JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
,
2291 JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
2298 procedure TGUIKeyRead2
.OnMessage(var Msg
: TMessage
);
2299 procedure actDefCtl ();
2302 if FDefControl
<> '' then
2303 SetActive(GetControl(FDefControl
))
2311 if not FEnabled
then
2320 if FIsQuery
then actDefCtl();
2323 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
2325 if not FIsQuery
then
2328 if FActiveControl
<> Self
then
2333 else if (wParam
< VK_FIRSTKEY
) and (wParam
> VK_LASTKEY
) then
2335 // if (FKeyIdx = 0) then FKey0 := IK_ENTER else FKey1 := IK_ENTER; // <Enter>
2336 if (FKeyIdx
= 0) then FKey0
:= wParam
else FKey1
:= wParam
;
2341 IK_BACKSPACE
: // clear keybinding if we aren't waiting for a key
2343 if not FIsQuery
then
2345 if (FKeyIdx
= 0) then FKey0
:= 0 else FKey1
:= 0;
2349 IK_LEFT
, IK_KPLEFT
, VK_LEFT
, JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
:
2350 if not FIsQuery
then
2355 IK_RIGHT
, IK_KPRIGHT
, VK_RIGHT
, JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
2356 if not FIsQuery
then
2365 if not FIsQuery
and (wParam
= IK_BACKSPACE
) then
2367 if (FKeyIdx
= 0) then FKey0
:= 0 else FKey1
:= 0;
2370 else if FIsQuery
then
2373 IK_ENTER
, IK_KPRETURN
, VK_FIRSTKEY
..VK_LASTKEY (*, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK*): // Not <Enter
2375 if e_KeyNames
[wParam
] <> '' then
2377 if (FKeyIdx
= 0) then FKey0
:= wParam
else FKey1
:= wParam
;
2386 g_GUIGrabInput
:= FIsQuery
2392 constructor TGUIModelView
.Create
;
2399 destructor TGUIModelView
.Destroy
;
2406 procedure TGUIModelView
.NextAnim();
2408 if FModel
= nil then
2411 if FModel
.Animation
< A_PAIN
then
2412 FModel
.ChangeAnimation(FModel
.Animation
+1, True)
2414 FModel
.ChangeAnimation(A_STAND
, True);
2417 procedure TGUIModelView
.NextWeapon();
2419 if FModel
= nil then
2422 if FModel
.Weapon
< WP_LAST
then
2423 FModel
.SetWeapon(FModel
.Weapon
+1)
2425 FModel
.SetWeapon(WEAPON_KASTET
);
2428 procedure TGUIModelView
.OnMessage(var Msg
: TMessage
);
2434 procedure TGUIModelView
.SetColor(Red
, Green
, Blue
: Byte);
2436 if FModel
<> nil then FModel
.SetColor(Red
, Green
, Blue
);
2439 procedure TGUIModelView
.SetModel(ModelName
: string);
2443 FModel
:= g_PlayerModel_Get(ModelName
);
2446 procedure TGUIModelView
.Update
;
2453 if FModel
<> nil then FModel
.Update
;
2458 constructor TGUIMapPreview
.Create();
2464 destructor TGUIMapPreview
.Destroy();
2470 procedure TGUIMapPreview
.OnMessage(var Msg
: TMessage
);
2476 procedure TGUIMapPreview
.SetMap(Res
: string);
2481 //header: TMapHeaderRec_1;
2486 map
: TDynRecord
= nil;
2493 FileName
:= g_ExtractWadName(Res
);
2495 WAD
:= TWADFile
.Create();
2496 if not WAD
.ReadFile(FileName
) then
2502 //k8: ignores path again
2503 if not WAD
.GetMapResource(g_ExtractFileName(Res
), Data
, Len
) then
2512 map
:= g_Map_ParseMap(Data
, Len
);
2522 if (map
= nil) then exit
;
2525 panlist
:= map
.field
['panel'];
2526 //header := GetMapHeader(map);
2528 FMapSize
.X
:= map
.Width
div 16;
2529 FMapSize
.Y
:= map
.Height
div 16;
2531 rX
:= Ceil(map
.Width
/ (MAPPREVIEW_WIDTH
*256.0));
2532 rY
:= Ceil(map
.Height
/ (MAPPREVIEW_HEIGHT
*256.0));
2533 FScale
:= max(rX
, rY
);
2537 if (panlist
<> nil) then
2539 for pan
in panlist
do
2541 if (pan
.PanelType
and (PANEL_WALL
or PANEL_CLOSEDOOR
or
2542 PANEL_STEP
or PANEL_WATER
or
2543 PANEL_ACID1
or PANEL_ACID2
)) <> 0 then
2545 SetLength(FMapData
, Length(FMapData
)+1);
2546 with FMapData
[High(FMapData
)] do
2551 X2
:= (pan
.X
+ pan
.Width
) div 16;
2552 Y2
:= (pan
.Y
+ pan
.Height
) div 16;
2554 X1
:= Trunc(X1
/FScale
+ 0.5);
2555 Y1
:= Trunc(Y1
/FScale
+ 0.5);
2556 X2
:= Trunc(X2
/FScale
+ 0.5);
2557 Y2
:= Trunc(Y2
/FScale
+ 0.5);
2559 if (X1
<> X2
) or (Y1
<> Y2
) then
2567 PanelType
:= pan
.PanelType
;
2573 //writeln('freeing map');
2578 procedure TGUIMapPreview
.ClearMap();
2580 SetLength(FMapData
, 0);
2587 procedure TGUIMapPreview
.Update();
2593 function TGUIMapPreview
.GetScaleStr(): String;
2595 if FScale
> 0.0 then
2597 Result
:= FloatToStrF(FScale
*16.0, ffFixed
, 3, 3);
2598 while (Result
[Length(Result
)] = '0') do
2599 Delete(Result
, Length(Result
), 1);
2600 if (Result
[Length(Result
)] = ',') or (Result
[Length(Result
)] = '.') then
2601 Delete(Result
, Length(Result
), 1);
2602 Result
:= '1 : ' + Result
;
2610 procedure TGUIListBox
.AddItem(Item
: string);
2612 SetLength(FItems
, Length(FItems
)+1);
2613 FItems
[High(FItems
)] := Item
;
2615 if FSort
then g_gui
.Sort(FItems
);
2618 function TGUIListBox
.ItemExists (item
: String): Boolean;
2622 while (i
<= High(FItems
)) and (FItems
[i
] <> item
) do Inc(i
);
2623 result
:= i
<= High(FItems
)
2626 procedure TGUIListBox
.Clear
;
2634 constructor TGUIListBox
.Create(FontID
: DWORD
; Width
, Height
: Word);
2638 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
2643 FOnChangeEvent
:= nil;
2645 FDrawScroll
:= True;
2648 procedure TGUIListBox
.OnMessage(var Msg
: TMessage
);
2652 if not FEnabled
then Exit
;
2656 if FItems
= nil then Exit
;
2669 FIndex
:= High(FItems
);
2670 FStartLine
:= Max(High(FItems
)-FHeight
+1, 0);
2672 IK_UP
, IK_LEFT
, IK_KPUP
, IK_KPLEFT
, VK_LEFT
, JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
:
2676 if FIndex
< FStartLine
then Dec(FStartLine
);
2677 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2679 IK_DOWN
, IK_RIGHT
, IK_KPDOWN
, IK_KPRIGHT
, VK_RIGHT
, JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
2680 if FIndex
< High(FItems
) then
2683 if FIndex
> FStartLine
+FHeight
-1 then Inc(FStartLine
);
2684 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2686 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
2689 if FActiveControl
<> Self
then SetActive(Self
)
2691 if FDefControl
<> '' then SetActive(GetControl(FDefControl
))
2692 else SetActive(nil);
2696 for a
:= 0 to High(FItems
) do
2697 if (Length(FItems
[a
]) > 0) and (LowerCase(FItems
[a
][1]) = LowerCase(Chr(wParam
))) then
2700 FStartLine
:= Min(Max(FIndex
-1, 0), Length(FItems
)-FHeight
);
2701 if @FOnChangeEvent
<> nil then FOnChangeEvent(Self
);
2707 function TGUIListBox
.SelectedItem(): String;
2711 if (FIndex
< 0) or (FItems
= nil) or
2712 (FIndex
> High(FItems
)) then
2715 Result
:= FItems
[FIndex
];
2718 procedure TGUIListBox
.FSetItems(Items
: SSArray
);
2720 if FItems
<> nil then
2728 if FSort
then g_gui
.Sort(FItems
);
2731 procedure TGUIListBox
.SelectItem(Item
: String);
2735 if FItems
= nil then
2739 Item
:= LowerCase(Item
);
2741 for a
:= 0 to High(FItems
) do
2742 if LowerCase(FItems
[a
]) = Item
then
2748 if FIndex
< FHeight
then
2751 FStartLine
:= Min(FIndex
, Length(FItems
)-FHeight
);
2754 procedure TGUIListBox
.FSetIndex(aIndex
: Integer);
2756 if FItems
= nil then
2759 if (aIndex
< 0) or (aIndex
> High(FItems
)) then
2764 if FIndex
<= FHeight
then
2767 FStartLine
:= Min(FIndex
, Length(FItems
)-FHeight
);
2772 procedure TGUIFileListBox
.OnMessage(var Msg
: TMessage
);
2774 a
, b
: Integer; s
: AnsiString;
2776 if not FEnabled
then
2779 if FItems
= nil then
2790 if @FOnChangeEvent
<> nil then
2791 FOnChangeEvent(Self
);
2796 FIndex
:= High(FItems
);
2797 FStartLine
:= Max(High(FItems
)-FHeight
+1, 0);
2798 if @FOnChangeEvent
<> nil then
2799 FOnChangeEvent(Self
);
2802 IK_PAGEUP
, IK_KPPAGEUP
:
2804 if FIndex
> FHeight
then
2805 FIndex
:= FIndex
-FHeight
2809 if FStartLine
> FHeight
then
2810 FStartLine
:= FStartLine
-FHeight
2815 IK_PAGEDN
, IK_KPPAGEDN
:
2817 if FIndex
< High(FItems
)-FHeight
then
2818 FIndex
:= FIndex
+FHeight
2820 FIndex
:= High(FItems
);
2822 if FStartLine
< High(FItems
)-FHeight
then
2823 FStartLine
:= FStartLine
+FHeight
2825 FStartLine
:= High(FItems
)-FHeight
+1;
2828 IK_UP
, IK_LEFT
, IK_KPUP
, IK_KPLEFT
, VK_UP
, VK_LEFT
, JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
:
2832 if FIndex
< FStartLine
then
2834 if @FOnChangeEvent
<> nil then
2835 FOnChangeEvent(Self
);
2838 IK_DOWN
, IK_RIGHT
, IK_KPDOWN
, IK_KPRIGHT
, VK_DOWN
, VK_RIGHT
, JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
2839 if FIndex
< High(FItems
) then
2842 if FIndex
> FStartLine
+FHeight
-1 then
2844 if @FOnChangeEvent
<> nil then
2845 FOnChangeEvent(Self
);
2848 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
2851 if FActiveControl
<> Self
then
2855 if FItems
[FIndex
][1] = #29 then // Ïàïêà
2857 if FItems
[FIndex
] = #29 + '..' then
2859 e_LogWritefln('TGUIFileListBox: Upper dir "%s" -> "%s"', [FSubPath
, e_UpperDir(FSubPath
)]);
2860 FSubPath
:= e_UpperDir(FSubPath
)
2864 s
:= Copy(AnsiString(FItems
[FIndex
]), 2);
2865 e_LogWritefln('TGUIFileListBox: Enter dir "%s" -> "%s"', [FSubPath
, e_CatPath(FSubPath
, s
)]);
2866 FSubPath
:= e_CatPath(FSubPath
, s
);
2873 if FDefControl
<> '' then
2874 SetActive(GetControl(FDefControl
))
2882 for b
:= FIndex
+ 1 to High(FItems
) + FIndex
do
2884 a
:= b
mod Length(FItems
);
2885 if ( (Length(FItems
[a
]) > 0) and
2886 (LowerCase(FItems
[a
][1]) = LowerCase(Chr(wParam
))) ) or
2887 ( (Length(FItems
[a
]) > 1) and
2888 (FItems
[a
][1] = #29) and // Ïàïêà
2889 (LowerCase(FItems
[a
][2]) = LowerCase(Chr(wParam
))) ) then
2892 FStartLine
:= Min(Max(FIndex
-1, 0), Length(FItems
)-FHeight
);
2893 if @FOnChangeEvent
<> nil then
2894 FOnChangeEvent(Self
);
2901 procedure TGUIFileListBox
.ScanDirs
;
2902 var i
, j
: Integer; path
: AnsiString; SR
: TSearchRec
; sm
, sc
: String;
2906 i
:= High(FBaseList
);
2909 path
:= e_CatPath(FBaseList
[i
], FSubPath
);
2912 if FindFirst(path
+ '/' + '*', faDirectory
, SR
) = 0 then
2915 if LongBool(SR
.Attr
and faDirectory
) then
2916 if (SR
.Name
<> '.') and ((FSubPath
<> '') or (SR
.Name
<> '..')) then
2917 if Self
.ItemExists(#1 + SR
.Name
) = false then
2918 Self
.AddItem(#1 + SR
.Name
)
2919 until FindNext(SR
) <> 0
2926 i
:= High(FBaseList
);
2929 path
:= e_CatPath(FBaseList
[i
], FSubPath
);
2935 j
:= length(sm
) + 1;
2936 sc
:= Copy(sm
, 1, j
- 1);
2938 if FindFirst(path
+ '/' + sc
, faAnyFile
, SR
) = 0 then
2941 if Self
.ItemExists(SR
.Name
) = false then
2943 until FindNext(SR
) <> 0
2950 for i
:= 0 to High(FItems
) do
2951 if FItems
[i
][1] = #1 then
2952 FItems
[i
][1] := #29;
2955 procedure TGUIFileListBox
.SetBase (dirs
: SSArray
; path
: String = '');
2962 function TGUIFileListBox
.SelectedItem (): String;
2966 if (FIndex
>= 0) and (FIndex
<= High(FItems
)) and (FItems
[FIndex
][1] <> '/') and (FItems
[FIndex
][1] <> '\') then
2968 s
:= e_CatPath(FSubPath
, FItems
[FIndex
]);
2969 if e_FindResource(FBaseList
, s
) = true then
2970 result
:= ExpandFileName(s
)
2972 e_LogWritefln('TGUIFileListBox.SelectedItem -> "%s"', [result
]);
2975 procedure TGUIFileListBox
.UpdateFileList();
2979 if (FIndex
= -1) or (FItems
= nil) or
2980 (FIndex
> High(FItems
)) or
2981 (FItems
[FIndex
][1] = '/') or
2982 (FItems
[FIndex
][1] = '\') then
2985 fn
:= FItems
[FIndex
];
2996 procedure TGUIMemo
.Clear
;
3002 constructor TGUIMemo
.Create(FontID
: DWORD
; Width
, Height
: Word);
3006 FFont
:= TFont
.Create(FontID
, TFontType
.Character
);
3011 FDrawScroll
:= True;
3014 procedure TGUIMemo
.OnMessage(var Msg
: TMessage
);
3016 if not FEnabled
then Exit
;
3020 if FLines
= nil then Exit
;
3026 IK_UP
, IK_LEFT
, IK_KPUP
, IK_KPLEFT
, VK_UP
, VK_LEFT
, JOY0_LEFT
, JOY1_LEFT
, JOY2_LEFT
, JOY3_LEFT
:
3027 if FStartLine
> 0 then
3029 IK_DOWN
, IK_RIGHT
, IK_KPDOWN
, IK_KPRIGHT
, VK_DOWN
, VK_RIGHT
, JOY0_RIGHT
, JOY1_RIGHT
, JOY2_RIGHT
, JOY3_RIGHT
:
3030 if FStartLine
< Length(FLines
)-FHeight
then
3032 IK_RETURN
, IK_KPRETURN
, VK_FIRE
, VK_OPEN
, JOY0_ATTACK
, JOY1_ATTACK
, JOY2_ATTACK
, JOY3_ATTACK
:
3035 if FActiveControl
<> Self
then
3041 if FDefControl
<> '' then SetActive(GetControl(FDefControl
))
3042 else SetActive(nil);
3048 procedure TGUIMemo
.SetText(Text: string);
3051 FLines
:= GetLines(Text, FFont
.ID
, FWidth
*16);
3056 procedure TGUIimage
.ClearImage();
3058 if FImageRes
= '' then Exit
;
3060 g_Texture_Delete(FImageRes
);
3064 constructor TGUIimage
.Create();
3071 destructor TGUIimage
.Destroy();
3076 procedure TGUIimage
.OnMessage(var Msg
: TMessage
);
3081 procedure TGUIimage
.SetImage(Res
: string);
3085 if g_Texture_CreateWADEx(Res
, Res
) then FImageRes
:= Res
;
3088 procedure TGUIimage
.Update();