如何检测动画 GIF？
How to detect animated GIF?
我需要检测 GIF 文件是否为动画（超过一帧）。也许帧数写在GIF文件的header中？
一个非常丑陋（缓慢）的解决方案是加载整个 GIF (Vcl.Imaging.GIFImg.TGIFImage.LoadFromFile)，然后检查是否有不止一帧。但是，对于大型 GIF 文件，这需要几秒钟的时间。
为了提高速度，我复制了那个文件，并从 LoadFromStream 中删除了一些代码。当然，图像本身无法正确解码，但我不在乎。我只需要帧数。它有效：
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;
现在加载只有 600 毫秒，而不是 6 秒。
如何使用这个 modified LoadFromStream 程序，而不使用完全重复的 GIFImg.pas 文件？
How do I use this modified LoadFromStream procedure, without using a
full duplicate GIFImg.pas file?
由于您显示的代码摘录中的 classes/methods 未隐藏在 private/implementation 部分中，因此最好的做法是编写复制相关功能的代码。
示例实现如下所示：
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;
该函数为非 gif 文件引发异常，否则 returns 帧计数。
此 FMX 库 (link1 link2) 读取动画 gif 文件。它比 VCL 简单得多，但效果很好。
我将库转换为 VCL。
清理
基本上，我们只需要 GIF 结构解析器。可以删除帧解码器代码（使库变慢的代码）。
我们可以删除：
- TGifFrameList 及其相关的所有代码。
- 所有帧解码代码
- 一些实用函数，例如 MergeBitmap。
获取帧数
在 TGifReader.Read 过程中有一个名为 FrameIndex 的变量。制作 public 并询问它以获得最终的帧数。
您最终只会得到几百行代码。挺干净的。
速度
清理后的速度令人印象深刻。
对于 50MB 的 gif（199 帧），执行时间约为 650 毫秒。
我用大约 50 个 gif 文件（静态和动画）测试了这个库。
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:
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 = [=10=];
GifSignature : array [0 .. 2] of Byte = (, , ); // GIF
VerSignature87a: array [0 .. 2] of Byte = (, , ); // 87a
VerSignature89a: array [0 .. 2] of Byte = (, , ); // 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 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 ) = );
end;
if LGraphCtrlExt then
begin
LIsTransparent := (LGraphicsCtrlExt.Packedbit and ) <> 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 = 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;
: // 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 ) = 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 [C, B]);
if Introducer = B 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 ) <> 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.
我需要检测 GIF 文件是否为动画（超过一帧）。也许帧数写在GIF文件的header中？
一个非常丑陋（缓慢）的解决方案是加载整个 GIF (Vcl.Imaging.GIFImg.TGIFImage.LoadFromFile)，然后检查是否有不止一帧。但是，对于大型 GIF 文件，这需要几秒钟的时间。
为了提高速度，我复制了那个文件，并从 LoadFromStream 中删除了一些代码。当然，图像本身无法正确解码，但我不在乎。我只需要帧数。它有效：
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;
现在加载只有 600 毫秒，而不是 6 秒。
如何使用这个 modified LoadFromStream 程序，而不使用完全重复的 GIFImg.pas 文件？
How do I use this modified LoadFromStream procedure, without using a full duplicate GIFImg.pas file?
由于您显示的代码摘录中的 classes/methods 未隐藏在 private/implementation 部分中，因此最好的做法是编写复制相关功能的代码。
示例实现如下所示：
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;
该函数为非 gif 文件引发异常，否则 returns 帧计数。
此 FMX 库 (link1 link2) 读取动画 gif 文件。它比 VCL 简单得多，但效果很好。 我将库转换为 VCL。
清理
基本上，我们只需要 GIF 结构解析器。可以删除帧解码器代码（使库变慢的代码）。
我们可以删除：
- TGifFrameList 及其相关的所有代码。
- 所有帧解码代码
- 一些实用函数，例如 MergeBitmap。
获取帧数
在 TGifReader.Read 过程中有一个名为 FrameIndex 的变量。制作 public 并询问它以获得最终的帧数。
您最终只会得到几百行代码。挺干净的。
速度
清理后的速度令人印象深刻。
对于 50MB 的 gif（199 帧），执行时间约为 650 毫秒。
我用大约 50 个 gif 文件（静态和动画）测试了这个库。
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:
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 = [=10=];
GifSignature : array [0 .. 2] of Byte = (, , ); // GIF
VerSignature87a: array [0 .. 2] of Byte = (, , ); // 87a
VerSignature89a: array [0 .. 2] of Byte = (, , ); // 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 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 ) = );
end;
if LGraphCtrlExt then
begin
LIsTransparent := (LGraphicsCtrlExt.Packedbit and ) <> 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 = 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;
: // 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 ) = 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 [C, B]);
if Introducer = B 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 ) <> 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.