Load Jpg/Gif/Bitmap and convert to Bitmap - delphi

I have to load an image from an XML file. There is no information in the XML file about whether the image is JPG/GIF/BMP. After loading the image, I need to convert it to Bitmap.
Does anyone have any clue how to convert images to Bitmap without knowing the actual file format? I'm using Delphi 2007/2009
Thank you.

Delphi 2009 comes with built in support for JPEG, BMP, GIF and PNG.
For earlier versions of Delphi you may need to find third party implementations for PNG and GIF, but in Delphi 2009 you simply add the Jpeg, pngimage and GIFImg units to your uses clause.
If the file has an extension you can use the following code, as noted by others the TPicture.LoadFromFile looks at the extensions registered by the inherited classes to determine which image to load.
uses
Graphics, Jpeg, pngimage, GIFImg;
procedure TForm1.Button1Click(Sender: TObject);
var
Picture: TPicture;
Bitmap: TBitmap;
begin
Picture := TPicture.Create;
try
Picture.LoadFromFile('C:\imagedata.dat');
Bitmap := TBitmap.Create;
try
Bitmap.Width := Picture.Width;
Bitmap.Height := Picture.Height;
Bitmap.Canvas.Draw(0, 0, Picture.Graphic);
Bitmap.SaveToFile('C:\test.bmp');
finally
Bitmap.Free;
end;
finally
Picture.Free;
end;
end;
If the file extension is not known one method is to look at the first few bytes to determine the image type.
procedure DetectImage(const InputFileName: string; BM: TBitmap);
var
FS: TFileStream;
FirstBytes: AnsiString;
Graphic: TGraphic;
begin
Graphic := nil;
FS := TFileStream.Create(InputFileName, fmOpenRead);
try
SetLength(FirstBytes, 8);
FS.Read(FirstBytes[1], 8);
if Copy(FirstBytes, 1, 2) = 'BM' then
begin
Graphic := TBitmap.Create;
end else
if FirstBytes = #137'PNG'#13#10#26#10 then
begin
Graphic := TPngImage.Create;
end else
if Copy(FirstBytes, 1, 3) = 'GIF' then
begin
Graphic := TGIFImage.Create;
end else
if Copy(FirstBytes, 1, 2) = #$FF#$D8 then
begin
Graphic := TJPEGImage.Create;
end;
if Assigned(Graphic) then
begin
try
FS.Seek(0, soFromBeginning);
Graphic.LoadFromStream(FS);
BM.Assign(Graphic);
except
end;
Graphic.Free;
end;
finally
FS.Free;
end;
end;

I've found a simpler way! It loads JPG/GIF/BMP etc. files automatically without even knowing/checking the file format, and convert that accordingly. It worked for me perfectly.
Sharing it here :)
Uses
Classes, ExtCtrls, Graphics, axCtrls;
Procedure TForm1.Button1Click(Sender: TObject);
Var
OleGraphic : TOleGraphic;
fs : TFileStream;
Source : TImage;
BMP : TBitmap;
Begin
Try
OleGraphic := TOleGraphic.Create; {The magic class!}
fs := TFileStream.Create('c:\testjpg.dat', fmOpenRead Or fmSharedenyNone);
OleGraphic.LoadFromStream(fs);
Source := Timage.Create(Nil);
Source.Picture.Assign(OleGraphic);
BMP := TBitmap.Create; {Converting to Bitmap}
bmp.Width := Source.Picture.Width;
bmp.Height := source.Picture.Height;
bmp.Canvas.Draw(0, 0, source.Picture.Graphic);
image1.Picture.Bitmap := bmp; {Show the bitmap on form}
Finally
fs.Free;
OleGraphic.Free;
Source.Free;
bmp.Free;
End;
End;

