How to detect animated GIF?

Question

I need to detect if a GIF file is animated (more than one frame) or not. Maybe the number of frames is written somewhere in the header of the GIF file?

---

A very ugly (slow) solution is to load the whole GIF (Vcl.Imaging.GIFImg.TGIFImage.LoadFromFile) and then to check if there is more than one frame. However, for large GIF files this takes seconds.

To improve speed I made a duplicate of that file and I removed some code from LoadFromStream. Of course, the image itself won't decode properly but I don't care. I only need the frame count. And it works:

procedure TGIFImage.LoadFromStream(Stream: TStream);
var
  Position: integer;
begin
  try
    InternalClear;
    Position := Stream.Position;
    try
      FHeader.LoadFromStream(Stream);
      FImages.LoadFromStream(Stream);

     { This makes the loading slow:
     with TGIFTrailer.Create(Self) do
       try
         LoadFromStream(Stream);
       finally
         Free;
       end;
      Changed(Self);
     }
    except
      Stream.Position := Position;
      raise;
    end;
  finally
  end;
end;

Now the loading is only 600ms instead of 6 sec.
How do I use this modified LoadFromStream procedure, without using a full duplicate GIFImg.pas file?

Answer 1

How do I use this modified LoadFromStream procedure, without using a full duplicate GIFImg.pas file?

Since the classes/methods in the code excerpt you display are not hidden in private/implementation sections, the best course of action would be to write code that duplicates relevant functionality.

Sample implementation can be like the below:

uses
  gifimg;

function GifFrameCount(const FileName: string): Integer;
var
  Img: TGifImage;
  Header: TGIFHeader;
  Stream: TFileStream;
  Images: TGIFImageList;
begin
  Img := TGIFImage.Create;
  try
    Header := TGIFHeader.Create(Img);
    try
      Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
      try
        Header.LoadFromStream(Stream);
        Images := TGIFImageList.Create(Img);
        try
          Images.LoadFromStream(Stream);
          Result := Images.Image.Images.Count;
        finally
          Images.Free;
        end;
      finally
        Stream.Free;
      end;
    finally
      Header.Free;
    end;
  finally
    Img.Free;
  end;
end;

The function raises an exception for a non-gif file, otherwise returns the frame count.

Answer 2

This FMX library (link1 link2) reads animated gif files. It is much simpler than the VCL one but it does the job well. I converted the library to VCL.

Clean up
Basically, we need only the GIF structure parser. The frame decoder code (the one that makes the library slow) can be removed.
We can delete:

• the TGifFrameList and all code related to it.
• all frame decoding code
• some of the utility functions like MergeBitmap.

Getting the frame count
In TGifReader.Read procedure there is a var called FrameIndex. Make that public and interrogate it to obtain the final frame count.
You will end up with only a few hundred lines of code. Pretty clean.

Speed
The speed after clean up is impressive. The execution time is about 650ms for a 50MB gif (199 frames).

I tested the library with about 50 gif files (static and animated).

unit GifParser;

{---------------------------------------------------
  The purpose of this unit is to return the FrameGount of an animated gif.
  This was converted from FMX.
  It will not decode the actual frames!

  Originally this was for animated gif in Firemonkey
  Pointing: https://stackguides.com/questions/45285599/how-to-use-animated-gif-in-firemonkey
  Original original code: http://www.raysoftware.cn/?p=559

-------------------------------------------------------------------------------------------------------------}

INTERFACE
USES
  System.Classes, System.SysUtils, System.Types, System.UITypes, Vcl.Graphics;

{ 100mb Animated Elementalist Lux Desktop Background.gif = 4.1s }
function IsAnimatedGif(CONST FileName: string): Integer;

TYPE
  TGifVer = (verUnknow, ver87a, ver89a);

  TInternalColor = packed record
    case Integer of
      0: (
{$IFDEF BIGENDIAN} R, G, B, A: Byte;
{$ELSE}  B, G, R, A: Byte;
{$ENDIF} );
      1: (Color: TAlphaColor; );
  end;

