paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-04 09:39:43 +01:00
Code Issues Packages Projects Releases Wiki Activity

IDE: fixed writing project ico, verbosity for failed resource generate

Browse Source 
git-svn-id: trunk@37948 -
This commit is contained in:
mattias 2012-07-15 10:13:43 +00:00
parent 86e27ff8a7
commit 8d2d0b8f96
3 changed files with 28 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
ide/main.pp
View File

@ -12301,7 +12301,7 @@ begin
if not Project1.ProjResources.Regenerate(Project1.MainFilename, False, True, TargetExeDirectory)
then begin
debugln(['TMainIDE.DoBuildProject Project1.ProjResources.Regenerate failed']);
debugln(['TMainIDE.DoBuildProject ProjResources.Regenerate failed']);
exit;
end;
@ -12314,7 +12314,7 @@ begin
Project1.ProjectDirectory,lisExecutingCommandBefore);
if Result<>mrOk then
begin
debugln(['TMainIDE.DoBuildProject Project1.CompilerOptions.ExecuteBefore.Execute failed']);
debugln(['TMainIDE.DoBuildProject CompilerOptions.ExecuteBefore.Execute failed']);
CompileProgress.Ready(lisInfoBuildError);
exit;
end;

24
ide/projecticon.pas
View File

@ -127,20 +127,10 @@ begin
SetFileNames(MainFilename);
if FilenameIsAbsolute(FIcoFileName) then
if not CreateIconFile then
if not CreateIconFile then begin
debugln(['TProjectIcon.UpdateResources CreateIconFile "'+FIcoFileName+'" failed']);
exit(false);
{ to create an lrs with icon we can use this but there is no reason anymore
if AResources.ResourceType <> rtRes then
begin
AResource := GetStream;
try
AResources.AddLazarusResource(AResource, 'MAINICON', 'ICO');
finally
AResource.Free;
end;
end;
}
AName := TResourceDesc.Create('MAINICON');
ARes := TGroupIconResource.Create(nil, AName); //type is always RT_GROUP_ICON
@ -153,7 +143,7 @@ begin
ItemStream:=ARes.ItemData;
except
on E: Exception do begin
DebugLn(['TProjectIcon.UpdateResources bug in fcl: ',E.Message]);
DebugLn(['TProjectIcon.UpdateResources ignoring bug in fcl: ',E.Message]);
end;
end;
if ItemStream<>nil then
@ -188,13 +178,19 @@ begin
Result := False;
if IsEmpty then exit;
try
fs:=TFileStreamUTF8.Create(FIcoFileName,fmCreate or fmOpenReadWrite);
if FileExistsUTF8(FIcoFileName) then
fs:=TFileStreamUTF8.Create(FIcoFileName,fmOpenWrite)
else
fs:=TFileStreamUTF8.Create(FIcoFileName,fmCreate);
try
fs.Write(FData[0],length(FData));
Result:=true;
finally
fs.Free;
end;
except
on E: Exception do
debugln(['TProjectIcon.CreateIconFile "'+FIcoFileName+'": '+E.Message]);
end;
end;

22
ide/projectresources.pas
View File

@ -368,14 +368,18 @@ end;
function TProjectResources.Update: Boolean;
var
i: integer;
Res: TAbstractProjectResource;
begin
Result:=true;
Clear;
for i := 0 to FResources.Count - 1 do
begin
Result := TAbstractProjectResource(FResources[i]).UpdateResources(Self, resFileName);
if not Result then
Res:=TAbstractProjectResource(FResources[i]);
Result := Res.UpdateResources(Self, resFileName);
if not Result then begin
debugln(['TProjectResources.Update UpdateResources of ',DbgSName(Res),' failed']);
Exit;
end;
end;
end;
@ -495,16 +499,22 @@ begin
try
// update resources (FLazarusResources, FSystemResources, ...)
if not Update then
if not Update then begin
debugln(['TProjectResources.Regenerate Update failed']);
Exit;
end;
// create codebuffers of new .lrs and .rc files
UpdateCodeBuffers;
// update .lpr file (old and new include files exist, so parsing should work without errors)
if UpdateSource and not UpdateMainSourceFile(MainFileName) then
Exit;
if UpdateSource and not UpdateMainSourceFile(MainFileName) then begin
debugln(['TProjectResources.Regenerate UpdateMainSourceFile failed']);
exit;
end;
if PerformSave and not Save(SaveToTestDir) then
if PerformSave and not Save(SaveToTestDir) then begin
debugln(['TProjectResources.Regenerate Save failed']);
Exit;
end;
finally
DeleteLastCodeBuffers;
end;