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;

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

2 个答案: