FireMonkey跨平台的GIF解决方案

转载自，谢谢原内容 http://www.raysoftware.cn/?p=559#comment-3192

用FireMonkey的同学们一定知道FireMonkey对GIF动画的支持不是太好，只有静态的。

网上已有的解决方案就是先手动预处理GIF文件分割成多个单张，然后放到BitmapList中，缺点是要手动处理，而且帧速率也麻烦。因为项目中要实现了一个GIF的格式处理，代码整理了一下，嫁接到FireMonkey中，给广大兄弟们使用。

主要是就实现一个GIF格式的Reader，把GIF每一帧解析出来变成TBitmap，帧速率读出来，按照指定的帧速率播放。

之前用GDIPlus写了一份，但是有两个原因促使我自己重头写。

1）GDIPlus不能跨平台只支持Windows，

2）效率偏低。也用FreeImage试过，FreeImage对静态图还可以，获取GIF帧极其慢，40毫秒解析出一帧，几百帧要等死人的。改GDIPlus好一些，但是也慢。我自己解析GIF的话，比GDIPlus的快接近一倍。GDIPlus解析要900-1000ms，这个只要500ms

因为这份代码是直接自己解析GIF文件格式的，理论上可以跨任何Delphi支持的平台。

自己测试Win32,Win64,Android,FMX for Linux 0.91无问题。

 

代码和例子：FMXGif

控件部分的代码如下：

