paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-18 20:09:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: added try..except workaround for bug in fcl with fpc 2.4.0rc1

Browse Source 
git-svn-id: trunk@23780 -
This commit is contained in:
mattias 2010-02-24 21:41:00 +00:00
parent dc2a5b26a1
commit f6e63d473f
1 changed files with 18 additions and 5 deletions

23
ide/projecticon.pas
View File

@ -102,6 +102,7 @@ var
AResource: TStream;
AName: TResourceDesc;
ARes: TGroupIconResource;
ItemStream: TStream;
begin
Result := True;
@ -128,11 +129,23 @@ begin
ARes := TGroupIconResource.Create(nil, AName); //type is always RT_GROUP_ICON
aName.Free; //not needed anymore
AResource := GetStream;
try
ARes.ItemData.CopyFrom(AResource, AResource.Size);
finally
AResource.Free;
end;
if AResource<>nil then
try
ItemStream:=nil;
try
ItemStream:=ARes.ItemData;
except
on E: Exception do begin
DebugLn(['TProjectIcon.UpdateResources bug in fcl: ',E.Message]);
end;
end;
if ItemStream<>nil then
ItemStream.CopyFrom(AResource, AResource.Size);
finally
AResource.Free;
end
else
ARes.ItemData.Size:=0;
AResources.AddSystemResource(ARes);
end;