无法在动态创建的TBitmap上绘制GIF [英] Cannot draw GIF on dynamically created TBitmap(s)

问题描述

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

  procedure TForm1.Button2Click（Sender：TObject）; 
 var 
 GIF：TGIFImage; 
位图：TBitmap; 
 I：整数; 
 GR：TGIFRenderer; 
 R：TRect; 
 begin 
 GIF：= TGIFImage.Create; 
 TRY 
 GIF.LoadFromFile（'c：\1.gif'）; 
位图：= TBitmap.Create; < ------------单个对象，重用
 Bitmap.SetSize（GIF.Width，GIF.Height）; 
 GR：= TGIFRenderer.Create（GIF）; 
尝试
为I：= 0到GIF.Images.Count  -  1 do 
 begin 
 GR.Draw（Bitmap.Canvas，Bitmap.Canvas.ClipRect）; 
 
 Self.Canvas.Draw（0，0，Bitmap）; 
 
 GR.NextFrame; 
结束
 finally 
 GR.Free; 
结束
 finally 
 GIF.Free; 
 //Bitmap.Free; 
结束
结束
  

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

  procedure TForm1.Button2Click（Sender：TObject）; 
 var 
 GIF：TGIFImage; 
位图：TBitmap; 
 I：整数; 
 GR：TGIFRenderer; 
 R：TRect; 
 begin 
 GIF：= TGIFImage.Create; 
 TRY 
 GIF.LoadFromFile（'c：\1.gif'）; 
 GR：= TGIFRenderer.Create（GIF）; 
尝试
为I：= 0到GIF.Images.Count  -  1 do 
 begin 
位图：= TBitmap.Create; < -----多个位图，每个框架一个
 Bitmap.SetSize（GIF.Width，GIF.Height）; 
 
 GR.Draw（Bitmap.Canvas，Bitmap.Canvas.ClipRect）; 
 
 Self.Canvas.Draw（0，0，Bitmap）; 
 
 GR.NextFrame; 
结束
 finally 
 GR.Free; 
结束
 
 {TODO：在TObjectList中存储位图以供以后使用
 List.Add（Bitmap）; } 
 finally 
 GIF.Free; 
结束
结束
  

上面的代码有什么问题？也许TGIFRenderer只得到框架之间的差异？

---

TLama / jachguate的更新： p>

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

  VAR列表：TObjectList; {used and freed somwhere else} 
 
 procedure TForm1.Button2Click（Sender：TObject）; 
 var 
 GIF：TGIFImage; 
 UniqueBMP：TBitmap; 
 I：整数; 
 GR：TGIFRenderer; 
 R：TRect; 
 begin 
列表：= TObjectList.Create; 
 GIF：= TGIFImage.Create; 
 TRY 
 GIF.LoadFromFile（'c：\1.gif'）; 
 
 GR：= TGIFRenderer.Create（GIF）; 
尝试
为I：= 0到GIF.Images.Count  -  1 do 
 begin 
 UniqueBMP：= TBitmap.Create; 
 UniqueBMP.SetSize（GIF.Width，GIF.Height）; 
 
如果GIF.Images [I] .Empty then Break; 
 
 GR.Draw（UniqueBMP.Canvas，UniqueBMP.Canvas.ClipRect）; 
 
 Self.Canvas.Draw（0，0，UniqueBMP）; 
睡眠（50）; 
 
 List.Add（UniqueBMP）; 
 
 GR.NextFrame; 
结束
 finally 
 GR.Free; 
结束
 finally 
 GIF.Free; 
结束
结束
 
 
程序TForm1.btnFreeClick（发件人：TObject）; 
 begin 
 FreeAndNil（List）; 
结束
  

解决方案

TCustomGIFRenderer.Draw 检查要渲染的画布。如果它不同于最后一次渲染所记住的（与之不同的是，因为您为每个帧创建新的位图），所以 TCustomGIFRenderer.Reset 方法是调用，其名称解释，将框架索引重置为0.这就是为什么你总是只渲染第一帧。

I want to extract frames of a GIF image. The code below works, but it's not what I need. I need to keep the extracted frames in a series of bitmaps.

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;

So I dynamically create a bitmap for each frame. But this won't work. It will only show the same/first frame in all bitmaps!

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;

What is wrong with the above piece of code? Maybe TGIFRenderer draws ONLY the differences between frames?

---

UPDATE for TLama/jachguate:

TLama says that the code doesn't work because I don't free the bitmaps. I don't want to free the bitmaps. I need them later. Here is some (demo-grade) code.

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;

解决方案

The TCustomGIFRenderer.Draw checks the canvas on which is going to render. If it differs from the one which it remembers from the last rendering (and it differs, since you're creating the new bitmap for each frame), the TCustomGIFRenderer.Reset method is called, which, as its name explains, resets the frame index to 0. That's why you're getting rendered always just the first frame.

这篇关于无法在动态创建的TBitmap上绘制GIF的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！