diff --git a/src/editor/f_main.pas b/src/editor/f_main.pas
index 8fd1fa3372b6a4e87fe52580603a0f3a82def031..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
begin
RemoveSelectFromObjects();
ClearMap();
begin
RemoveSelectFromObjects();
ClearMap();
+ LoadSky(gMapInfo.SkyName);
UndoBuffer := nil;
slInvalidTextures.Clear();
MapCheckForm.lbErrorList.Clear();
UndoBuffer := nil;
slInvalidTextures.Clear();
MapCheckForm.lbErrorList.Clear();
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);
PreviewMode := not PreviewMode;
(Sender as TMenuItem).Checked := PreviewMode;
PreviewMode := not PreviewMode;
(Sender as TMenuItem).Checked := PreviewMode;
+
+ FormResize(Self);
end;
procedure TMainForm.miLayer1Click(Sender: TObject);
end;
procedure TMainForm.miLayer1Click(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.