X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Feditor%2Ff_main.pas;h=ef9e19d2ee9c59c7ffd0bdeae5e12aedfa9221cc;hb=71ef827e8608f2e426111ff0ddfb7019beba0e65;hp=8fd1fa3372b6a4e87fe52580603a0f3a82def031;hpb=6f0e2f411ed57b45f4665c44d89d3c5e6d890a9a;p=d2df-editor.git diff --git a/src/editor/f_main.pas b/src/editor/f_main.pas index 8fd1fa3..ef9e19d 100644 --- a/src/editor/f_main.pas +++ b/src/editor/f_main.pas @@ -8,7 +8,7 @@ uses 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 @@ -207,6 +207,8 @@ type 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); @@ -258,8 +260,6 @@ type procedure OnIdle(Sender: TObject; var Done: Boolean); public procedure RefreshRecentMenu(); - { procedure lbTextureListDrawItem(Control: TWinControl; Index: Integer; - Rect: TRect; State: TOwnerDrawState); } end; const @@ -1795,6 +1795,7 @@ procedure FullClear(); begin RemoveSelectFromObjects(); ClearMap(); + LoadSky(gMapInfo.SkyName); UndoBuffer := nil; slInvalidTextures.Clear(); MapCheckForm.lbErrorList.Clear(); @@ -1908,7 +1909,7 @@ begin else begin // Внешний WAD FileName := EditorDir+'wads/'+aWAD; - ResourceName := aWAD+':'+SectionName+'\'+aTex; + ResourceName := utf2win(aWAD)+':'+SectionName+'\'+aTex; end; ok := True; @@ -2046,7 +2047,7 @@ begin lbTextureList.Sorted := True; lbTextureList.Sorted := False; - UpdateCaption(gMapInfo.Name, ExtractFileName(FileName), MapName); + UpdateCaption(win2utf(gMapInfo.Name), ExtractFileName(FileName), MapName); end; end; @@ -2500,6 +2501,7 @@ procedure TMainForm.aRecentFileExecute(Sender: TObject); var n, pw: Integer; s, fn: String; + b: Boolean; begin s := LowerCase((Sender as TMenuItem).Caption); Delete(s, Pos('&', s), 1); @@ -2511,17 +2513,31 @@ begin 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 + begin OpenMap(fn, s); + b := True; + end; end else // Only wad name if (FileExists(s)) then + begin 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); @@ -4032,10 +4048,20 @@ var 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); @@ -4079,7 +4105,7 @@ begin 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); @@ -4366,6 +4392,27 @@ begin 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 @@ -6018,7 +6065,7 @@ begin 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); @@ -6107,6 +6154,8 @@ begin PreviewMode := not PreviewMode; (Sender as TMenuItem).Checked := PreviewMode; + + FormResize(Self); end; procedure TMainForm.miLayer1Click(Sender: TObject); @@ -6239,21 +6288,33 @@ end; procedure TMainForm.miTestMapClick(Sender: TObject); var - cmd, mapWAD, mapToRun: String; + cmd, mapWAD, mapToRun, tempWAD: String; opt: LongWord; time: Integer; - lpMsgBuf: PChar; + proc: TProcessUTF8; + res: Boolean; 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); - 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; @@ -6269,7 +6330,8 @@ begin 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; @@ -6279,16 +6341,29 @@ begin 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; + proc.Free(); SysUtils.DeleteFile(mapWAD); Application.Restore(); @@ -6383,26 +6458,4 @@ begin 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.