* Patch from Werner Pamler to implement GetInternalSize. Fixes issue #40630

This commit is contained in:
Michaël Van Canneyt 2024-02-08 21:27:39 +01:00
parent 26855a29c8
commit be7b9a66db

View File

@ -94,6 +94,7 @@ type
function WriteScanLine(Img: TFPCustomImage): Boolean; virtual;
function InternalCheck (Stream: TStream) : boolean; override;
function SkipBlock(Stream: TStream): byte;
class function InternalSize(Stream: TStream): TPoint; override;
public
constructor Create; override;
destructor Destroy; override;
@ -261,6 +262,86 @@ begin
Progress(FPimage.psEnding, 100, false, Rect(0,0,FWidth,FHeight), '', ContProgress);
end;
class function TFPReaderGif.InternalSize(Stream:TStream): TPoint;
function LocalSkipBlock(Stream: TStream): byte;
var
Introducer,
Labels,
SkipByte : byte;
begin
Stream.read(Introducer,1);
if Introducer = $21 then
begin
Stream.read(Labels,1);
Case Labels of
$FE, $FF : // Comment Extension block or Application Extension block
while true do
begin
Stream.Read(SkipByte, 1);
if SkipByte = 0 then Break;
Stream.Seek(SkipByte, soFromCurrent);
end;
$F9 : // Graphics Control Extension block
begin
Stream.Seek(SizeOf(TGifGraphicsControlExtension), soFromCurrent);
end;
$01 : // Plain Text Extension block
begin
Stream.Read(SkipByte, 1);
Stream.Seek(SkipByte, soFromCurrent);
while true do
begin
Stream.Read(SkipByte, 1);
if SkipByte = 0 then Break;
Stream.Seek(SkipByte, soFromCurrent);
end;
end;
end;
end;
Result:=Introducer;
end;
var
hdr: TGIFHeader;
introducer: Byte;
b: Byte = 0;
skipByte: Byte = 0;
descr: TGifImageDescriptor;
n: Integer;
begin
Result := Point(-1, 1);
Stream.Read(hdr, SizeOf(hdr));
// Skip global palette if there is one
if (hdr.Packedbit and $80) <> 0 then
begin
n := hdr.Packedbit and 7 + 1;
Stream.Seek(1 shl n, soFromCurrent);
end;
if Stream.Position >= Stream.Size then
exit;
// Skip extensions until image descriptor is found ($2C)
repeat
introducer := LocalSkipBlock(Stream);
until (introducer = $2C) or (Stream.Position>=Stream.Size);
if Stream.Position>=Stream.Size then
Exit;
Stream.Read(descr, SizeOf(descr));
with descr do
begin
{$IFDEF ENDIAN_BIG}
Width := LEtoN(Width);
Height := LEtoN(Height);
{$ENDIF}
Result.X := Width;
Result.Y := Height;
end;
end;
function TFPReaderGif.ReadScanLine(Stream: TStream): Boolean;
var
OldPos,