Delphi の古いバージョン (2009 年より前) の場合:ユニットのコードを見て、各フレームのメソッドに基づいて画像がGIFImage
どのようにレンダリングされるかを確認することをお勧めします。TGIFPainter
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;