{   GIF文件格式解析。   参考：http://blog.csdn.net/wzy198852/article/details/17266507   http://wenku.baidu.com/link?url=lLsRy13yNCOTdeJLHpLejRvPV_Qz9X_E1ZupyiVXL3-TaE8SFdiFM78YFm50436pD1TwgZO833a5vyrmiwi8n1xDGmLvJph6TE5TyIYiRg3###     by  wr960204武稀松  2016.11.30   可以给FMX播放GIF的控件     大概用法     2016.12.7   2017.4.19加入对FMX for Linux的支持 }   unit FMX.GifUtils;   interface   uses   System.Classes, System.SysUtils, System.Types, System.UITypes,   FMX.Types, FMX.Objects, FMX.Graphics, System.Generics.Collections;   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     GIF_DISPOSAL_UNSPECIFIED = 0;   GIF_DISPOSAL_LEAVE = 1;   GIF_DISPOSAL_BACKGROUND = 2;   GIF_DISPOSAL_PREVIOUS = 3;   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;     TGIFHeader = 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;     TGifReader = class;     // 调色板   TPalette = TArray<TInternalColor>;     TGifFrameItem = class;     TGifFrameList = TObjectList<TGifFrameItem>;   { TGifReader }     TGifReader = class(TObject)   protected     FHeader: TGIFHeader;     FPalette: TPalette;     FScreenWidth: Integer;     FScreenHeight: Integer;     FInterlace: Boolean;     FBitsPerPixel: Byte;     FBackgroundColorIndex: Byte;     FResolution: Byte;     FGifVer: TGifVer;     public     function Read(Stream: TStream; var AFrameList: TGifFrameList): Boolean;       overload; virtual;     function Read(FileName: string; var AFrameList: TGifFrameList): Boolean;       overload; virtual;     function ReadRes(Instance: THandle; ResName: string; ResType: PChar;       var AFrameList: TGifFrameList): Boolean; overload; virtual;     function ReadRes(Instance: THandle; ResId: Integer; ResType: PChar;       var AFrameList: TGifFrameList): Boolean; overload; virtual;       function Check(Stream: TStream): Boolean; overload; virtual;     function Check(FileName: string): Boolean; overload; virtual;   public     constructor Create; virtual;     destructor Destroy; override;     //     property Header: TGIFHeader read FHeader;     property ScreenWidth: Integer read FScreenWidth;     property ScreenHeight: Integer read FScreenHeight;     property Interlace: Boolean read FInterlace; // 是否是交织的     property BitsPerPixel: Byte read FBitsPerPixel; // 颜色位     property Background: Byte read FBackgroundColorIndex; // 背景色     property Resolution: Byte read FResolution; //     property GifVer: TGifVer read FGifVer; // 版本，枚举类型   end;     TGifFrameItem = class     FDisposalMethod: Integer;     FPos: TPoint;     FTime: Integer;     FDisbitmap: TBitmap;   public     destructor Destroy; override;   end;     TGifPlayer = class(TComponent)   private     FImage: TImage;     FGifFrameList: TGifFrameList;     FTimer: TTimer;     FActiveFrameIndex: Integer;     FSpeedup: Single;     FScreenHeight: Integer;     FScreenWidth: Integer;     procedure SetImage(const Value: TImage);     procedure TimerProc(Sender: TObject);     function GetIsPlaying: Boolean;     procedure SetActiveFrameIndex(const Value: Integer);     procedure SetSpeedup(const Value: Single);   protected     procedure Notification(AComponent: TComponent;       Operation: TOperation); override;     public     constructor Create(AOwner: TComponent); override;     destructor Destroy; override;       procedure LoadFromFile(AFileName: string);     procedure LoadFromStream(AStream: TStream);     procedure LoadFromResById(Instance: THandle; ResId: Integer;       ResType: PChar);     procedure LoadFromResByName(Instance: THandle; ResName: string;       ResType: PChar);     procedure Play();     procedure Pause();     procedure stop();     //     property Image: TImage read FImage write SetImage;     property IsPlaying: Boolean read GetIsPlaying;     property Speedup: Single read FSpeedup write SetSpeedup;     property ActiveFrameIndex: Integer read FActiveFrameIndex       write SetActiveFrameIndex;     property ScreenWidth: Integer read FScreenWidth;     property ScreenHeight: Integer read FScreenHeight;   end;   implementation   uses   Math;   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;   {   不知道为什么Windows下和Android中的Canvas.DrawBitmap对透明处理有区别，   写这个函数来弥补这个区别 } procedure MergeBitmap(const Source, Dest: TBitmap; SrcRect: TRect;   DestX, DestY: Integer); var   I, J, MoveBytes: Integer;   SrcData, DestData: TBitmapData;   lpColorSrc, lpColorDst: PInternalColor; begin   With Dest do   begin     if Map(TMapAccess.Write, DestData) then       try         if Source.Map(TMapAccess.Read, SrcData) then           try             if SrcRect.Left < 0 then             begin               Dec(DestX, SrcRect.Left);               SrcRect.Left := 0;             end;             if SrcRect.Top < 0 then             begin               Dec(DestY, SrcRect.Top);               SrcRect.Top := 0;             end;             SrcRect.Right := Min(SrcRect.Right, Source.Width);             SrcRect.Bottom := Min(SrcRect.Bottom, Source.Height);             if DestX < 0 then             begin               Dec(SrcRect.Left, DestX);               DestX := 0;             end;             if DestY < 0 then             begin               Dec(SrcRect.Top, DestY);               DestY := 0;             end;             if DestX + SrcRect.Width > Width then               SrcRect.Width := Width - DestX;             if DestY + SrcRect.Height > Height then               SrcRect.Height := Height - DestY;               if (SrcRect.Left < SrcRect.Right) and (SrcRect.Top < SrcRect.Bottom)             then             begin               MoveBytes := SrcRect.Width * SrcData.BytesPerPixel;               for I := 0 to SrcRect.Height - 1 do               begin                 lpColorSrc := SrcData.GetPixelAddr(SrcRect.Left,                   SrcRect.Top + I);                 lpColorDst := DestData.GetPixelAddr(DestX, DestY + I);                 for J := 0 to SrcRect.Width - 1 do                   if lpColorSrc[J].A <> 0 then                   begin                     lpColorDst[J] := lpColorSrc[J];                   end;               end;             end;           finally             Source.Unmap(SrcData);           end;       finally         Unmap(DestData);       end;   end; end;   { TGifReader }   function TGifReader.Read(FileName: string;   var AFrameList: TGifFrameList): Boolean; var   fs: TFileStream; begin   Result := False;   fs := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);   try     Result := Read(fs, AFrameList);   except     end;   fs.DisposeOf; end;   function TGifReader.ReadRes(Instance: THandle; ResName: string; ResType: PChar;   var AFrameList: TGifFrameList): Boolean; var   res: TResourceStream; begin   res := TResourceStream.Create(HInstance, ResName, ResType);   Result := Read(res, AFrameList);   res.DisposeOf; end;   function TGifReader.ReadRes(Instance: THandle; ResId: Integer; ResType: PChar;   var AFrameList: TGifFrameList): Boolean; var   res: TResourceStream; begin   res := TResourceStream.CreateFromID(HInstance, ResId, ResType);   Result := Read(res, AFrameList);   res.DisposeOf; end;   function TGifReader.Read(Stream: TStream;   var AFrameList: TGifFrameList): 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;     c: TInternalColor;   begin     SetLength(APalette, Size);     For I := 0 To Size - 1 Do     Begin       Stream.Read(RGBEntry, SizeOf(RGBEntry));       With APalette[I] do       begin         R := RGBEntry.R or (RGBEntry.R shl 8);         G := RGBEntry.G or (RGBEntry.G shl 8);         B := RGBEntry.B or (RGBEntry.B shl 8);         A := $FF;       end;     End;   end; // 处理文件头，把文件头解析到对象的属性   function ProcHeader: Boolean;   var     c: TInternalColor;   begin     Result := False;     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; // 全局颜色表的大小，Packedbit+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     Result := False;     With LDescriptor do     begin       LFrameWidth := Width;       LFrameHeight := Height;       FInterlace := ((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);     // 如果有透明，就把透明色的调色板中的颜色的Alpha值改成透明的     If LIsTransparent then     begin       LLocalPalette[LBackColorIndex].A := alphaTransparent;     end;     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; // 把一帧图像解析到ScanLine   function ReadScanLine(Stream: TStream; AScanLine: PByte): Boolean;   var     OldPos, UnpackedSize, PackedSize: longint;     I: Integer;     Data, Bits, Code: Cardinal;     SourcePtr: PByte;     InCode: Cardinal;       CodeSize: Cardinal;     CodeMask: Cardinal;     FreeCode: Cardinal;     OldCode: Cardinal;     Prefix: array [0 .. 4095] of Cardinal;     Suffix, Stack: array [0 .. 4095] of Byte;     StackPointer: PByte;     Target: PByte;     DataComp: TBytes;     B, FInitialCodeSize, FirstChar: Byte;     ClearCode, EOICode: 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);             CodeMask := (1 shl CodeSize) - 1;           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;           SourcePtr := @DataComp[0];         Target := AScanLine;         CodeSize := FInitialCodeSize + 1;         ClearCode := 1 shl FInitialCodeSize;         EOICode := ClearCode + 1;         FreeCode := ClearCode + 2;         OldCode := 4096;         CodeMask := (1 shl CodeSize) - 1;         UnpackedSize := LFrameWidth * LFrameHeight;         for I := 0 to ClearCode - 1 do         begin           Prefix[I] := 4096;           Suffix[I] := I;         end;         StackPointer := @Stack;         FirstChar := 0;         Data := 0;         Bits := 0;         // 解压LZW         while (UnpackedSize > 0) and (PackedSize > 0) do         begin           Inc(Data, SourcePtr^ shl Bits);           Inc(Bits, 8);           while Bits >= CodeSize do           begin             Code := Data and CodeMask;             Data := Data shr CodeSize;             Dec(Bits, CodeSize);             if Code = EOICode then               Break;             if Code = ClearCode then             begin               CodeSize := FInitialCodeSize + 1;               CodeMask := (1 shl CodeSize) - 1;               FreeCode := ClearCode + 2;               OldCode := 4096;               Continue;             end;             if Code > FreeCode then               Break;             if OldCode = 4096 then             begin               FirstChar := Suffix[Code];               Target^ := FirstChar;               Inc(Target);               Dec(UnpackedSize);               OldCode := Code;               Continue;             end;             InCode := Code;             if Code = FreeCode then             begin               StackPointer^ := FirstChar;               Inc(StackPointer);               Code := OldCode;             end;             while Code > ClearCode do             begin               StackPointer^ := Suffix[Code];               Inc(StackPointer);               Code := Prefix[Code];             end;             FirstChar := Suffix[Code];             StackPointer^ := FirstChar;             Inc(StackPointer);             Prefix[FreeCode] := OldCode;             Suffix[FreeCode] := FirstChar;             if (FreeCode = CodeMask) and (CodeSize < 12) then             begin               Inc(CodeSize);               CodeMask := (1 shl CodeSize) - 1;             end;             if FreeCode < 4095 then               Inc(FreeCode);             OldCode := InCode;             repeat               Dec(StackPointer);               Target^ := StackPointer^;               Inc(Target);               Dec(UnpackedSize);             until StackPointer = @Stack;           end;           Inc(SourcePtr);           Dec(PackedSize);         end;         finally         DataComp := nil;       end;     except       end;     Result := True;   end; // 把ScanLine写到我们常用的图像   function WriteScanLine(var Img: TBitmap; AScanLine: PByte): Boolean;   Var     Row, Col: Integer;     Pass, Every: Byte;     P: PByte;     function IsMultiple(NumberA, NumberB: Integer): Boolean;     begin       Result := (NumberA >= NumberB) and (NumberB > 0) and         (NumberA mod NumberB = 0);     end;     var     PLine: PInternalColor;     Data: TBitmapData;   begin     Result := False;     P := AScanLine;     if Img.Map(TMapAccess.Write, Data) then     begin       try         // 如果是交织的         If FInterlace then         begin           For Pass := 1 to 4 do           begin             Case Pass of               1:                 begin                   Row := 0;                   Every := 8;                 end;               2:                 begin                   Row := 4;                   Every := 8;                 end;               3:                 begin                   Row := 2;                   Every := 4;                 end;               4:                 begin                   Row := 1;                   Every := 2;                 end;             end;             PLine := Data.GetScanline(Row);             Repeat               for Col := 0 to Img.Width - 1 do               begin                 PLine[Col] := LLocalPalette[P^];                 Inc(P);               end;               Inc(Row, Every);             until Row >= Img.Height;           end;         end         else         begin           for Row := 0 to Img.Height - 1 do           begin             PLine := Data.GetScanline(Row);             for Col := 0 to Img.Width - 1 do             begin               PLine[Col] := LLocalPalette[P^];               Inc(P);             end;           end;         end;         Result := True;       finally         Img.Unmap(Data);       end;     end;   end;   var   Introducer: Byte;   ColorTableSize: Integer;   tmp: TBitmap;   LFrame: TGifFrameItem;   FrameIndex: Integer;   I: Integer; begin   Result := False;   if not Check(Stream) then     Exit;   AFrameList.Clear;   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]); // 2C每一帧的标识，3B文件结尾标志       if Introducer = $3B then         Break;         // 描述符       Stream.Read(LDescriptor, SizeOf(LDescriptor)); {$IFDEF BIGENDIAN}       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       begin         LLocalPalette := Copy(FPalette, 0, Length(FPalette));       end;         if not ProcFrame then         Exit;       // 创建图片       LFrame := TGifFrameItem.Create;       LFrame.FTime := 10 * LGraphicsCtrlExt.DelayTime;       LFrame.FDisbitmap := TBitmap.Create(FScreenWidth, FScreenHeight);       tmp := TBitmap.Create(LFrameWidth, LFrameHeight);       LFrame.FPos := Point(LDescriptor.Left, LDescriptor.Top);       LFrame.FDisposalMethod := 7 and (LGraphicsCtrlExt.Packedbit shr 2);       // 读取ScanLine       if not ReadScanLine(Stream, @LScanLineBuf[0]) then         Exit;       // 写ScanLine       if not WriteScanLine(tmp, @LScanLineBuf[0]) then         Exit;       if FrameIndex = 0 then       begin // 第0个强制视为 DisposalMethod = GIF_DISPOSAL_UNSPECIFIED         LFrame.FDisbitmap.Clear(LLocalPalette[FBackgroundColorIndex].Color);         MergeBitmap(tmp, LFrame.FDisbitmap, Bounds(0, 0, LFrameWidth,           LFrameHeight), LFrame.FPos.x, LFrame.FPos.Y);         // CoverData(LFrame.FDisbitmap, tmp, Bounds(LFrame.FPos.X, LFrame.FPos.Y,         // LFrameWidth, LFrameHeight), Rect(0, 0, LFrameWidth, LFrameHeight));       end       else       begin           case AFrameList[AFrameList.Count - 1].FDisposalMethod of           GIF_DISPOSAL_UNSPECIFIED, // 不处理           GIF_DISPOSAL_LEAVE: // 不处置图形，把图形从当前位置移去,重绘背景，在背景基础上画新的一帧             begin               LFrame.FDisbitmap.CopyFromBitmap(AFrameList[AFrameList.Count - 1]                 .FDisbitmap);               MergeBitmap(tmp, LFrame.FDisbitmap, Bounds(0, 0, LFrameWidth,                 LFrameHeight), LFrame.FPos.x, LFrame.FPos.Y);             end;           GIF_DISPOSAL_BACKGROUND: // 恢复到背景色             begin               LFrame.FDisbitmap.Clear                 (LLocalPalette[FBackgroundColorIndex].Color);                 MergeBitmap(tmp, LFrame.FDisbitmap, Bounds(0, 0, LFrameWidth,                 LFrameHeight), LFrame.FPos.x, LFrame.FPos.Y);             end;           GIF_DISPOSAL_PREVIOUS: // 回复到先前状态             begin               // 向前追溯到关键帧，如果没用就是第0帧               for I := AFrameList.Count - 1 downto 0 do               begin                 if (AFrameList[I].FDisposalMethod = GIF_DISPOSAL_BACKGROUND)                 then                   Break;               end;               if I < 0 then                 I := 0;                 LFrame.FDisbitmap.CopyFromBitmap(AFrameList[I].FDisbitmap);                 MergeBitmap(tmp, LFrame.FDisbitmap, Bounds(0, 0, LFrameWidth,                 LFrameHeight), LFrame.FPos.x, LFrame.FPos.Y);             end;           4 .. 7: // 自定义处理，咋处理，不知道。。。             begin             end;         end;         end;       AFrameList.Add(LFrame);       // tmp.SaveToFile(Format('d:\test%d.png', [FrameIndex]));       // LFrame.FDisbitmap.SaveToFile(Format('d:\test%d.png', [FrameIndex]));       tmp.DisposeOf;       Inc(FrameIndex);     end;     Result := True;   finally     LLocalPalette := nil;     LScanLineBuf := 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; begin   inherited Create;   end;   destructor TGifReader.Destroy; begin     inherited Destroy; end;   { TGifFrameItem }   destructor TGifFrameItem.Destroy; begin   if FDisbitmap <> nil then   begin     FDisbitmap.DisposeOf;     FDisbitmap := nil;   end;   inherited Destroy; end;   { TGifPlayer }   constructor TGifPlayer.Create(AOwner: TComponent); begin   inherited Create(AOwner);   FGifFrameList := TGifFrameList.Create();   FTimer := TTimer.Create(Self);   FTimer.Enabled := False;   FTimer.OnTimer := TimerProc;   FSpeedup := 1.0; end;   destructor TGifPlayer.Destroy; begin   FTimer.Enabled := False;   FGifFrameList.DisposeOf;   FGifFrameList := nil;   inherited Destroy; end;   function TGifPlayer.GetIsPlaying: Boolean; begin   Result := FTimer.Enabled; end;   procedure TGifPlayer.LoadFromFile(AFileName: string); var   gr: TGifReader; begin   gr := TGifReader.Create;   gr.Read(AFileName, FGifFrameList);   FScreenWidth := gr.ScreenWidth;   FScreenHeight := gr.ScreenHeight;   gr.DisposeOf;   ActiveFrameIndex := 0; end;   procedure TGifPlayer.LoadFromResById(Instance: THandle; ResId: Integer;   ResType: PChar); var   gr: TGifReader; begin   gr := TGifReader.Create;   gr.ReadRes(Instance, ResId, ResType, FGifFrameList);   FScreenWidth := gr.ScreenWidth;   FScreenHeight := gr.ScreenHeight;   gr.DisposeOf;   ActiveFrameIndex := 0; end;   procedure TGifPlayer.LoadFromResByName(Instance: THandle; ResName: string;   ResType: PChar); var   gr: TGifReader; begin   gr := TGifReader.Create;   gr.ReadRes(Instance, ResName, ResType, FGifFrameList);   FScreenWidth := gr.ScreenWidth;   FScreenHeight := gr.ScreenHeight;   gr.DisposeOf;   ActiveFrameIndex := 0; end;   procedure TGifPlayer.LoadFromStream(AStream: TStream); var   gr: TGifReader; begin   gr := TGifReader.Create;   gr.Read(AStream, FGifFrameList);   FScreenWidth := gr.ScreenWidth;   FScreenHeight := gr.ScreenHeight;   gr.DisposeOf;   ActiveFrameIndex := 0; end;   procedure TGifPlayer.Notification(AComponent: TComponent;   Operation: TOperation); begin   inherited;   if Operation = opRemove then   begin     if AComponent = FImage then       FImage := nil;   end; end;   procedure TGifPlayer.Pause; begin   FTimer.Enabled := False; end;   procedure TGifPlayer.Play; begin   if not IsPlaying then   begin     ActiveFrameIndex := FActiveFrameIndex;     FTimer.Enabled := True;   end; end;   procedure TGifPlayer.SetActiveFrameIndex(const Value: Integer); var   lInterval: Integer; begin   // if (FActiveFrameIndex <> Value) then   begin     FActiveFrameIndex := Value;     if (FActiveFrameIndex < 0) or (FActiveFrameIndex >= FGifFrameList.Count)     then       FActiveFrameIndex := -1;     if (FActiveFrameIndex >= 0) and (FActiveFrameIndex < FGifFrameList.Count)     then     begin       if FImage <> nil then       begin         FImage.Bitmap.Assign(FGifFrameList[FActiveFrameIndex].FDisbitmap);       end;       lInterval := FGifFrameList[FActiveFrameIndex].FTime;       if lInterval = 0 then         lInterval := 100;       lInterval := Trunc(lInterval / FSpeedup);       if lInterval <= 3 then         lInterval := 3;       FTimer.Interval := lInterval;     end     else     begin       FImage.Bitmap.SetSize(0, 0);       FTimer.Interval := 0;     end;   end; end;   procedure TGifPlayer.SetImage(const Value: TImage); begin   FImage := Value;   if FImage <> nil then     FImage.FreeNotification(Self); end;   procedure TGifPlayer.SetSpeedup(const Value: Single); begin   if FSpeedup <> Value then   begin     FSpeedup := Value;     if FSpeedup <= 0.001 then       FSpeedup := 0.001;   end; end;   procedure TGifPlayer.stop; begin   Pause;   FActiveFrameIndex := 0; end;   procedure TGifPlayer.TimerProc(Sender: TObject); var   Interval: Integer; begin   if ([csDesigning, csDestroying, csLoading] * ComponentState) <> [] then     Exit;   FTimer.Enabled := False;   if ActiveFrameIndex < (FGifFrameList.Count - 1) then     ActiveFrameIndex := FActiveFrameIndex + 1   else     ActiveFrameIndex := 0;   FTimer.Enabled := True; end;   end.