TGifImage transparency issue

Question

I am using TGifImage which is included in Delphi XE.

What I'm trying to do is load the Gif from a file and extract all the frames in a bitmap.

This is what I have done so far:

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; 

The problem that I encountered is related to the problem of transparency with many different Gifs, as well as size problems.

Here are some examples of bitmaps that were saved using my code above:

As you can see, the results are small, they have problems with size and transparency.

I know that the Gif files themselves are not corrupted because I can download them through my web browser and they display correctly without errors.

How to load Gif from a file, assign Bitmap to each frame without quality loss?

Answer 1

For older versions of Delphi (until 2009): Take a look at the GIFImage module GIFImage , you can check how TGIFPainter displays images based on each frame of the Disposal method.

I wrote a little code using the TGIFPainter.OnAfterPaint event handler to save the active frame in BMP and do all the "hard work".

Note: GIFImage device version 2.2 Release: 5 (23-MAY-1999)

 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; 

Note. To simplify the code, there is no error handling.

---

For newer versions of Delphi (2009 +): With the built-in GIFImg module GIFImg you can do this easily with the TGIFRenderer (which completely replaced the old TGIFPainter ), for example:

 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; 

---

Using 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; 

Answer 2

Frames of an animated GIF file often contain only differences from the previous frame (optimization method to reduce file size). Therefore, to create a GIF snapshot at a specific point, you will have to insert all the frames to that point one by one.

We can achieve this using Draw() with its draw transparent option:

 procedure ExtractGifFrames(FileName: string); var Gif: TGifImage; Bmp: TBitmap; i: Integer; Bounds: TRect; begin Gif := TGifImage.Create; try Gif.LoadFromFile(FileName); Bounds := Rect(0, 0, Gif.Width-1, Gif.Height-1); Bmp := TBitmap.Create; try Bmp.SetSize(Gif.Width, Gif.Height); Bmp.PixelFormat := pf32bit; for i := 0 to Gif.Images.Count - 1 do begin if not Gif.Images[i].Empty then begin Gif.Images[i].Draw(Bmp.Canvas, Bounds, True, True); Bmp.SaveToFile(IntToStr(i) + '.bmp'); end; end; finally Bmp.Free; end; finally Gif.Free; end; end; 

NB: In the animated GIF format, there are other elements that determine the number of frames repeated, etc., but they may not concern you.