我正在使用Delphi XE附带的TGif
Image.
这是我到目前为止所做的：
procedure ExtractGifFrames(FileName: string);
var
Gif: TGifImage;
Bmp: TBitmap;
i: Integer;
begin
Gif := TGifImage.Create;
try
Gif.LoadFromFile(FileName);
Bmp := TBitmap.Create;
try
Bmp.SetSize(Gif.Width,Gif.Height);
for i := 0 to Gif.Images.Count - 1 do
begin
if not Gif.Images[i].Empty then
begin
Bmp.Assign(Gif.Images[i]);
Bmp.SaveToFile('C:\test\bitmap' + IntToStr(i) + '.bmp');
end;
end;
finally
Bmp.Free;
end;
finally
Gif.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute then
begin
ExtractGifFrames(OpenPictureDialog1.FileName);
end;
end;
我面临的问题是存在许多不同Gif的透明度问题,以及尺寸问题.
以下是使用上面的代码保存的一些示例位图：
如您所见,结果不是很好,它们有大小和透明度问题.
解决方法
对于较旧的Delphi版本(Pre 2009)：看一下GIFImage单元的代码,您可能想要检查TGIFPainter如何根据每个Frame的Disposal方法呈现图像.
我用TGIFPainter.OnAfterPaint事件处理程序编写了一个小代码,将活动帧保存到BMP,并完成所有“辛勤工作”.
注：GIFImage单元版本2.2发布：5(1999年5月23日)
type
TForm1 = class(TForm)
Button1: TButton;
ProgressBar1: TProgressBar;
procedure Button1Click(Sender: TObject);
public
FBitmap: TBitmap;
procedure AfterPaintGIF(Sender: TObject);
end;
...
procedure TForm1.Button1Click(Sender: TObject);
var
GIF: TGIFImage;
begin
GIF := TGIFImage.Create;
FBitmap := TBitmap.Create;
Button1.Enabled := False;
try
GIF.LoadFromFile('c:\test\test.gif');
GIF.DrawOptions := GIF.DrawOptions - [goLoop,goLoopContinously,goAsync];
GIF.AnimationSpeed := 1000; // Max - no delay
FBitmap.Width := GIF.Width;
FBitmap.Height := GIF.Height;
GIF.OnAfterPaint := AfterPaintGIF;
ProgressBar1.Max := Gif.Images.Count;
ProgressBar1.Position := 0;
ProgressBar1.Smooth := True;
ProgressBar1.Step := 1;
// Paint the GIF onto FBitmap,Let TGIFPainter do the painting logic
// AfterPaintGIF will fire for each Frame
GIF.Paint(FBitmap.Canvas,FBitmap.Canvas.ClipRect,GIF.DrawOptions);
ShowMessage('Done!');
finally
FBitmap.Free;
GIF.Free;
Button1.Enabled := True;
end;
end;
procedure TForm1.AfterPaintGIF(Sender: TObject);
begin
if not (Sender is TGIFPainter) then Exit;
if not Assigned(FBitmap) then Exit;
// The event will ignore Empty frames
FBitmap.Canvas.Lock;
try
FBitmap.SaveToFile(Format('%.2d.bmp',[TGIFPainter(Sender).ActiveImage]));
finally
FBitmap.Canvas.Unlock;
end;
ProgressBar1.StepIt;
end;
对于较新的Delphi版本(2009)：使用内置GIFImg单元,您可以使用TGIFRenderer(完全替换旧的TGIFPainter)轻松退出,例如：
procedure TForm1.Button1Click(Sender: TObject);
var
GIF: TGIFImage;
Bitmap: TBitmap;
I: Integer;
GR: TGIFRenderer;
begin
GIF := TGIFImage.Create;
Bitmap := TBitmap.Create;
try
GIF.LoadFromFile('c:\test\test.gif');
Bitmap.SetSize(GIF.Width,GIF.Height);
GR := TGIFRenderer.Create(GIF);
try
for I := 0 to GIF.Images.Count - 1 do
begin
if GIF.Images[I].Empty then Break;
GR.Draw(Bitmap.Canvas,Bitmap.Canvas.ClipRect);
GR.NextFrame;
Bitmap.SaveToFile(Format('%.2d.bmp',[I]));
end;
finally
GR.Free;
end;
finally
GIF.Free;
Bitmap.Free;
end;
end;
使用GDI：
uses ...,GDIPAPI,GDIPOBJ,GDIPUTIL;
procedure ExtractGifFrames(const FileName: string);
var
GPImage: TGPImage;
encoderClsid: TGUID;
BmpFrame: TBitmap;
MemStream: TMemoryStream;
FrameCount,FrameIndex: Integer;
begin
GPImage := TGPImage.Create(FileName);
try
if GPImage.GetLastStatus = Ok then
begin
GetEncoderClsid('image/bmp',encoderClsid);
FrameCount := GPImage.GetFrameCount(GDIPAPI.FrameDimensionTime);
for FrameIndex := 0 to FrameCount - 1 do
begin
GPImage.SelectActiveFrame(GDIPAPI.FrameDimensionTime,FrameIndex);
MemStream := TMemoryStream.Create;
try
if GPImage.Save(TStreamAdapter.Create(MemStream),encoderClsid) = Ok then
begin
MemStream.Position := 0;
BmpFrame := TBitmap.Create;
try
BmpFrame.LoadFromStream(MemStream);
BmpFrame.SaveToFile(Format('%.2d.bmp',[FrameIndex]));
finally
BmpFrame.Free;
end;
end;
finally
MemStream.Free;
end;
end;
end;
finally
GPImage.Free;
end;
end;