{$POINTERMATH ON}
  PInternalColor = ^TInternalColor;
{$POINTERMATH OFF}

  TGifRGB = packed record
    R: Byte;
    G: Byte;
    B: Byte;
  end;

  TGIFHeaderX = packed record
    Signature: array [0 .. 2] of Byte;    // * Header Signature (always "GIF") */
    Version: array [0 .. 2] of Byte;      // * GIF format version("87a" or "89a") */
    // Logical Screen Descriptor
    ScreenWidth : word;                   // * Width of Display Screen in Pixels */
    ScreenHeight: word;                   // * Height of Display Screen in Pixels */
    Packedbit: Byte;                      // * Screen and Color Map Information */
    BackgroundColor: Byte;                // * Background Color Index */
    AspectRatio: Byte;                    // * Pixel Aspect Ratio */
  end;

  TGifImageDescriptor = packed record
    Left: word;                           // * X position of image on the display */
    Top: word;                            // * Y position of image on the display */
    Width: word;                          // * Width of the image in pixels */
    Height: word;                         // * Height of the image in pixels */
    Packedbit: Byte;                      // * Image and Color Table Data Information */
  end;

  TGifGraphicsControlExtension = packed record
    BlockSize: Byte;                      // * Size of remaining fields (always 04h) */
    Packedbit: Byte;                      // * Method of graphics disposal to use */
    DelayTime: word;                      // * Hundredths of seconds to wait */
    ColorIndex: Byte;                     // * Transparent Color Index */
    Terminator: Byte;                     // * Block Terminator (always 0) */
  end;

  TPalette = TArray<TInternalColor>;

  { TGifReader }
  TGifReader = class(TObject)
  protected
    FHeader: TGIFHeaderX;
    FPalette: TPalette;
    FScreenWidth: Integer;
    FScreenHeight: Integer;
    FBitsPerPixel: Byte;
    FBackgroundColorIndex: Byte;
    FResolution: Byte;
    FGifVer: TGifVer;
    function Read(Stream: TStream): Boolean; overload; virtual;
  public
    Interlace: Boolean;
    FrameIndex: Integer;
    function Read(FileName: string): Boolean; overload; virtual;
    function Check(Stream: TStream): Boolean; overload; virtual;
    function Check(FileName: string): Boolean; overload; virtual;
  public
    constructor Create; virtual;
    property Header: TGIFHeaderX read FHeader;
    property ScreenWidth: Integer read FScreenWidth;
    property ScreenHeight: Integer read FScreenHeight;
    property BitsPerPixel: Byte read FBitsPerPixel;
    property Resolution: Byte read FResolution;
    property GifVer: TGifVer read FGifVer;
  end;


IMPLEMENTATION

USES
  Math;



{ 100mb Animated Elementalist Lux Desktop Background.gif = 4.1s }
function IsAnimatedGif(CONST FileName: string): integer;
VAR
   GIFImg: TGifReader;
begin
 GIFImg := TGifReader.Create;
 TRY
   GIFImg.Read(FileName);
   Result:= GIFImg.FrameIndex; //GifFrameList.Count;
 FINALLY
   FreeAndNil(GIFImg);
 END;
end;











CONST
  alphaTransparent = $00;
  GifSignature   : array [0 .. 2] of Byte = ($47, $49, $46); // GIF
  VerSignature87a: array [0 .. 2] of Byte = ($38, $37, $61); // 87a
  VerSignature89a: array [0 .. 2] of Byte = ($38, $39, $61); // 89a


function swap16(x: UInt16): UInt16; inline;
begin
  Result := ((x and $FF) shl 8) or ((x and $FF00) shr 8);
end;

function swap32(x: UInt32): UInt32; inline;
begin
  Result := ((x and $FF) shl 24) or ((x and $FF00) shl 8) or
    ((x and $FF0000) shr 8) or ((x and $FF000000) shr 24);
end;

function LEtoN(Value: word): word; overload;
begin
  Result := swap16(Value);
end;

