简体   繁体   English

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

[英]Cannot draw GIF on dynamically created TBitmap(s)

I want to extract frames of a GIF image. 我想提取GIF图像的帧。 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? 也许TGIFRenderer只绘制帧之间的差异?


UPDATE for TLama/jachguate: TLama / jachguate的更新:

TLama says that the code doesn't work because I don't free the bitmaps. TLama说代码不起作用,因为我没有释放位图。 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. TCustomGIFRenderer.Draw检查要渲染的画布。 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. 如果它与它从上次渲染中记住的那个不同(并且它不同,因为您为每个帧创建了新的位图),则调用TCustomGIFRenderer.Reset方法,正如其名称所解释的那样,重置帧索引这就是为什么你总是只渲染第一帧的原因。

Working code based on TLama's solution (please vote his post not mine): 基于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;

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM