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

LCL/Graphics: Fix TImage being empty when its picture was written by an unregistered writer. Issue #40685.

Browse Source
This commit is contained in:
wp_xyz 2024-01-17 12:21:45 +01:00
parent 767d21e2d9
commit 05f867ee4b
1 changed files with 18 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
lcl/include/picture.inc
View File

@ -823,16 +823,33 @@ var
NewGraphic: TGraphic;
GraphicClass: TGraphicClass;
ok: boolean;
isRegisteredFormat: Boolean = true;
begin
Stream.Read(GraphicClassName[0], 1);
Stream.Read(GraphicClassName[1], length(GraphicClassName));
GraphicClass := GetPicFileFormats.FindClassName(GraphicClassName);
if GraphicClass = nil then
begin
// This case happens when the stream does not contain the name of a registered graphic class
isRegisteredFormat := false;
// In Delphi the image data follow immediately after the graphic class name
GraphicClass := GetPicFileFormats.FindByStreamFormat(Stream);
if GraphicClass = nil then
begin
// In Lazarus we must skip 4 bytes (image size) to get to the image data.
Stream.ReadDWord;
GraphicClass := GetPicFileFormats.FindByStreamFormat(Stream);
end;
end;
NewGraphic := nil;
if GraphicClass <> nil then begin
NewGraphic := GraphicClass.Create;
ok:=false;
try
NewGraphic.ReadData(Stream);
if isRegisteredFormat then
NewGraphic.ReadData(Stream)
else
NewGraphic.LoadFromStream(Stream);
ok:=true;
finally
if not ok then NewGraphic.Free;