Author: Tomas Rutkauskas
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):
1 TPictureFiler = class(TFiler)
2 public
3 ReadData: TStreamProc;
4 WriteData: TStreamProc;
5
6 constructor Create; overload;
7
8 procedure DefineProperty(const Name: string; ReadData: TReaderProc;
9 WriteData: TWriterProc; HasData: Boolean); override;
10 procedure DefineBinaryProperty(const Name: string; ReadData, WriteData:
11 TStreamProc;
12 HasData: Boolean); override;
13 procedure FlushBuffer; override;
14 end;
15
16 {Since I use TFiler only partially, the inherited constructor TFiler.Create is
17 unnecessary,
18 so I use this dummy}
19
20 constructor TPictureFiler.Create;
21 begin
22 end;
23
24 {Will be called by TPicture, handing over the private methods to read/write
25 TPicture from/to Stream}
26
27 procedure TPictureFiler.DefineBinaryProperty(const Name: string; ReadData,
28 WriteData: TStreamProc; HasData: Boolean);
29 begin
30 if Name = 'Data' then
31 begin
32 Self.ReadData := ReadData;
33 Self.WriteData := WriteData;
34 end;
35 end;
36
37 procedure TPictureFiler.DefineProperty(const Name: string; ReadData: TReaderProc;
38 WriteData: TWriterProc; HasData: Boolean);
39 begin
40 {At this time TPicture don't call this function. Only implemented as a precaution
41 to (unlikely) changes in future Delphi versions}
42 end;
43
44 procedure TPictureFiler.FlushBuffer;
45 begin
46 {At this time TPicture don't call this function. Only implemented as precaution
47 to (unlikely) changes in future Delphi versions}
48 end;
49
50 {Wrapper to call protected TPicture.DefineProperties. Must be in same unit
51 as ReadWritePictureFromStream}
52 type
53 TMyPicture = class(TPicture)
54 end;
55
56 procedure ReadWritePictureFromStream(Picture: TPicture; Stream: TStream; read:
57 Boolean);
58 var
59 Filer: TPictureFiler;
60 begin
61 Filer := TPictureFiler.Create;
62 try
63 {TPicture.DefineProperties is protected, but TMyPicture is declared in this
64 unit.
65 TMyPicture's protected members (also the inherited) are public to this unit}
66 TMyPicture(Picture).DefineProperties(Filer);
67 {TPicture.DefineProperties calls Filer.DefineBinaryProperty}
68 if read then
69 Filer.ReadData(Stream) {TPicture does the work}
70 else
71 Filer.WriteData(Stream); {TPicture does the work}
72 finally
73 Filer.Free;
74 end;
75 end;
76
77 {Whatever TIcons actual image size, its LoadFromStream(Stream: TStream) reads
78 just to the end of the stream. If I have additional things after TIcon streamed,
79 they
80 are lost after TIcon.LoadFromStream. So I store the actual size before in the
81 stream}
82
83 procedure WritePictureToStream(Picture: TPicture; Stream: TStream);
84 var
85 MStream: TMemoryStream;
86 iPictureSize: Integer;
87 begin
88 MStream := TMemoryStream.Create;
89 try
90 ReadWritePictureFromStream(Picture, MStream, False);
91 {Store TPicture data in TMemoryStream}
92 iPictureSize := MStream.Size;
93 Stream.WriteBuffer(iPictureSize, sizeof(iPictureSize));
94 {Store size of TPicture data in TStream}
95 Stream.WriteBuffer(MStream.Memory^, iPictureSize);
96 {Store TMemoryStream(containing TPicture data) in TStream}
97 finally
98 MStream.Free;
99 end;
100 end;
101
102 procedure ReadPictureFromStream(Picture: TPicture; Stream: TStream);
103 var
104 MStream: TMemoryStream;
105 iPictureSize: Integer;
106 begin
107 MStream := TMemoryStream.Create;
108 try
109 Stream.ReadBuffer(iPictureSize, sizeof(iPictureSize));
110 {Read size of TPicture data}
111 MStream.SetSize(iPictureSize); {adjust buffer size}
112 Stream.ReadBuffer(MStream.Memory^, iPictureSize); {get TPicture data}
113 {Why TMemoryStream ? See what I said above about TIcon}
114 ReadWritePictureFromStream(Picture, MStream, True); {read TPicture data}
115 finally
116 MStream.Free;
117 end;
118 end;
119
120
121 //Now WritePictureToStream and ReadPictureFromStream could be used to save/load any
122 TPicture to / from any TStream. Example (in pseudo code):
123
124
125 TStream := TDataSet.CreateBlobStream(TBlobField, bmWrite);
126 try
127 WritePictureToStream(TPicture, TStream);
128 finally
129 TStream.Free;
130 end;
131
132 TStream := TDataSet.CreateBlobStream(TBlobField, bmRead);
133 try
134 ReadPictureFromStream(TPicture, TStream);
135 finally
136 TStream.Free;
137 end;
Perhaps this looks a bit tricky, but I think changes to the VCL and TPicture
streaming system are
very unlikely.
|
