我想提取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)
在TCustomGIFRenderer.Draw检查其上要呈现在画布上.如果它与它从上次渲染中记忆的那个不同(并且它不同,因为您为每个帧创建了新的位图),TCustomGIFRenderer.Reset则调用该方法,正如其名称所解释的那样,将帧索引重置为0.这就是为什么你总是只渲染第一帧的原因.
| 归档时间: |
|
| 查看次数: |
558 次 |
| 最近记录: |