delphi 保存或加载图片成流TStream|笨鱼技术网

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.