I have a listbox of images that normally works fine, but today it throws a access violation for no apparent reason.
Here is my code:
procedure TfrmSelectIcon.ListBox1DrawItem(Control: TWinControl; Index: integer;
Rect: TRect; State: TOwnerDrawState);
var
icone: TImageItem; // Ticone;
png1: TPngImage;
ImageIcone: TPngImage;
TextPosition: integer;
nomearquivo: string;
Images: TImageList;
begin
icone := TImageItem(listaIcone.Items[StrToInt(TListBox(Control).Items.Strings
[Index])]);
// Ticone(listaIcone.Items[strtoint(TListBox(Control).Items.Strings[Index])]);
nomearquivo := Diretorio + icone.arquivo;
// ShowMessage(nomearquivo);
TListBox(Control).Canvas.FillRect(Rect);
if FileExists(nomearquivo) then
begin
png1 := TPngImage.Create;
png1.LoadFromFile(nomearquivo); //here happen the problem.
png1.Draw(TListBox(Control).Canvas, Rect);
end;
end;
The file exists and it's a .png.
The bug happens just on the fifth image.
You have a memory leak, as you are not freeing the TPngImage objects you create. But worse, you should NOT be loading image files during a drawing operation to begin with. You should instead load the images once beforehand and then reuse them each time an item need to be drawn.
Try something more like this:
private
Images: array of TPngImage; // or any other container you want to use
...
procedure TfrmSelectIcon.FormDestroy(Sener: TObject);
var
I: Integer;
begin
for I := 0 to High(Images) do
Images[I].Free;
end;
procedure TfrmSelectIcon.ListBox1DrawItem(Control: TWinControl; Index: integer; Rect: TRect; State: TOwnerDrawState);
var
png: TPngImage;
begin
png := Images[Index];
if (png <> nil) and (not png.Empty) then
png1.Draw(TListBox(Control).Canvas, Rect);
end;
var
icone: TImageItem; // Ticone;
nomearquivo: string;
I: Integer;
begin
SetLength(Images, ListBox1.Items.Count);
for I := 0 to High(Images) do
Images[I] := nil;
for I := 0 to High(Images) do
begin
// personally, I would suggest storing the TImageItem pointers
// in the TListBox.Items.Objects[] property for easier access:
//
// icone := TImageItem(ListBox1.Items.Objects[I]);
//
icone := TImageItem(listaIcone.Items[StrToInt(ListBox1.Items.Strings[I])]);
nomearquivo := Diretorio + icone.arquivo;
if FileExists(nomearquivo) then
begin
try
Images[I] := TPngImage.Create;
Images[I].LoadFromFile(nomearquivo);
except
end;
end;
end;
end;
Problem solved:
TListBox(Control).Canvas.FillRect(Rect);
if FileExists(nomearquivo) then
begin
png1 := TPngImage.Create;
png1.LoadFromFile(nomearquivo);
png1.Draw(TListBox(Control).Canvas, Rect);
**FreeAndNil(png1);** //i put this line and works fine!
end;
Related
I have a Listbox. I populate it with a file using this:
IF Opendialog1.Execute then
BEGIN
Listbox1.Items.LoadfromFile(OpenDialog1.FileName);
END;
The file loaded contains numbers, and numbers only (I assume).
To be 100 pct. sure, I now starts a scan: (pseudocode :)
for N := 0 til Listbox1.Items.Count -1 DO
BEGIN
NUM := ScanForNotNumberInListbox1Item(Listbox1.Items[N]);
//
// returns NUM = -1 if non digit is met..
//
IF NUM <> 0 then
begin
LISTBOX1.Items[N].BackGroundColor := RED;
Exit; (* or terminate *)
END;
END;
I know I have to use LIstbox1.DrawItem (); and have tried several af the examples shown here in Stack Exchange, but none of the used examples seems to be code-generated.
So how Can I do that ?
Kris
Introduction
You can store additional information about each list item in its associated "object". This can be a (pointer to a) real object, or you can use this pointer-sized integer to encode any simple information you want.
As a simple example, let's put the item's background colour in this field (uses Math):
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
begin
ListBox1.Items.BeginUpdate;
try
ListBox1.Clear;
for i := 1 to 100 do
ListBox1.Items.AddObject(i.ToString, TObject(IfThen(Odd(i), clSkyBlue, clMoneyGreen)));
finally
ListBox1.Items.EndUpdate;
end;
end;
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
ListBox: TListBox;
Canvas: TCanvas;
S: string;
begin
ListBox := Control as TListBox;
Canvas := ListBox.Canvas;
Canvas.Brush.Color := TColor(ListBox.Items.Objects[Index]);
Canvas.FillRect(Rect);
S := ListBox.Items[Index];
Canvas.TextRect(Rect, S, [tfSingleLine, tfVerticalCenter]);
end;
Don't forget to set the list box's Style property to lbOwnerDrawFixed (say).
A more "advanced" approach would be to associate an actual object with each item:
type
TItemFormat = class
BackgroundColor: TColor;
TextColor: TColor;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
ItemFormat: TItemFormat;
begin
ListBox1.Items.BeginUpdate;
try
ListBox1.Clear;
for i := 1 to 100 do
begin
ItemFormat := TItemFormat.Create;
ItemFormat.BackgroundColor := IfThen(Odd(i), clSkyBlue, clMoneyGreen);
ItemFormat.TextColor := IfThen(Odd(i), clNavy, clGreen);
ListBox1.Items.AddObject(i.ToString, ItemFormat);
end;
finally
ListBox1.Items.EndUpdate;
end;
end;
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
ListBox: TListBox;
Canvas: TCanvas;
ItemFormat: TItemFormat;
S: string;
begin
ListBox := Control as TListBox;
Canvas := ListBox.Canvas;
ItemFormat := ListBox.Items.Objects[Index] as TItemFormat;
Canvas.Brush.Color := ItemFormat.BackgroundColor;
Canvas.FillRect(Rect);
S := ListBox.Items[Index];
Canvas.Font.Color := ItemFormat.TextColor;
Canvas.TextRect(Rect, S, [tfSingleLine, tfVerticalCenter]);
end;
(In this case, you own the objects, so you are responsible for freeing them when they are no longer needed.)
Putting everything in action
In your particular case, I'd try something like
procedure TForm1.Button1Click(Sender: TObject);
var
i, dummy, FirstInvalidIndex: Integer;
begin
with TOpenDialog.Create(Self) do
try
Filter := 'Text files (*.txt)|*.txt';
Options := [ofPathMustExist, ofFileMustExist];
if Execute then
ListBox1.Items.LoadFromFile(FileName);
finally
Free;
end;
FirstInvalidIndex := -1;
ListBox1.Items.BeginUpdate;
try
for i := 0 to ListBox1.Count - 1 do
if not TryStrToInt(ListBox1.Items[i], dummy) then
begin
ListBox1.Items.Objects[i] := TObject(1);
if FirstInvalidIndex = -1 then
FirstInvalidIndex := i;
end;
finally
ListBox1.Items.EndUpdate;
end;
if FirstInvalidIndex <> -1 then
begin
ListBox1.ItemIndex := FirstInvalidIndex;
MessageBox(Handle, 'An invalid row was found.', PChar(Caption), MB_ICONERROR);
end;
end;
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
ListBox: TListBox;
Canvas: TCanvas;
S: string;
begin
ListBox := Control as TListBox;
Canvas := ListBox.Canvas;
Canvas.Font.Assign(ListBox.Font);
if odSelected in State then
begin
Canvas.Brush.Color := clHighlight;
Canvas.Font.Color := clHighlightText;
end
else
begin
Canvas.Brush.Color := clWindow;
Canvas.Font.Color := clWindowText;
end;
if ListBox.Items.Objects[Index] = TObject(1) then
begin
Canvas.Font.Color := clRed;
Canvas.Font.Style := [fsBold, fsStrikeOut]
end;
Canvas.FillRect(Rect);
S := ListBox.Items[Index];
Canvas.TextRect(Rect, S, [tfSingleLine, tfVerticalCenter]);
end;
The fine print: Notice that the above snippets are only simple examples intended to demonstrate the basic approach. In a real application, you need to be more careful about the details. For instance, you cannot use a hard-coded red text colour if the background colour is a system colour (because that colour might very well be red too!).
In addition, what happens if the text file is empty (try it!)?
Set lbOwnerDrawFixed (or another ownerdraw) style for Listbox
Listbox items have auxiliary property Objects[] and you can set Objects[i] to non-nil value for invalid items
IF NUM <> 0 then
LISTBOX1.Objects[N] := TObject(1);
Use some example for OnDrawItem event treatment and use Objects[] to define background color during drawing
I will assign this procedure into OnMouseEnter. I have some TImage that will change it's picture OnMouseEnter. It is easier to make each procedure of it on event handler. But i don't like to repeat the same code.
var
i: Integer;
CoName: TComponent;
png: TPngImage;
s: string;
begin
s := '';
for i := 1 to 16 do
begin
CoName := Form1.Components[i];
if CoName is TImage then
begin
s := CoName.Name;
Break;
end;
end;
if Trim(s) <> '' then
begin
png := TPngImage.Create;
try
png.LoadFromResourceName(hInstance, 'ResImgA');
// s.picture.Assign(png); > i can not do this
finally
FreeAndNil(png);
end;
end;
end;
How can i allow s into TImage.Name ?
Set the OnMouseEnter event of all the TImage objects to point to the same event handler, and use its Sender parameter to identify which TImage is calling the handler:
procedure TForm38.ImageMouseEnter(Sender: TObject);
var
ResName: string;
im: TImage;
png: TPngImage;
begin
im := Sender as TImage;
// if your image resources are named as 'Res' + name of TImage (eg. 'ImgA')
// you can combine these as
ResName := 'Res' + im.Name;
png := TPngImage.Create;
try
png.LoadFromResourceName(hInstance, ResName);
im.picture.Assign(png);
finally
png.Free;
end;
end;
I do this and it's work fine, you don't need String variable or loops:
procedure TForm1.Image1MouseEnter(Sender: TObject);
Var PngImg : TPngImage;
// Image : TImage; < -- If you need to handle error
begin
//Image := Sender as TImage; and remove IF
if Sender is TImage then
begin
PngImg := TPngImage.Create;
try
PngImg.LoadFromResourceName(HInstance , 'PngImage_1');
TImage(Sender).Picture.Assign(PngImg);
finally
PngImg.Free;
end ;
end;
end;
For all the other Timage (15) , you can set the event without repeat the code from the object inspector as:
i have listview item that i try to add image to its subitem as status-image i already can set image from image list but i want to get ride of image list and use images from resource i already created resource file and try to add Tgifimage to item draw but now image image not drawing
here is my code
procedure TForm1.Add_Item(strCaption: String; ListView: TListView;
strFile: String; boolBlink: Boolean; strUniqueID: String;
CurrentStatus: string);
var
Item: TListItem;
begin
Item := ListView1.Items.Add;
Item.Caption := '';
Item.SubItems.Add(strCaption);// subitem 0
Item.SubItems.AddObject( '0', nil ); // subitem 1
Item.SubItems.Add( strUniqueID ); // subitem 2 // UniqueID
Item.SubItems.Add('0'); // subitem 3 // Next User Idx (beside)
Item.SubItems.Add(Currentstatus); // subitem 4 // StateIdx
Item.Data := nil;
SetItemStatusGif(Item, Currentstatus); // here start to set status
end;
// here setitemStatusGif procedure
procedure TForm1.SetItemStatusGif(Item: TListItem; State: String);
var
ResStream: TResourceStream;
aGif: TGifImage;
strStateImg: String;
ImgIdx: Integer;
begin
strStateImg := 'State_' + State;
ImgIdx := StatusGifs.IndexOf(strStateImg);
if ImgIdx <> -1 then
aGif := TGifImage(StatusGifs.Objects[ImgIdx])
else
begin
try
ResStream := TResourceStream.Create(HInstance, strStateImg, RT_RCDATA);
try
aGif := TGifImage.Create;
try
aGif.LoadFromStream(ResStream);
aGif.Transparent := True;
StatusGifs.AddObject(strStateImg, aGif);
except
aGif.Free;
raise;
end;
finally
ResStream.Free;
end;
except
aGif := nil;
end;
end;
Item.SubItems.Objects[1] := aGif;
ListView1.UpdateItems(Item.Index, Item.Index);
end;
// here listview draw event code
procedure TForm1.ListView1DrawItem(Sender: TCustomListView; Item: TListItem;
Rect: TRect; State: TOwnerDrawState);
Var
xOff, yOff: Integer;
R: TRect;
i: Integer;
NewRect: TRect;
begin
With TListView(Sender).Canvas do
begin // User State Image
if (StrToint(Item.SubItems[1]) <> 0) And (Item.SubItems[1] <> '') then
begin
NewRect := Rect;
NewRect.Left := NewRect.Left + 2;
NewRect.Width := 24;
Newrect.Height := 23;
NewRect.Top := NewRect.Top;
NewRect.Bottom := NewRect.Bottom;
if Panel2.Visible AND (Item.Index = 0) then
//do nothing
else
Sender.Canvas.StretchDraw( NewRect, TGIFImage( Item.SubItems.Objects[1]) );
end;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
ListView1.Invalidate; // This is for animation over ListView Canvas
end;
We covered this a month ago in your other question:
how do i update listview item index inside thread
In that question, you were downloading images from online, where the download thread creates the TGifImage object and assigns it to a TListItem for drawing. Now, you want to add resource images. You still have to create a TGifImage object for them, and assign that to your TListItem object so you can draw it. You just don't need to use a thread to handle that. When you add a new item to the list, you can create the TGifImage object immediately and fill it from the resource, eg:
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ListView1Deletion(Sender: TObject; Item: TListItem);
...
private
StatusGifs: TStringList;
procedure Add_Item(strCaption: String; ListView: TListView; strFile: String; boolBlink: Boolean; strUniqueID: String; CurrentStatus: string);
procedure StatuseHandle;
procedure SetItemStatusGif(Item: TListItem; State: String);
...
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
StatusGifs := TStringList.Create(True);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
StatusGifs.Free;
end;
procedure TForm1.ListView1Deletion(Sender: TObject; Item: TListItem);
begin
TGifImage(Item.SubItems.Objects[1]).Free;
TGifImage(Item.Data).Free;
end;
procedure TForm1.Add_Item(strCaption: String; ListView: TListView; strFile: String; boolBlink: Boolean; strUniqueID: String; CurrentStatus: string);
var
Item: TListItem;
begin
Item := ListView1.Items.Add;
Item.Caption := '';
Item.SubItems.Add( strCaption ); // subitem 0
Item.SubItems.AddObject( 'IMA', TGifImage.Create ); // subitem 1
Item.SubItems.Add( strUniqueID ); // subitem 2 // UniqueID
Item.SubItems.Add('0'); // subitem 3 // Next User Idx (beside)
Item.SubItems.Add(Currentstatus); // subitem 4 // StateIdx
Item.Data := nil; // populated by TURLDownload
SetItemStatusGif(Item, Currentstatus);
TURLDownload.Create(strFile, UpdateVisual, Item);
end;
procedure TForm1.StatuseHandle;
var
i : integer;
Item : TListItem;
begin
try
for i := 0 to ListView1.Items.Count-1 do
begin
Item := ListView1.Items[i];
if Item.SubItems[2] = Trim(LineToid) then
begin
Item.SubItems[4] := LineTostatus;
SetItemStatusGif(Item, LineTostatus);
end;
end;
except
end;
end;
procedure TForm1.SetItemStatusGif(Item: TListItem; State: String);
var
ResStream : TResourceStream;
aGif : TGifImage;
strStateImg : String;
ImgIdx: Integer;
begin
strStateImg := 'State_' + State;
ImgIdx := StatusGifs.IndexOf(strStateImg);
if ImgIdx <> -1 then
aGif := TGifImage(StatusGifs.Objects[ImgIdx])
else
begin
try
ResStream := TResourceStream.Create(HInstance, strStateImg, RT_RCDATA);
try
aGif := TGifImage.Create;
try
aGif.LoadFromStream(ResStream);
aGif.Transparent := True;
StatusGifs.AddObject(strStateImg, aGif);
except
aGif.Free;
raise;
end;
finally
ResStream.Free;
end;
except
aGif := nil;
end;
end;
TGifImage(Item.SubItems.Objects[1]).Assign(aGif);
ListView1.UpdateItems(Item.Index, Item.Index);
end;
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.
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.