You can't use TPicture.LoadFromFile if you don't know what format the graphic has, as this method uses the file extension to determine which of the registered graphic formats needs to be loaded. There's a reason that there is no matching TPicture.LoadFromStream method.
An external library which can examine data and determine the graphic format at runtime would be the best solution. You could use the efg page as a starting point of your research.
A quick and dirty solution is to try the few formats you need to handle until one succeeds:
function TryLoadPicture(const AFileName: string; APicture: TPicture): boolean;
const
GraphicClasses: array[0..3] of TGraphicClass = (
TBitmap, TJPEGImage, TGIFImage, TPngImage);
var
FileStr, MemStr: TStream;
ClassIndex: integer;
Graphic: TGraphic;
begin
Assert(APicture <> nil);
FileStr := TFileStream.Create('D:\Temp\img.dat', fmOpenRead);
try
MemStr := TMemoryStream.Create;
try
MemStr.CopyFrom(FileStr, FileStr.Size);
// try various
for ClassIndex := Low(GraphicClasses) to High(GraphicClasses) do begin
Graphic := GraphicClasses[ClassIndex].Create;
try
try
MemStr.Seek(0, soFromBeginning);
Graphic.LoadFromStream(MemStr);
APicture.Assign(Graphic);
Result := TRUE;
exit;
except
end;
finally
Graphic.Free;
end;
end;
finally
MemStr.Free;
end;
finally
FileStr.Free;
end;
Result := FALSE;
end;
Edit:
The GraphicEx library has an example convert that uses
GraphicClass := FileFormatList.GraphicFromContent(...);
to determine the graphic format. This seems very similar to the VB6 way of doing this that you mention. Maybe you can use this library for your purpose.

I don't have Delphi 2007 or 2009 to see if this will work in either of those versions. However, in XE2, there is another class in Vcl.Graphics called TWICImage that handles images supported by the Microsoft Imaging Component, including BMP, GIF, ICO, JPEG, PNG, TIF and Windows Media Photo. It is capable of detecting the image type from a stream. Assuming you have a TImage on the form called Image1:
procedure LoadImageFromStream(Stream: TStream; Image: TImage);
var
wic: TWICImage;
begin
Stream.Position := 0;
wic := TWICImage.Create;
try
wic.LoadFromStream(Stream);
Image.Picture.Assign(wic);
finally
wic.Free;
end;
end;
procedure RenderImage(const Filename: string);
var
fs: TFileStream;
begin
fs := TFileStream.Create(Filename, fmOpenRead);
try
LoadImageFromStream(fs, Image1);
finally
fs.Free;
end;
end;
It works without adding PNGImage, GIFImg, or JPEG to your uses statement.
The other answers show how to convert the TImage to a BMP, so I'm not including that here. I'm just showing another way to load various graphic types into a TImage without knowing beforehand the image type, or the file extension...

Related

Create and populate an ImageList at runtime

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.

Save canvas as an image

