mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-19 04:09:20 +02:00
* Patch from Werner Pamler to implement GetInternalSize. Fixes issue #40630
This commit is contained in:
parent
26855a29c8
commit
be7b9a66db
@ -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,
|
||||
|
Loading…
Reference in New Issue
Block a user