无法在动态创建的 TBitmap(s) 上绘制 GIF

Question

我想提取 GIF 图像的帧。下面的代码有效，但这不是我需要的。我需要将提取的帧保存在一系列位图中。

procedure TForm1.Button2Click(Sender: TObject);
var
  GIF: TGIFImage;
  Bitmap: TBitmap;
  I: Integer;
  GR: TGIFRenderer;
  R: TRect;
begin
  GIF := TGIFImage.Create;
  TRY
    GIF.LoadFromFile('c:\1.gif');
    Bitmap := TBitmap.Create;       <------------ one single object, reused
    Bitmap.SetSize(GIF.Width, GIF.Height);
    GR := TGIFRenderer.Create(GIF);
    try
      for I := 0 to GIF.Images.Count - 1 do
       begin    
         GR.Draw(Bitmap.Canvas, Bitmap.Canvas.ClipRect);

         Self.Canvas.Draw(0, 0, Bitmap);

         GR.NextFrame;
       end;
    finally
      GR.Free;
    end;
  finally
    GIF.Free;
    //Bitmap.Free;
  end;
end;

所以我为每一帧动态地创建一个位图。但这行不通。它只会在所有位图中显示相同/第一帧！

procedure TForm1.Button2Click(Sender: TObject);
var
  GIF: TGIFImage;
  Bitmap: TBitmap;
  I: Integer;
  GR: TGIFRenderer;
  R: TRect;
begin
  GIF := TGIFImage.Create;
  TRY
    GIF.LoadFromFile('c:\1.gif');
    GR := TGIFRenderer.Create(GIF);
    try
      for I := 0 to GIF.Images.Count - 1 do
       begin
         Bitmap := TBitmap.Create;       <----- multiple bitmaps, one for each frame
         Bitmap.SetSize(GIF.Width, GIF.Height);

         GR.Draw(Bitmap.Canvas, Bitmap.Canvas.ClipRect);

         Self.Canvas.Draw(0, 0, Bitmap);

         GR.NextFrame;
       end;
    finally
      GR.Free;
    end;

    {TODO: store bitmaps in a TObjectList for later use 
    List.Add(Bitmap);  }     
  finally
    GIF.Free;
  end;
end;

上面的代码有什么问题？也许 TGIFRenderer 只绘制帧之间的差异？

---

TLama/jachguate 的更新：

TLama 说代码不起作用，因为我没有释放位图。我不想释放位图。我以后需要它们。这是一些（演示级）代码。

VAR List: TObjectList;    {used and freed somwhere else}

procedure TForm1.Button2Click(Sender: TObject);
var
  GIF: TGIFImage;
  UniqueBMP: TBitmap;
  I: Integer;
  GR: TGIFRenderer;
  R: TRect;
begin
  List:= TObjectList.Create;
  GIF := TGIFImage.Create;
  TRY
    GIF.LoadFromFile('c:\1.gif');

    GR := TGIFRenderer.Create(GIF);
    try
      for I := 0 to GIF.Images.Count - 1 do
       begin
         UniqueBMP := TBitmap.Create;
         UniqueBMP.SetSize(GIF.Width, GIF.Height);

         if GIF.Images[I].Empty then Break;

         GR.Draw(UniqueBMP.Canvas, UniqueBMP.Canvas.ClipRect);

         Self.Canvas.Draw(0, 0, UniqueBMP);
         Sleep(50);

         List.Add(UniqueBMP);

         GR.NextFrame;
       end;
    finally
      GR.Free;
    end;
  finally
    GIF.Free;
  end;
end;


procedure TForm1.btnFreeClick(Sender: TObject);
begin 
  FreeAndNil(List);
end;

Answer 1

TCustomGIFRenderer.Draw 检查要在其上渲染的画布。如果它与上次渲染时记住的不同（并且它不同，因为您正在为每一帧创建新的位图），则调用 TCustomGIFRenderer.Reset 方法，正如其名称所解释的那样，它会重置帧索引到 0。这就是为什么你总是只渲染第一帧。

Answer 2

基于 TLama 解决方案的工作代码（请投票不是我的帖子）：

procedure TForm1.Button2Click(Sender: TObject);
var
  GIF: TGIFImage;
  TempBMP, UniqueBMP: TBitmap;
  I: Integer;
  GR: TGIFRenderer;
  R: TRect;
begin
  GIF := TGIFImage.Create;
  TRY
    GIF.LoadFromFile('c:\1.gif');

    TempBMP := TBitmap.Create;       <------- SOLUTION
    TempBMP.SetSize(GIF.Width, GIF.Height);

    GR := TGIFRenderer.Create(GIF);
    try
      for I := 0 to GIF.Images.Count - 1 do
       begin
         UniqueBMP := TBitmap.Create;      <------- SOLUTION
         UniqueBMP.SetSize(GIF.Width, GIF.Height);

         if GIF.Images[I].Empty then Break;

         GR.Draw(TempBMP.Canvas, TempBMP.Canvas.ClipRect);

         UniqueBMP.Assign(TempBMP);                <------- SOLUTION
         Self.Canvas.Draw(0, 0, UniqueBMP);
         Sleep(50);

         GR.NextFrame;
       end;
    finally
      GR.Free;
    end;
  finally
    GIF.Free;
    TempBMP.Free;
  end;
end;