I am writing a program using Delphi XE2. I draw some lines and shapes on a Canvas. I want to save that Canvas as an image file using a save dialog.
So I have a save button on my form and by clicking it, it opens the save dialog. How should I proceed to be able to save the Canvas?
At the moment you most likely have code in an OnPaint event for a TPaintBox or the form itself. That code might look like this:
procedure TMyForm.PaintBox1Paint(Sender: TObject);
begin
with PaintBox1.Canvas do
begin
MoveTo(0, 0);
LineTo(42, 666);
// and so on.
end;
end;
We need to do a little re-factoring. We need to extract that paint code into a separate method. Pass that method a canvas so that it is agnostic of the canvas on which it draws.
procedure TMyForm.PaintToCanvas(Canvas: TCanvas);
begin
with Canvas do
begin
MoveTo(0, 0);
LineTo(42, 666);
// and so on.
end;
end;
procedure TMyForm.PaintBox1Paint(Sender: TObject);
begin
PaintToCanvas(PaintBox1.Canvas);
end;
We are now back exactly where we started, but ready to strike at the real goal. Let's write a function to paint to a bitmap and then save to a file:
procedure TMyForm.PaintToFile(const FileName: string);
var
Bitmap: TBitmap;
begin
Bitmap := TBitmap.Create;
try
Bitmap.SetSize(Paintbox1.Width, Paintbox1.Height);
PaintToCanvas(Bitmap.Canvas);
Bitmap.SaveToFile(FileName);
finally
Bitmap.Free;
end;
end;
This can naturally be extended to other image types like GIF, PNG, JPEG etc.
I've done it like this (using VCL). You'll have to set up the SaveDialog properly (make the user select valid image file types etc) but you should be able to that on your own. You can obviously replace the TPngImage with TJpegImge / directly save it as BMP or whatnot, maybe you want to allow multiple image extensions and use the appropriate one based on the user input from the SaveDialog.
procedure TForm2.Button1Click(Sender: TObject);
var Bmp: TBitmap;
Png: TPngImage;
begin
if SaveDialog1.Execute then
begin
Bmp := TBitmap.Create;
try
Bmp.SetSize(Canvas.ClipRect.Right, Canvas.ClipRect.Bottom);
BitBlt(Bmp.Canvas.Handle, 0, 0, Width, Height, Canvas.Handle, 0, 0, SRCCOPY);
Png := TPngImage.Create;
try
Png.Assign(Bmp);
Png.SaveToFile(SaveDialog1.FileName + '.png');
finally
Png.Free;
end;
finally
Bmp.Free;
end;
end;
end;
DNR: Generalizing a little your code, we have
uses Vcl.Imaging.pngimage
procedure TfrmPrincipalTest.PrintCanvas(aCanvas: TCanvas; aRect: TRect);
var Bmp: TBitmap;
Png: TPngImage;
begin
if sSaveDialog1.Execute then
begin
Bmp := TBitmap.Create;
try
Bmp.SetSize(aCanvas.ClipRect.Right, aCanvas.ClipRect.Bottom);
BitBlt(Bmp.Canvas.Handle, aRect.Top, aRect.Left, aRect.Right, aRect.Bottom, aCanvas.Handle, 0, 0, SRCCOPY);
Png := TPngImage.Create;
try
Png.Assign(Bmp);
Png.SaveToFile(sSaveDialog1.FileName + '.png');
finally
Png.Free;
end;
finally
Bmp.Free;
end;
end;
end;
procedure TfrmPrincipalTest.I1Click(Sender: TObject);
var vRect: TRect;
begin
vRect.Top:=0;
vRect.Left:=0;
vRect.Right:=sPageControl1.Width;
vRect.Bottom:=sPageControl1.Height;
PrintCanvas(sPageControl1.Canvas, vRect);
end;

How to display BLOB Image from database in the TAdvStringGrid with the help of DataSet

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;

TGifImage Transparency Issue

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.

Stream objects to a file using TFileStream

Why does this code not work?
I am writing an application that has ability to save and load its own files and need to know how to stream objects to a file using FileStream.
procedure TForm1.btnSaveClick(Sender: TObject);
var
fs: TFileStream;
begin
fs := TFileStream.Create('c:\temp\a.my', fmCreate);
try
fs.WriteBuffer(Image1.Picture.Graphic, SizeOf(TGraphic));
finally
fs.Free;
end;
ShowMessage('ok');
Image1.Picture.Graphic := nil;
end;
procedure TForm1.btnLoadClick(Sender: TObject);
var
fs: TFileStream;
g: TGraphic;
begin
fs := TFileStream.Create('c:\temp\a.my', fmOpenRead);
try
fs.ReadBuffer(g, SizeOf(TGraphic));
Image1.Picture.Graphic := g;
finally
fs.Free;
end;
ShowMessage('ok');
end;
EDIT 1:
Found the way to do it, but need some more help:
procedure TForm1.btnSaveClick(Sender: TObject);
var
fs: TFileStream;
s: TMemoryStream;
buf: TBytes;
begin
fs := TFileStream.Create('c:\temp\a.my', fmCreate);
s := TMemoryStream.Create;
try
Image1.Picture.Graphic.SaveToStream(s);
SetLength(buf, s.Size);
s.Position := 0;
s.ReadBuffer(buf[0], s.Size);
//fs.WriteBuffer(, SizeOf(Integer)); <-here how do I save an integer which represents the size of the buffer? (so that when reading back i read this first.)
fs.WriteBuffer(buf[0], s.Size);
finally
s.Free;
fs.Free;
end;
ShowMessage('ok');
Image1.Picture.Graphic := nil;
end;
What you have done there is stream the reference, i.e. a pointer. What you need to stream is the contents. You can that with SaveToFile and LoadFromFile.
Regarding your update, assign s.Size to a local variable of type Integer and then use WriteBuffer to save it. In reverse, use ReadBuffer to read into a local variable.
If I were you I would write direct to the file and avoid the memory streak. Use the Position property of TStream to seek around the file. So write 0 for then length, write the graphic, seek back to the beginning and write the true length accounting for the 4 bytes of the length.

Resources