Geek Answers Handbook

Unable to draw GIF for dynamically created TBitmap (s)

I want to extract GIF image frames. The code below works, but that is not what I need. I need to save the extracted frames in a series of bitmaps.

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;

So, I dynamically create a bitmap for each frame. But that will not work. It will only show the same / first frame in all bitmaps!

 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;

What is wrong with the above code snippet? Perhaps TGIFRenderer uses ONLY differences between frames?

UPDATE for TLama / jachguate:

TLama says the code does not work because I do not release bitmaps. I do not want to free bitmaps. I need them later. Here is some (demo) code.

 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;
+5
source share
2 answers

TCustomGIFRenderer.Draw checks the canvas on which it will be displayed. If it is different from the one it remembers from the last rendering (and it is different since you are creating a new bitmap for each frame), the TCustomGIFRenderer.Reset method is TCustomGIFRenderer.Reset , which, as its name explains, resets the frame index 0. That's why you always only the first frame was rendered.

+9
source

Working code based on TLama solution (please vote for his message not mine):

 procedure TForm1.Button2Click(Sender: TObject); var GIF: TGIFImage; TempBMP, UniqueBMP: TBitmap; I: Integer; GR: TGIFRenderer; R: TRect; begin GIF := TGIFImage.Create; TRY GIF.LoadFromFile('c:\1.gif'); TempBMP := TBitmap.Create; <------- SOLUTION TempBMP.SetSize(GIF.Width, GIF.Height); GR := TGIFRenderer.Create(GIF); try for I := 0 to GIF.Images.Count - 1 do begin UniqueBMP := TBitmap.Create; <------- SOLUTION UniqueBMP.SetSize(GIF.Width, GIF.Height); if GIF.Images[I].Empty then Break; GR.Draw(TempBMP.Canvas, TempBMP.Canvas.ClipRect); UniqueBMP.Assign(TempBMP); <------- SOLUTION Self.Canvas.Draw(0, 0, UniqueBMP); Sleep(50); GR.NextFrame; end; finally GR.Free; end; finally GIF.Free; TempBMP.Free; end; end;
+3
source

More articles:


All Articles