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

WeG*_*ars 5 delphi

我想提取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;
Run Code Online (Sandbox Code Playgroud)

所以我为每个帧动态创建一个位图.但这不起作用.它只会在所有位图中显示相同/第一帧!

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;
Run Code Online (Sandbox Code Playgroud)

上面的代码有什么问题?也许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;
Run Code Online (Sandbox Code Playgroud)

TLa*_*ama 9

TCustomGIFRenderer.Draw检查其上要呈现在画布上.如果它与它从上次渲染中记忆的那个不同(并且它不同,因为您为每个帧创建了新的位图),TCustomGIFRenderer.Reset则调用该方法,正如其名称所解释的那样,将帧索引重置为0.这就是为什么你总是只渲染第一帧的原因.

  • 感谢TLama的解释.不,感谢Embarcadero的"伟大"用户手册. (3认同)