diff --git a/src/editor/f_main.pas b/src/editor/f_main.pas
index a87747362f596fca53cb69bac2bb2c58b5b59b29..ef9e19d2ee9c59c7ffd0bdeae5e12aedfa9221cc 100644 (file)
--- a/src/editor/f_main.pas
+++ b/src/editor/f_main.pas
LCLIntf, LCLType, LMessages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, ImgList, StdCtrls, Buttons,
ComCtrls, ValEdit, Types, ToolWin, Menus, ExtCtrls,
LCLIntf, LCLType, LMessages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, ImgList, StdCtrls, Buttons,
ComCtrls, ValEdit, Types, ToolWin, Menus, ExtCtrls,
- CheckLst, Grids, OpenGLContext, utils;
+ CheckLst, Grids, OpenGLContext, utils, UTF8Process;
type
type
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormResize(Sender: TObject);
procedure lbTextureListClick(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormResize(Sender: TObject);
procedure lbTextureListClick(Sender: TObject);
+ procedure lbTextureListDrawItem(Control: TWinControl; Index: Integer;
+ ARect: TRect; State: TOwnerDrawState);
procedure RenderPanelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure RenderPanelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure RenderPanelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure RenderPanelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure RenderPanelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure RenderPanelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure OnIdle(Sender: TObject; var Done: Boolean);
public
procedure RefreshRecentMenu();
procedure OnIdle(Sender: TObject; var Done: Boolean);
public
procedure RefreshRecentMenu();
- { procedure lbTextureListDrawItem(Control: TWinControl; Index: Integer;
- Rect: TRect; State: TOwnerDrawState); }
end;
const
end;
const
else
begin // Внешний WAD
FileName := EditorDir+'wads/'+aWAD;
else
begin // Внешний WAD
FileName := EditorDir+'wads/'+aWAD;
- ResourceName := aWAD+':'+SectionName+'\'+aTex;
+ ResourceName := utf2win(aWAD)+':'+SectionName+'\'+aTex;
end;
ok := True;
end;
ok := True;
lbTextureList.Sorted := True;
lbTextureList.Sorted := False;
lbTextureList.Sorted := True;
lbTextureList.Sorted := False;
- UpdateCaption(gMapInfo.Name, ExtractFileName(FileName), MapName);
+ UpdateCaption(win2utf(gMapInfo.Name), ExtractFileName(FileName), MapName);
end;
end;
end;
end;
var
n, pw: Integer;
s, fn: String;
var
n, pw: Integer;
s, fn: String;
+ b: Boolean;
begin
s := LowerCase((Sender as TMenuItem).Caption);
Delete(s, Pos('&', s), 1);
begin
s := LowerCase((Sender as TMenuItem).Caption);
Delete(s, Pos('&', s), 1);
s := RecentFiles[n];
pw := Pos('.wad:\', LowerCase(s));
s := RecentFiles[n];
pw := Pos('.wad:\', LowerCase(s));
+ b := False;
if pw > 0 then
begin // Map name included
fn := Copy(s, 1, pw + 3);
Delete(s, 1, pw + 5);
if (FileExists(fn)) then
if pw > 0 then
begin // Map name included
fn := Copy(s, 1, pw + 3);
Delete(s, 1, pw + 5);
if (FileExists(fn)) then
+ begin
OpenMap(fn, s);
OpenMap(fn, s);
+ b := True;
+ end;
end
else // Only wad name
if (FileExists(s)) then
end
else // Only wad name
if (FileExists(s)) then
+ begin
OpenMap(s, '');
OpenMap(s, '');
+ b := True;
+ end;
+
+ if (not b) and (MessageBox(0, PChar(_lc[I_MSG_DEL_RECENT_PROMT]),
+ PChar(_lc[I_MSG_DEL_RECENT]), MB_ICONQUESTION or MB_YESNO) = idYes) then
+ begin
+ RecentFiles.Delete(n);
+ RefreshRecentMenu();
+ end;
end;
procedure TMainForm.aEditorOptionsExecute(Sender: TObject);
end;
procedure TMainForm.aEditorOptionsExecute(Sender: TObject);
begin
config := TConfig.CreateFile(EditorDir+'Editor.cfg');
begin
config := TConfig.CreateFile(EditorDir+'Editor.cfg');
- config.WriteInt('Editor', 'XPos', Left);
- config.WriteInt('Editor', 'YPos', Top);
- config.WriteInt('Editor', 'Width', Width);
- config.WriteInt('Editor', 'Height', Height);
+ if WindowState <> wsMaximized then
+ begin
+ config.WriteInt('Editor', 'XPos', Left);
+ config.WriteInt('Editor', 'YPos', Top);
+ config.WriteInt('Editor', 'Width', Width);
+ config.WriteInt('Editor', 'Height', Height);
+ end
+ else
+ begin
+ config.WriteInt('Editor', 'XPos', RestoredLeft);
+ config.WriteInt('Editor', 'YPos', RestoredTop);
+ config.WriteInt('Editor', 'Width', RestoredWidth);
+ config.WriteInt('Editor', 'Height', RestoredHeight);
+ end;
config.WriteBool('Editor', 'Maximize', WindowState = wsMaximized);
config.WriteBool('Editor', 'Minimap', ShowMap);
config.WriteInt('Editor', 'PanelProps', PanelProps.ClientWidth);
config.WriteBool('Editor', 'Maximize', WindowState = wsMaximized);
config.WriteBool('Editor', 'Minimap', ShowMap);
config.WriteInt('Editor', 'PanelProps', PanelProps.ClientWidth);
while (Pos(':\', ResName) > 0) do
Delete(ResName, 1, Pos(':\', ResName) + 1);
while (Pos(':\', ResName) > 0) do
Delete(ResName, 1, Pos(':\', ResName) + 1);
- UpdateCaption(gMapInfo.Name, ExtractFileName(OpenedWAD), ResName);
+ UpdateCaption(win2utf(gMapInfo.Name), ExtractFileName(OpenedWAD), ResName);
end;
procedure TMainForm.aAboutExecute(Sender: TObject);
end;
procedure TMainForm.aAboutExecute(Sender: TObject);
end;
end;
end;
end;
+procedure TMainForm.lbTextureListDrawItem(Control: TWinControl; Index: Integer;
+ ARect: TRect; State: TOwnerDrawState);
+begin
+ with Control as TListBox do
+ begin
+ if LCLType.odSelected in State then
+ begin
+ Canvas.Brush.Color := clHighlight;
+ Canvas.Font.Color := clHighlightText;
+ end else
+ if (Items <> nil) and (Index >= 0) then
+ if slInvalidTextures.IndexOf(Items[Index]) > -1 then
+ begin
+ Canvas.Brush.Color := clRed;
+ Canvas.Font.Color := clWhite;
+ end;
+ Canvas.FillRect(ARect);
+ Canvas.TextRect(ARect, ARect.Left, ARect.Top, Items[Index]);
+ end;
+end;
+
procedure TMainForm.vleObjectPropertyGetPickList(Sender: TObject;
const KeyName: String; Values: TStrings);
begin
procedure TMainForm.vleObjectPropertyGetPickList(Sender: TObject;
const KeyName: String; Values: TStrings);
begin
gMapInfo.FileName := SaveDialog.FileName;
gMapInfo.MapName := SaveMapForm.eMapName.Text;
gMapInfo.FileName := SaveDialog.FileName;
gMapInfo.MapName := SaveMapForm.eMapName.Text;
- UpdateCaption(gMapInfo.Name, ExtractFileName(gMapInfo.FileName), gMapInfo.MapName);
+ UpdateCaption(win2utf(gMapInfo.Name), ExtractFileName(gMapInfo.FileName), gMapInfo.MapName);
end;
procedure TMainForm.aSelectAllExecute(Sender: TObject);
end;
procedure TMainForm.aSelectAllExecute(Sender: TObject);
procedure TMainForm.miTestMapClick(Sender: TObject);
var
procedure TMainForm.miTestMapClick(Sender: TObject);
var
- cmd, mapWAD, mapToRun: String;
+ cmd, mapWAD, mapToRun, tempWAD: String;
opt: LongWord;
time: Integer;
opt: LongWord;
time: Integer;
- lpMsgBuf: PChar;
+ proc: TProcessUTF8;
+ res: Boolean;
begin
begin
+ mapToRun := '';
+ if OpenedMap <> '' then
+ begin
+ // Указываем текущую карту для теста:
+ g_ProcessResourceStr(OpenedMap, @mapWAD, nil, @mapToRun);
+ mapToRun := mapWAD + ':\' + mapToRun;
+ mapToRun := ExtractRelativePath(ExtractFilePath(TestD2dExe) + 'maps/', mapToRun);
+ end;
// Сохраняем временную карту:
time := 0;
repeat
mapWAD := ExtractFilePath(TestD2dExe) + Format('maps/temp%.4d.wad', [time]);
Inc(time);
until not FileExists(mapWAD);
// Сохраняем временную карту:
time := 0;
repeat
mapWAD := ExtractFilePath(TestD2dExe) + Format('maps/temp%.4d.wad', [time]);
Inc(time);
until not FileExists(mapWAD);
- mapToRun := mapWAD + ':\' + TEST_MAP_NAME;
- SaveMap(mapToRun);
+ tempWAD := mapWAD + ':\' + TEST_MAP_NAME;
+ SaveMap(tempWAD);
- mapToRun := ExtractRelativePath(ExtractFilePath(TestD2dExe) + 'maps/', mapToRun);
+ tempWAD := ExtractRelativePath(ExtractFilePath(TestD2dExe) + 'maps/', tempWAD);
+// Если карта не была открыта, указываем временную в качестве текущей:
+ if mapToRun = '' then
+ mapToRun := tempWAD;
// Опции игры:
opt := 32 + 64;
// Опции игры:
opt := 32 + 64;
opt := opt + 16;
// Составляем командную строку:
opt := opt + 16;
// Составляем командную строку:
- cmd := ' -map "' + mapToRun + '"';
+ cmd := '-map "' + mapToRun + '"';
+ cmd := cmd + ' -testmap "' + tempWAD + '"';
cmd := cmd + ' -gm ' + TestGameMode;
cmd := cmd + ' -limt ' + TestLimTime;
cmd := cmd + ' -lims ' + TestLimScore;
cmd := cmd + ' -gm ' + TestGameMode;
cmd := cmd + ' -limt ' + TestLimTime;
cmd := cmd + ' -lims ' + TestLimScore;
cmd := cmd + ' --close';
cmd := cmd + ' --debug';
cmd := cmd + ' --close';
cmd := cmd + ' --debug';
- cmd := cmd + ' --tempdelete';
// Запускаем:
// Запускаем:
- Application.Minimize();
- if ExecuteProcess(TestD2dExe, cmd) < 0 then
+ proc := TProcessUTF8.Create(nil);
+ proc.Executable := TestD2dExe;
+ proc.Parameters.Add(cmd);
+ res := True;
+ try
+ proc.Execute();
+ except
+ res := False;
+ end;
+ if res then
+ begin
+ Application.Minimize();
+ proc.WaitOnExit();
+ end;
+ if (not res) or (proc.ExitCode < 0) then
begin
MessageBox(0, 'FIXME',
PChar(_lc[I_MSG_EXEC_ERROR]),
MB_OK or MB_ICONERROR);
end;
begin
MessageBox(0, 'FIXME',
PChar(_lc[I_MSG_EXEC_ERROR]),
MB_OK or MB_ICONERROR);
end;
+ proc.Free();
SysUtils.DeleteFile(mapWAD);
Application.Restore();
SysUtils.DeleteFile(mapWAD);
Application.Restore();
end;
end;
end;
end;
-{
-procedure TMainForm.lbTextureListDrawItem(Control: TWinControl; Index: Integer;
- Rect: TRect; State: LCLType.TOwnerDrawState);
-begin
- with Control as TListBox do
- begin
- if LCLType.odSelected in State then
- begin
- Canvas.Brush.Color := clHighlight;
- Canvas.Font.Color := clHighlightText;
- end else
- if (Items <> nil) and (Index >= 0) then
- if slInvalidTextures.IndexOf(Items[Index]) > -1 then
- begin
- Canvas.Brush.Color := clRed;
- Canvas.Font.Color := clWhite;
- end;
- Canvas.FillRect(Rect);
- Canvas.TextRect(Rect, Rect.Left, Rect.Top, Items[Index]);
- end;
-end;
-}
end.
end.