Delphi 无法在动态创建的TBitmap上绘制GIF

我想提取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;
  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;

procedure TForm1.按钮2点击（发送方：TObject）；
变量
GIF:TGIFImage；
TempBMP，UniqueBMP:TBitmap；
I：整数；
GR:tgifr；
R:TRect；
开始
GIF:=TGIFImage.Create；
尝试
LoadFromFile（'c:\1.GIF'）；
TempBMP:=TBitmap.Create 
TCustomGIFRenderer.Draw
检查要渲染的画布。如果它与上次渲染时记忆的不同（并且不同，因为您正在为每个帧创建新位图），则调用
TCustomGIFRenderer.Reset
方法，正如其名称所述，该方法将帧索引重置为0。这就是为什么渲染总是在第一帧进行。
我知道！请不要理它！这只是一个演示。这与我们当前的问题无关：）不起作用解释不了什么，但我怀疑帧交错。我的猜测是渲染器完全按照原样绘制帧（无论如何，为什么不这样做），并且由于您总是为每个帧使用一个新位图，因此您可以（视觉上）得到几乎为空的位图，因为（视觉上）其余部分必须由基础帧渲染。换句话说，您需要使用一个位图，让渲染器为您绘制图层。但是，这只是我的猜测。@TLama-我也这么想，但我使用的GIF图像非常生动。框架之间有许多不同之处。我应该能在接下来的几帧中看到一些东西……你能把这张图片上传到某个地方（例如imgur.com）并附上你的问题的链接吗？除了渲染交错帧，我找不到任何其他合理的原因，为什么两个代码示例的结果可能不同。这在我看来像是一个bug：TGIFRenderer在
FCanvas
strict private字段中缓存对画布的引用。然后，
TCustomGIFRenderer.Draw
方法以：
if（FCanvas ACanvas）
开始，但是当位图被释放时，新位图被创建在相同的地址中，然后，渲染器
重置
和
初始化
方法不被调用，因此动画工作，多亏了这个bug。这个解决方案很好。要让渲染器绘制当前索引的帧，必须使用
GR.draw
方法调用相同的画布和相同的矩形。一旦这些参数中的任何一个与第一个
GR.Draw
方法调用不同，帧索引将重置为第一帧。感谢TLama的解释。不，谢谢Embarcadero提供的“优秀”用户手册。不客气！是的，这应该在文档中提到，或者以不同的方式更好地实现。
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;

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;