如何使用此修改后的LoadFromStream过程，而不使用
GIFImg.pas文件是否完全重复？
由于您显示的代码摘录中的类/方法没有隐藏在私有/实现部分中，因此最好的做法是编写可重复相关功能的代码。
示例实现如下：
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文件的异常，否则返回帧数。
,
此FMX库（link1 link2）读取动画gif文件。它比VCL简单得多，但效果很好。
我将库转换为VCL。
清理
基本上，我们只需要GIF结构解析器。可以删除帧解码器代码（使库变慢的代码）。
我们可以删除：
- TGifFrameList及其所有相关代码。
- 所有帧解码代码
- 一些实用程序功能，例如MergeBitmap。
获取帧数
在TGifReader.Read过程中，有一个称为FrameIndex的变量。公开并审问以获得最终的帧数。
您最终将只有几百行代码。很干净。
速度
清理后的速度令人印象深刻。
50MB gif（199帧）的执行时间约为650ms。
我用大约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: 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,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,3) then
FGifVer := ver87a
else if CompareMem(@Version,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,LLocalPalette);
end
else
LLocalPalette := Copy(FPalette,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,3)) and
(CompareMem(@FHeader.Version,3)) or
(CompareMem(@FHeader.Version,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.
本文链接：https://www.f2er.com/3044678.html