function LEtoN(Value: Dword): Dword; overload;
begin
  Result := swap32(Value);
end;











{ TGifReader }
function TGifReader.Read(FileName: string): Boolean;
var
  fs: TFileStream;
begin
  Result := False;
  fs := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    Result := Read(fs);
  except
  end;
  fs.DisposeOf;
end;


function TGifReader.Read(Stream: TStream): Boolean;
var
  LDescriptor: TGifImageDescriptor;
  LGraphicsCtrlExt: TGifGraphicsControlExtension;
  LIsTransparent: Boolean;
  LGraphCtrlExt: Boolean;
  LFrameWidth: Integer;
  LFrameHeight: Integer;
  LLocalPalette: TPalette;
  LScanLineBuf: TBytes;

  procedure ReadPalette(Stream: TStream; Size: Integer; var APalette: TPalette);
  Var
    RGBEntry: TGifRGB;
    I: Integer;
  begin
    SetLength(APalette, Size);
    For I := 0 To Size - 1 Do
      Stream.Read(RGBEntry, SizeOf(RGBEntry));
  end;

  function ProcHeader: Boolean;
  begin
    With FHeader do
    begin
      if (CompareMem(@Signature, @GifSignature, 3)) and
        (CompareMem(@Version, @VerSignature87a, 3)) or
        (CompareMem(@Version, @VerSignature89a, 3)) then
      begin
        FScreenWidth  := FHeader.ScreenWidth;
        FScreenHeight := FHeader.ScreenHeight;

        FResolution := Packedbit and $70 shr 5 + 1;
        FBitsPerPixel := Packedbit and 7 + 1;
        FBackgroundColorIndex := BackgroundColor;
        if CompareMem(@Version, @VerSignature87a, 3) then
          FGifVer := ver87a
        else if CompareMem(@Version, @VerSignature89a, 3) then
          FGifVer := ver89a;
        Result := True;
      end
      else
        Raise Exception.Create('Unknown GIF image format');
    end;

  end;

  function ProcFrame: Boolean;
  var
    LineSize: Integer;
    LBackColorIndex: Integer;
  begin
    LBackColorIndex:= 0;
    With LDescriptor do
     begin
      LFrameWidth := Width;
      LFrameHeight := Height;
      Interlace := ((Packedbit and $40) = $40);
     end;

    if LGraphCtrlExt then
     begin
      LIsTransparent := (LGraphicsCtrlExt.Packedbit and $01) <> 0;
      If LIsTransparent then
        LBackColorIndex := LGraphicsCtrlExt.ColorIndex;
     end
    else
     begin
      LIsTransparent := FBackgroundColorIndex <> 0;
      LBackColorIndex := FBackgroundColorIndex;
     end;
    LineSize := LFrameWidth * (LFrameHeight + 1);
    SetLength(LScanLineBuf, LineSize);

    If LIsTransparent
    then LLocalPalette[LBackColorIndex].A := alphaTransparent;
    Result := True;
  end;


  function ReadAndProcBlock(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(Int64( SkipByte), soFromCurrent);
           end;
        $F9: // Graphics Control Extension block
          begin
            Stream.Read(LGraphicsCtrlExt, SizeOf(LGraphicsCtrlExt));
            LGraphCtrlExt := True;
          end;
        $01: // Plain Text Extension block
          begin
            Stream.Read(SkipByte, 1);
            Stream.Seek(Int64( SkipByte), soFromCurrent);
            while True do
            begin
              Stream.Read(SkipByte, 1);
              if SkipByte = 0 then
                Break;
              Stream.Seek(Int64( SkipByte), soFromCurrent);
            end;
          end;
      end;
    end;
    Result := Introducer;
  end;

  function ReadScanLine(Stream: TStream; AScanLine: PByte): Boolean;
  var
    OldPos, PackedSize: longint;
    I: Integer;
    SourcePtr: PByte;
    Prefix: array [0 .. 4095] of Cardinal;
    Suffix: array [0 .. 4095] of Byte;
    DataComp: TBytes;
    B, FInitialCodeSize: Byte;
    ClearCode: word;
  begin
    DataComp := nil;
    try
      try
        Stream.Read(FInitialCodeSize, 1);
        OldPos := Stream.Position;
        PackedSize := 0;
        Repeat
          Stream.Read(B, 1);
          if B > 0 then
          begin
            Inc(PackedSize, B);
            Stream.Seek(Int64(B), soFromCurrent);
          end;
        until B = 0;
        SetLength(DataComp, 2 * PackedSize);
        SourcePtr := @DataComp[0];
        Stream.Position := OldPos;
        Repeat
          Stream.Read(B, 1);
          if B > 0 then
          begin
            Stream.ReadBuffer(SourcePtr^, B);
            Inc(SourcePtr, B);
          end;
        until B = 0;

        ClearCode := 1 shl FInitialCodeSize;
        for I := 0 to ClearCode - 1 do
        begin
          Prefix[I] := 4096;
          Suffix[I] := I;
        end;
      finally
        DataComp := nil;
      end;
    except

    end;
    Result := True;
  end;

VAR
  Introducer: Byte;
  ColorTableSize: Integer;
  rendered : array of TBitmap;
begin
  Result := False;
  FrameIndex:= 0;
  if not Check(Stream) then Exit;
  FGifVer := verUnknow;
  FPalette := nil;
  LScanLineBuf := nil;
  TRY
    Stream.Position := 0;
    Stream.Read(FHeader, SizeOf(FHeader));

    {$IFDEF BIGENDIAN}
    with FHeader do
    begin
      ScreenWidth := LEtoN(ScreenWidth);
      ScreenHeight := LEtoN(ScreenHeight);
    end;
   {$ENDIF}
    if (FHeader.Packedbit and $80) = $80 then
    begin
      ColorTableSize := FHeader.Packedbit and 7 + 1;
      ReadPalette(Stream, 1 shl ColorTableSize, FPalette);
    end;
    if not ProcHeader then
      Exit;

    FrameIndex := 0;
    while True do
    begin
      LLocalPalette := nil;
      Repeat
        Introducer := ReadAndProcBlock(Stream);
      until (Introducer in [$2C, $3B]);
      if Introducer = $3B then
        Break;

      Stream.Read(LDescriptor, SizeOf(LDescriptor));
{$IFDEF BIGENDIAN}
      nope
      with FDescriptor do
      begin
        Left := LEtoN(Left);
        Top  := LEtoN(Top);
        Width  := LEtoN(Width);
        Height := LEtoN(Height);
      end;
{$ENDIF}
      if (LDescriptor.Packedbit and $80) <> 0 then
      begin
        ColorTableSize := LDescriptor.Packedbit and 7 + 1;
        ReadPalette(Stream, 1 shl ColorTableSize, LLocalPalette);
      end
      else
        LLocalPalette := Copy(FPalette, 0, Length(FPalette));

      if not ProcFrame then EXIT;
      if not ReadScanLine(Stream, @LScanLineBuf[0]) then EXIT;
      Inc(FrameIndex);
    end;

    Result := True;
  finally
    LLocalPalette := nil;
    LScanLineBuf := nil;
    rendered := nil;
  end;
end;


function TGifReader.Check(Stream: TStream): Boolean;
var
  OldPos: Int64;
begin
  try
    OldPos := Stream.Position;
    Stream.Read(FHeader, SizeOf(FHeader));
    Result := (CompareMem(@FHeader.Signature, @GifSignature, 3)) and
      (CompareMem(@FHeader.Version, @VerSignature87a, 3)) or
      (CompareMem(@FHeader.Version, @VerSignature89a, 3));
    Stream.Position := OldPos;
  except
    Result := False;
  end;
end;


function TGifReader.Check(FileName: string): Boolean;
var
  fs: TFileStream;
begin
  Result := False;
  fs := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    Result := Check(fs);
  except
  end;
  fs.DisposeOf;
end;


constructor TGifReader.Create;//delete
begin
  inherited Create;
end;
end.