Browse Source

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

Michaël Van Canneyt 1 year ago
parent
commit
be7b9a66db
1 changed files with 81 additions and 0 deletions
  1. 81 0
      packages/fcl-image/src/fpreadgif.pas

+ 81 - 0
packages/fcl-image/src/fpreadgif.pas

@@ -94,6 +94,7 @@ type
     function WriteScanLine(Img: TFPCustomImage): Boolean; virtual;
     function WriteScanLine(Img: TFPCustomImage): Boolean; virtual;
     function InternalCheck (Stream: TStream) : boolean; override;
     function InternalCheck (Stream: TStream) : boolean; override;
     function SkipBlock(Stream: TStream): byte;
     function SkipBlock(Stream: TStream): byte;
+    class function InternalSize(Stream: TStream): TPoint; override;
   public
   public
     constructor Create; override;
     constructor Create; override;
     destructor Destroy; override;
     destructor Destroy; override;
@@ -261,6 +262,86 @@ begin
   Progress(FPimage.psEnding, 100, false, Rect(0,0,FWidth,FHeight), '', ContProgress);
   Progress(FPimage.psEnding, 100, false, Rect(0,0,FWidth,FHeight), '', ContProgress);
 end;
 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;
 function TFPReaderGif.ReadScanLine(Stream: TStream): Boolean;
 var
 var
   OldPos,
   OldPos,