How to save / load any TPicture-contained TGraphic to / from a stream

Problem/Question/Abstract:

How to save / load any TPicture-contained TGraphic to / from a stream

Answer:

I have a general solution for storing (and loading back) any TPicture-contained TGraphic's into and from a stream (no need to know which TGraphic descendant is contained in the TPicture):


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

  constructor Create; overload;

  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.Create;
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 a 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
  TMyPicture = class(TPicture)
  end;

procedure ReadWritePictureFromStream(Picture: TPicture; Stream: TStream; Read: Boolean);
var
  Filer: TPictureFiler;
begin
  Filer := TPictureFiler.Create;
  try
    {TPicture.DefineProperties is protected, but TMyPicture is declared in this unit.
    TMyPicture's protected members (also the inherited) are public to this unit}
    TMyPicture(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 the VCL and TPicture streaming system are
very unlikely.