TPicture can load any registered (TPicture.RegisterFileFormat) Fileformat and can save this in a dfm file. But its generic ReadData(Stream: TStream) and WriteData(Stream: TStream) methods are private. The code shows how to get access to these methods and how to store and load any registered TGraphic descendant to/from stream/blobfield in a generic way. This means, to support additional graphic formats it is only needed to add the units to the uses clause - no changes in the store/load code are necessary. For instance, Graphics.pas already register windows bitmap (TBitmap), windows icons (TIcon), windows metafiles. Add "jpeg" to the uses clause of your program, and jpeg files (TJpegImage) are ready to use.

TPicture can load any registered (TPicture.RegisterFileFormat) Fileformat
and can save this in a dfm file. But its generic ReadData(Stream: TStream)
and WriteData(Stream: TStream) methods are private. The code shows how to get
access to these methods and how to store and load any registered TGraphic
descendant to/from stream/blobfield in a generic way. This means, to support
additional graphic formats it is only needed to add the units to the uses
clause - no changes in the store/load code are necessary. For instance,
Graphics.pas already register windows bitmap (TBitmap), windows icons
(TIcon), windows metafiles. Add "jpeg" to the uses clause of your program,
and jpeg files (TJpegImage) are ready to use.



TPictureFiler = class(TFiler)
public
ReadData: TStreamProc;
WriteData: TStreamProc;

constructor Dummy;

procedure DefineProperty(const Name: string;
ReadData: TReaderProc; WriteData: TWriterProc;
HasData: Boolean); override;

procedure DefineBinaryProperty(const Name: string;
ReadData, WriteData: TStreamProc;
HasData: Boolean); override;
procedure FlushBuffer; override;
end;

// Since I use TFiler only partially, the inherited constructor
TFiler.Create is unnecessary, so I use this dummy

constructor TPictureFiler.Dummy;
begin
end;

//will be called by TPicture, handing over the private methods to
read/write TPicture from/to Stream

procedure TPictureFiler.DefineBinaryProperty(const Name: string;
ReadData,WriteData: TStreamProc; HasData: Boolean);
begin
if Name = 'Data' then begin
Self.ReadData := ReadData;
Self.WriteData := WriteData;
end;
end;

procedure TPictureFiler.DefineProperty(const Name: string;
ReadData: TReaderProc; WriteData: TWriterProc; HasData: Boolean);
begin
//at this time TPicture don't call this function
//only implemented as precaution to (unlikely) changes in future
delphi versions
end;

procedure TPictureFiler.FlushBuffer;
begin
//at this time TPicture don't call this function
//only implemented as precaution to (unlikely) changes in future
delphi versions
end;

// Wrapper to call protected TPicture.DefineProperties
// must be in same unit as ReadWritePictureFromStream
type
TCrackPicture = class(TPicture)
end;

procedure ReadWritePictureFromStream(Picture: TPicture; Stream: TStream;
Read: Boolean);
var
Filer: TPictureFiler;
begin
Filer := TPictureFiler.Dummy;
try
//TPicture.DefineProperties is protected, but TMyPicture is
declared
in this unit
//TMyPicture's protected members (also the inherited) are public to
this unit
TCrackPicture(Picture).DefineProperties(Filer);
//TPicture.DefineProperties calls Filer.DefineBinaryProperty

if Read then
Filer.ReadData(Stream) //TPicture does the work
else
Filer.WriteData(Stream); //TPicture does the work
finally
Filer.Free;
end;
end;

//whatever TIcons actual image size, its LoadFromStream(Stream:
TStream)
reads just to the end of the stream
//if I have additional things after TIcon streamed, they are lost after
TIcon.LoadFromStream
//so I store the actual size before in the stream
procedure WritePictureToStream(Picture: TPicture; Stream: TStream);
var
MStream: TMemoryStream;
iPictureSize: Integer;
begin
MStream := TMemoryStream.Create;
try
ReadWritePictureFromStream(Picture, MStream, False); //store
TPicture data in TMemoryStream
iPictureSize := MStream.Size;
Stream.WriteBuffer(iPictureSize, sizeof(iPictureSize));//store size
of TPicture data in TStream
Stream.WriteBuffer(MStream.Memory^, iPictureSize);//store
TMemoryStream(containing TPicture data) in TStream
finally
MStream.Free;
end;
end;

procedure ReadPictureFromStream(Picture: TPicture; Stream: TStream);
var
MStream: TMemoryStream;
iPictureSize: Integer;
begin
MStream := TMemoryStream.Create;
try
Stream.ReadBuffer(iPictureSize, sizeof(iPictureSize));//read size of
TPicture data
MStream.SetSize(iPictureSize);//adjust buffer size
Stream.ReadBuffer(MStream.Memory^, iPictureSize);//get TPicture data
//why TMemoryStream ? See what I said above about TIcon
ReadWritePictureFromStream(Picture, MStream, True);//read TPicture
data
finally
MStream.Free;
end;
end;

//Now WritePictureToStream and ReadPictureFromStream could be used to
save/load any TPicture to/from any TStream.
//example (in pseudo code):

TStream := TDataSet.CreateBlobStream(TBlobField, bmWrite);
try
WritePictureToStream(TPicture, TStream);
finally
TStream.Free;
end;

TStream := TDataSet.CreateBlobStream(TBlobField, bmRead);
try
ReadPictureFromStream(TPicture, TStream);
finally
TStream.Free;
end;

//perhaps this looks a bit tricky, but I think changes to VCL and
//TPicture streaming system are very unlikely.