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?
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:
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://stackoverflow.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.