这里是另一个解决方案。单位从以前的答案http://www.raysoftware.cn，但与修复的错误

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;
    fBackColor : TalphaColor;
  public
    destructor Destroy; override;
    property Bitmap : TBitmap read FDisbitmap;
  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;

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;
        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);

    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;

  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;
        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;
  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;

            Repeat
              PLine := Data.GetScanline(Row);
              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;

  procedure RenderFrame(const Index : integer; const aFrames : array of TGifFrameItem; const aDisplay : TBitmap);
  var
    I, First, Last: Integer;
  begin
    Last := Index;
    First := Max(0, Last);
    aDisplay.Clear(aFrames[Index].fBackColor);
    while First > 0 do
    begin
      if (fScreenWidth = aFrames[First].Bitmap.Width) and (fScreenHeight = aFrames[First].Bitmap.Height) then
      begin
        if (aFrames[First].FDisposalMethod = GIF_DISPOSAL_BACKGROUND) and (First < Last) then
          Break;
      end;
      Dec(First);
    end;

    for I := First to Last - 1 do
    begin
      case aFrames[I].FDisposalMethod of
        GIF_DISPOSAL_UNSPECIFIED,
        GIF_DISPOSAL_LEAVE:
          begin
            // Copy previous raw frame  onto screen
            MergeBitmap(aFrames[i].Bitmap, aDisplay, aFrames[i].Bitmap.Bounds,
                        aFrames[i].FPos.X, aFrames[i].FPos.Y);
          end;
        GIF_DISPOSAL_BACKGROUND:
          if (I > First) then
          begin
            // Restore background color
            aDisplay.ClearRect(TRectF.Create(aFrames[i].FPos.X, aFrames[i].FPos.Y,
                        aFrames[i].FPos.X + aFrames[i].Bitmap.Width,
                        aFrames[i].FPos.Y + aFrames[i].Bitmap.Height),
                        aFrames[i].fBackColor);
          end;
        GIF_DISPOSAL_PREVIOUS: ; // Do nothing - previous state is already on screen
      end;
    end;
    MergeBitmap(aFrames[Index].Bitmap, aDisplay, aFrames[Index].Bitmap.Bounds, aFrames[Index].FPos.X, aFrames[Index].FPos.Y);
  end;

var
  Introducer: Byte;
  ColorTableSize: Integer;
  tmp: TBitmap;
  LFrame: TGifFrameItem;
  FrameIndex: Integer;
  I: Integer;
  LBC : integer;
  LFrames : array of TGifFrameItem;
  rendered : array of TBitmap;
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;
    SetLength(LFrames, 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}
      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(LFrameWidth, LFrameHeight);
      LFrame.FPos := Point(LDescriptor.Left, LDescriptor.Top);
      LFrame.FDisposalMethod := 7 and (LGraphicsCtrlExt.Packedbit shr 2);
      if not ReadScanLine(Stream, @LScanLineBuf[0]) then
        Exit;
      if not WriteScanLine(LFrame.FDisbitmap, @LScanLineBuf[0]) then
        Exit;
      if LGraphCtrlExt then
      begin
        LIsTransparent := (LGraphicsCtrlExt.Packedbit and $01) <> 0;
        If LIsTransparent then
          LBC := LGraphicsCtrlExt.ColorIndex
        else
          LBC := FBackgroundColorIndex;
      end
      else
        LBC := FBackgroundColorIndex;
      LFrame.fBackColor := LLocalPalette[LBC].Color;
      Inc(FrameIndex);
      SetLength(LFrames, FrameIndex);
      LFrames[FrameIndex - 1] := LFrame;
    end;
    SetLength(rendered, Length(LFrames));
    for I := 0 to Length(LFrames) - 1 do
    begin
      tmp := TBitmap.Create(FScreenWidth, FScreenHeight);
      RenderFrame(I, LFrames, tmp);
      rendered[i] := tmp;
    end;
    for I := 0 to Length(LFrames) - 1 do
    begin
      LFrames[i].Bitmap.Assign(rendered[i]);
      FreeAndNil(rendered[i]);
      AFrameList.Add(LFrames[i]);
    end;

    Result := True;
  finally
    LLocalPalette := nil;
    LScanLineBuf := nil;
    rendered := nil;
    LFrames := 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;

end.

3条答案

按热度按时间

g52tjvyc1#

也许有点晚了，但在这个页面上找到了一个简单的解决方案：http://www.raysoftware.cn/?p=559下载文件http://www.raysoftware.cn/wp-content/uploads/2016/12/FMXGif.rar，解压缩，取出文件FMX.gifUtils，放入应用程序的目录中
在窗体上放置一个名为Image1的图像组件
将您正在使用的文件FMX.GifUtils放在最前面
在您的表单中私下声明：

FGifPlayer: TGifPlayer;

在创建表单时：

FGifPlayer := TGifPlayer.Create(Self);
 FGifPlayer.Image := Image1;
 FGifPlayer.LoadFromFile('youfilename.gif');
 FGifPlayer.Play;

就是这样

赞(0）回复(0）举报 2023-03-01

tpxzln5u2#

使用T位图列表动画。
1.将TIimage放在表格上
1.将TBitmapListAnimation放入TIimage中，如屏幕截图所示：

1.在TBitmapListAnimation中设置属性
AnimationBitmap -

您可以使用在线转换器sm将gif分割为帧。
http://ezgif.com/split
http://www.photojoiner.net/merge-photos/editor/#
设置其他属性：动画计数= 8，动画行数= 1，已启用=真持续时间（以秒为单位），属性名称=位图。
如果你喜欢这个答案请投票。
如何从TBitmapListAnimation中使用的图像列表中创建动画位图？Download这个应用程序，here也是一个主题。

xeufq47z3#

delphi 如何在Firemonkey中使用动画gif？

3条答案

相关问题

热门标签

最新问答