I am using TGifImage that is included with Delphi XE.
What I am trying to do is load a Gif from a File and and extract all the frames to a Bitmap.
This is what I did 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 I am facing is with some transparency issue with a lot of different Gifs, and also size problems.
Here are some example bitmaps that were saved using my code above:
As you can see the results are not great, they have size and transparency issues.
I know the Gif Files themselves are not corrupt, because I can load them through my web browser and they display correctly without fault.
How can I load a Gif from File, assign each frame to Bitmap without losing any quality?
For older Delphi Versions (Pre 2009): Take a look at the code of GIFImage unit, you might want to check how TGIFPainter renders the images based on each Frame's Disposal method.
I have wrote a small code utilizing TGIFPainter.OnAfterPaint event handler to save the active frame to BMP, and do all the "hard work".
Note: GIFImage unit 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: No error handling to simplify the code.
For newer Delphi Versions (2009+): With build-in GIFImg unit, you can do this quit easy with the use of TGIFRenderer (which completely replaced old TGIFPainter) e.g.:
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;
The frames of an animated GIF file often only contain the differences from the previous frame (an optimisation technique to reduce file size). So in order to produce a snapshot of the GIF at a particular point, you'll have to paste all the frames up to that point, one after the other.
We can achieve this by using Draw() with its 'draw transparently' option set:
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: There are other elements to the animated GIF format, which specify the amount of times frames are to be repeated etc. but they may not concern you.
Related
Coming from C# and Visual Studio to Delphi 10.1 Berlin is very hard for me, but some performance is crucial, and I haven't worked with Delphi for a long time (more than 10 years), so I'm blocked.
I need to create an ImageList at run-time and store it in a singleton object, but I can't do that due to an exception while reading memory.
Here is an extract of my code:
ImagesRessource = class
private
_owner: TComponent;
_imageList: TimageList;
_man24: TPngImage;
constructor Create;
function GetBmpOf(png: TPngImage): TBitmap;
public
procedure Initialize(own: TComponent);
end;
implementation
constructor ImagesRessource.Create;
begin
;
end;
procedure ImagesRessource.Initialize(owner: TComponent);
var
bmp: TBitmap;
RS : TResourceStream;
begin
try
_man24 := TPngImage.Create;
RS := TResourceStream.Create(hInstance, 'man_24', RT_RCDATA);
_man24.LoadFromStream(RS);
bmp := GetBmpOf(_man24);
_imageList := TimageList.Create(owner);
_imageList.Width := 24;
_imageList.Height := 24;
_imageList.AddMasked(Bmp, Bmp.TransparentColor); // exception read memory here
except
raise;
end;
end;
function ImagesRessource.GetBmpOf(png: TPngImage): TBitmap;
var
bmp: TBitmap;
begin
bmp := TBitmap.Create;
bmp.Width := png.Width;
bmp.Height := png.Height;
png.Draw(bmp.Canvas, bmp.Canvas.ClipRect);
end;
What wrong here?
You don't return anything from GetBmpOf. You must assign to the Result variable.)
function ImagesRessource.GetBmpOf(png: TPngImage): TBitmap;
begin
Result := TBitmap.Create;
Result.Width := png.Width;
Result.Height := png.Height;
png.Draw(Result.Canvas, Result.Canvas.ClipRect);
end;
You also leak the PNG image _man24, which in any case should be a local variable. You hard code the size of 24 in some places but not others. Your try except block is pointless.
I've this event to draw on a bitmap :
procedure TForm1.Button1Click(Sender: TObject);
var
SrcBmp,MyBitmap: TBitmap;
MyRect: TRectF;
begin
SrcBmp:=TBitmap.CreateFromFile('android.png');
try
MyBitmap := TBitmap.CreateFromFile('fav.png');
try
MyRect.Left :=0;
MyRect.Top := 0;
MyRect.Bottom := MyBitmap.Height;
MyRect.Right := MyBitmap.Width;
SrcBmp.Canvas.BeginScene() ;
SrcBmp.Canvas.DrawBitmap(MyBitmap,MyRect
,MyRect, 50);
SrcBmp.Canvas.EndScene;
finally
MyBitmap.Free;
end;
Image1.Bitmap.Assign(SrcBmp);
finally
SrcBmp.Free;
end;
end;
The Result is :
But what i want to get is this result :
I tried to decrease the MyRect.Left and MyRect.Top , but that didn't give the 2nd result .
PS: the fav.png dimensions is 16x16 .
Many thanks
As others have pointed out:
procedure TForm1.Button1Click(Sender: TObject);
var
SrcBmp,MyBitmap: TBitmap;
MyRect,
DestRect: TRectF;
begin
SrcBmp:=TBitmap.CreateFromFile('android.png');
try
MyBitmap := TBitmap.CreateFromFile('fav.png');
try
MyRect:=TRectF.Create(0,0,MyBitmap.Width, MyBitmap.Height);
DestRect:=TRectF.Create(ScrBmp.Width-MyBitmap.width, ScrBmp.Height-MyBitmap.Height, MyBitmap.Width, MyBtmap.Height);
SrcBmp.Canvas.BeginScene() ;
SrcBmp.Canvas.DrawBitmap(MyBitmap,MyRect, DestRect, 50);
SrcBmp.Canvas.EndScene;
DestRect.Free;
MyRect.Free;
finally
MyBitmap.Free;
end;
Image1.Bitmap.Assign(SrcBmp);
finally
SrcBmp.Free;
end;
end;
I have been making an application at Delphi XE3. I am trying to display values from database to the TAdvStringGrid component placed on the form. I am using dataset to display results at TAdvSTringGRid (code is given below). All other values are displaying perfectly except Image in database. Where it is expected to show image, it is showing junk characters. How to display image perfectly from DataBase at TAdvStringGrid.
SQLConnection1: TSQLConnection;
SQLMonitor1: TSQLMonitor;
DataSource1: TDataSource;
ADOConnection1: TADOConnection;
ClientDataSet1: TClientDataSet;
AdvStringGrid1: TAdvStringGrid;
procedure Button1Click(Sender: TObject);
procedure ShowSelectResults(results: TDataSet; sg: TAdvSTringGrid);
procedure FormCreate(Sender: TObject);
procedure TForm2.FormCreate(Sender: TObject);
var
results: TDataSet;
begin
SQLConnection1.Params.Add('Database=E:\playdb.s3db');
try
SQLConnection1.Connected := true;
SQLMonitor1.Active := True;
SQLConnection1.Execute('Select * from plays', nil, results);
except
on E: EDatabaseError do
ShowMessage('Exception raised with message' + E.Message);
end;
ShowSelectResults(results, advstringgrid1);
end;
Call to ShowSelectResult below
procedure TForm2.ShowSelectResults(results: TDataSet; sg: TAdvStringGrid);
var
names: TStringList;
i,j,k, rc: Integer;
resultsfield: variant;
Field: TblobField;
Stream: TStream;
Jpg: TJPEGImage;
Picture: TPicture;
begin
if not results.IsEmpty then
//Prints Data in the TAdvStringGrid
results.First;
j := 1;
while not results.EOF do
begin
if (j>sg.rowcount) then
sg.rowcount := sg.rowcount + 1;
for i := 0 to results.fields.Count - 1 do
begin
if i=0 then
else if i = 4 then
//Here I want to display image from db
Field := TBlobField(results.FieldByName(names[i]).AsString);
Stream := results.CreateBlobStream(Field, bmRead);
sg.CreatePicture(i, j, true, ShrinkWithAspectRatio, 20, haCenter, vaAboveText).Picture
else
sg.cells[i,j] := results.FieldByName(names[i]).AsString;
end;
results.Next;
inc(j);
end;
end;
Problem is at the else if i=4 loop in the above code at sg.CreatePicture (format of the CreatePicture procedure is given below), where I want to display image in that particular column.
In manual of TAdvStringGrid they have mentioned following methods for picture display at grid cells
Grid.CreatePicture(2,3,True,Shrink,0,haLeft,vaTop).LoadFromFile(‘TST.JPG’);
procedure AddPicture(ACol,ARow: Integer;APicture:TPicture;transparent: Boolean; stretchmode:TStretchMode; padding: Integer; hal:TCellHalign; val:TCellValign);
function GetPicture(ACol,ARow: Integer): TPicture;
Grid.CreateFilePicture(2,3,True,Shrink,0,haLeft,vaTop).Filename := ‘TST.JPG’;
But there is no mention about how to use it with DataSet.I am messing with CreatePicture procedure of TAdvStringGRid, not getting it worked out with DataSet.
Latest Development
Finally I find out way with the help of some scholars like Bummi to save the JPEG image into memorystream and then display same.
My latest code is as follows
procedure TForm2.ShowSelectResults(results: TDataSet; sg: TAdvStringGrid);
var
names: TStringList;
Field: TblobField;
//Stream: TStream;
Stream: TMemoryStream;
//blobType := TBlobType;
Jpg: TJPEGImage;
Picture: TPicture;
Image: TImage;
Graphic: TGraphic;
Begin
//k := results.FieldCount;
//sg.Rowcount := rc;
results.First;
j := 1;
while not results.EOF do
begin
if (j>sg.rowcount) then
sg.rowcount := sg.rowcount + 1;
for i := 0 to results.fields.Count - 1 do
begin
if i=0 then
else if i = 4 then // Column 5 for Image
begin
try
if ((results.FieldByName(names[i]).AsString) <> '') then
Begin
Stream := TMemoryStream.Create;
Image := Timage.Create(Self);
Jpg := TJPEGImage.Create;
Picture := TPicture.Create;
Field := TBlobField(results.FieldByName('image'));
Stream := results.CreateBlobStream(Field, bmReadWrite);
//Field.SaveToStream(Stream);
Stream.Position := 0;
Jpg.LoadFromStream(Stream);
Picture.Assign(Jpg);
//Jpg.LoadFromFile('C:\Sample Pictures\Cabo.jpg');
//Picture.Assign(Jpg);
sg.AddPicture(i,j,Picture,True,ShrinkWithAspectRatio,0,haLeft,vaTop);
end;
finally
Jpg.Free;
Stream.Free;
end;
end
else
//Prints data in other columns
sg.cells[i.j] := results.FieldByName(names[i]).AsString;
inc(j);
end;
end;
Now it's facing some memory issue according to me at the line Jpg.LoadFromStream(Stream);
It is error code JPEG Error #53 , I came to know that above such error code display only when image you are trying to access via memorystream is corrupted but I have made sure image is not corrupted and displaying properly with the help of other software extracted from similar database. I also have renewed the image in the database. Still why I am getting JPEG Error #53. Problem is mainly at Jpg.LoadFromStream(Stream)
Note that the with commented code
Jpg.LoadFromFile('C:\Sample Pictures\Cabo.jpg');
Picture.Assign(Jpg);
sg.AddPicture(i,j,Picture,True,ShrinkWithAspectRatio,0,haLeft,vaTop);
When it is extracted from static file it works perfectly. Problem is only with the MemoryStream. How to rectify this error?
CreateBlobStream is creating a TStream object, not a TMemoryStream.
Since you do not want to write the JPG to the database you should use bmRead instead of bmReadWrite.
I am not used to SQLite, but you will have to make sure that you are using a suitable binary datetype (BLOB).
JPG := TJpegImage.Create;
Picture:= TPicture.Create;
try
st := results.CreateBlobStream(TBlobField(results.FieldByName('image')), bmRead);
try
JPG.LoadFromStream(st);
Picture.Assign(JPG);
sg.AddPicture(i,j,Picture,True,ShrinkWithAspectRatio,0,haLeft,vaTop);
finally
st.Free;
end;
finally
JPG.Free;
Picture.Free;
end;
To ensure that the stored image is really a JPG you should write the JPG for testing with something like:
var
ms: TMemoryStream;
begin
ads.Open;
ads.Append;
ms := TMemoryStream.Create;
try
Image1.Picture.Graphic.SaveToStream(ms); // make sure having loaded a JPG
ms.Position := 0;
TBlobField(ads.FieldByName('image')).LoadFromStream(ms);
finally
ms.Free;
end;
ads.Post;
end;
I realize this is a tad late, but I wanted to contribute. I quite simply did the following, having not to worry about the image format (.jpg, .png etc.). I simply create a TStream object, load the BLOB stream into it, and then I load the Image from the stream. Short and sweet, and it works great for me.
var
Stream : TStream;
begin
try
Stream := TStream.Create;
Stream := Dataset.CreateBlobStream(Dataset.FieldByName('SIGNATURE'), bmRead);
Stream.Position := 0;
lblPicSize.Caption := 'Picture is ' + IntToStr(Stream.Size) + ' Bytes';
if Stream.Size <= 0 then
pnlPic.Caption := '<No Signature>'
else
pnlPic.Caption := '';
try
imgSignature.Picture.LoadFromStream(Stream);
except
on E:Exception do
begin
ShowMessage(E.Message);
end;
end;
finally
Stream.Free;
end;
end;
right now I'm trying to make a program using Delphi 5 to take a photo from webcam.
I'm using delphi 5 and DSPack 2.3.1 because many people suggest it, and yes this is my first time programming multimedia with delphi.
I've been able to list and add camera that connect to my computer dynamically. I'm also able to display what the webcam "see", opening a video and capture it.
But now I can't capture a picture from the webcam.
I have a TImage which I named "Image", to check the picture is captured or not. When I use my code to open a video and capture it, it displayed in the TImage. But when I try to capture a webcam, it's just blank and not capturing anything. The file I saved also blank.
Could someone check which part of my code goes wrong?
Thanks before...
here's part of my code
var SysDev: TSysDevEnum;
FotoBitmap: TBitmap;
implementation
{$R *.DFM}
procedure Form1.FormCreate(Sender: TObject);
var
i: integer;
Device: TMenuItem;
begin
SysDev:= TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);
if SysDev.CountFilters > 0 then
for i := 0 to SysDev.CountFilters - 1 do
begin
Device := TMenuItem.Create(Devices);
Device.Caption := SysDev.Filters[i].FriendlyName;
Device.Tag := i;
Device.OnClick := OnSelectDevice;
Devices.Add(Device);
end;
end;
procedure Form1.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
SysDev.Free;
FilterGraph.ClearGraph;
FilterGraph.Active := false;
end;
procedureForm1.OnSelectDevice(sender: TObject);
var
CaptureGraph: ICaptureGraphBuilder2;
SourceFilter, DestFilter: IBaseFilter;
begin
FilterGraph.ClearGraph;
FilterGraph.Active := false;
Filter.BaseFilter.Moniker := SysDev.GetMoniker(TMenuItem(Sender).tag);
Filter.FilterGraph := FilterGraph;
FilterGraph.Active := true;
FilterGraph.QueryInterface(ICaptureGraphBuilder2, CaptureGraph);
Filter.QueryInterface(IBaseFilter, SourceFilter);
VideoWindow.QueryInterface(IBaseFilter, DestFilter);
if Filter.BaseFilter.DataLength > 0 then
CaptureGraph.RenderStream(nil, nil, SourceFilter, nil, DestFilter);
FilterGraph.Play;
CaptureGraph := nil;
SourceFilter := nil;
DestFilter := nil;
end;
procedure Form1.SnapshotClick(Sender: TObject);
var dir : String;
begin
if edt_nama_foto.Text <> '' then begin
dir := ExtractFilePath(Application.ExeName);
FotoBitmap := TBitmap.Create;
try
SampleGrabber.GetBitmap(FotoBitmap);
SampleGrabber.GetBitmap(Image.Picture.Bitmap);
showmessage(dir + 'Image\Foto\' + edt_nama_foto.Text + '.bmp');
FotoBitmap.SaveToFile(dir + 'Image\Foto\' + edt_nama_foto.Text + '.bmp');
finally
FotoBitmap.Free;
end;
end;
end;
procedure Form1.btn_batalClick(Sender: TObject);
begin
modalresult:=mrCancel;
end;
procedure Form1.btn_simpanClick(Sender: TObject);
begin
If CheckbeforeOK then
begin
ModalResult :=mrOK;
end else begin
ModalResult := mrNone;
end;
end;
function Form1.CheckbeforeOK:Boolean;
var flag:boolean;
MasterDataSet:TQuery;
begin
Flag:=True;
if flag and not(checkedit(nil, nil, edt_nama_foto, edt_nama_foto.Text, 'Nama Foto'))
then begin
flag := False;
end else begin
Snapshot.Click;
end;
Result := flag;
end;
procedure Form1.SampleGrabberBuffer(sender: TObject;
SampleTime: Double; pBuffer: Pointer; BufferLen: Integer);
begin
Image.Picture.Bitmap.Canvas.Lock;
try
SampleGrabber.GetBitmap(Image.Picture.Bitmap, pBuffer, BufferLen);
finally
Image.Picture.Bitmap.Canvas.UnLock;
end;
end;
end.
The object which "transfers" video frame into image object is SampleGrabber:
SampleGrabber.GetBitmap(Image.Picture.Bitmap, pBuffer, BufferLen);
However it needs to be inserted in to filter graph when you build it, and you are apparently not doing it in your OnSelectDevice: there is no mention of SampleGrabber there at all. You need to include it into RenderStream call or otherwise get it inserted there so that video is streamed through it and your callback is called copying data into TImage.
The demo below tries to draw the GIF on form's canvas. It doesn't work. The image won't advance. How to make it work?
procedure TForm1.FormCreate(Sender: TObject);
begin
GIF := TGIFImage.Create;
GIF.LoadFromFile('c:\2.gif');
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
GIF.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
VAR i: Integer;
begin
REPEAT
for i:= 0 to GIF.Images.Count-1 DO
begin
DisplayGifFrame(i);
Sleep(30);
end;
UNTIL FALSE;
end;
procedure TForm1.DisplayGifFrame(AIndex: Integer);
VAR
Renderer: TGIFRenderer;
begin
Renderer := TGIFRenderer.Create(GIF);
TRY
Renderer.Animate := TRUE;
Renderer.FrameIndex := AIndex;
Renderer.Draw(Canvas, Canvas.ClipRect);
{save frame in a bitmap here. save bitmap to disk}
// xxx
FINALLY
Renderer.Free;
end;
end;
What I want to achieve:
I want to extract all frames from a GIF and put each frame IN A UNIQUE bitmap.
Update:
Continued here: Cannot draw GIF on dynamically created TBitmap(s)
Try this:
procedure TForm1.Button1Click(Sender: TObject);
var
GIF: TGIFImage;
Bitmap: TBitmap;
I: Integer;
GR: TGIFRenderer;
R: TRect;
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;
The above code takes into account Frame's Disposal method. see related question here.