把几张图片以流的方式存在同一个表字段中,而读取时如何区分它们 ?(流的基本操作)(50分)

// 版权所有 cjsh
unit MGraphics;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, jpeg, Contnrs;

type
TMultiGraphic = class
private
FGraphics: TObjectList;
function GetCount: Integer;
function GetItem(index: Integer): TGraphic;
public
constructor Create;
destructor Destroy; override;
procedure Clear;
procedure Add(Graphic: TGraphic);
procedure Delete(Index: Integer);
procedure LoadFromFile(const FileName: string); virtual;
procedure LoadFromStream(Stream: TStream);
procedure SaveToFile(const FileName: string); virtual;
procedure SaveToStream(Stream: TStream);
property Count: Integer read GetCount;
property Items[index: Integer]: TGraphic read GetItem;
end;

implementation

function ReadInt(Stream: TStream): Word;
begin
Stream.ReadBuffer(Result, SizeOf(Word));
end;

procedure WriteInt(Stream: TStream; I: Word);
begin
Stream.WriteBuffer(I, SizeOf(Word));
end;

function ReadStr(Stream: TStream): string;
var
L: Word;
begin
Stream.ReadBuffer(L, SizeOf(Word));
SetString(Result, PChar(nil), L);
if L > 0 then Stream.ReadBuffer(Result[1], L);
end;

procedure WriteStr(Stream: TStream; const S: string);
var
L: Integer;
begin
L := Length(S);
if L > $FFFF then L := $FFFF;
Stream.WriteBuffer(L, SizeOf(Word));
if L > 0 then Stream.WriteBuffer(S[1], L);
end;

function ReadGraphic(Stream: TStream): TGraphic;
var
L: Int64;
ClassName: string;
InstanceClass: TPersistentClass;
MS: TMemoryStream;
begin
ClassName := ReadStr(Stream);
InstanceClass := FindClass(ClassName);
Result := TGraphic(InstanceClass.NewInstance);
Result.Create;
Stream.ReadBuffer(L, SizeOf(Int64));
if L > 0 then
begin
MS := TMemoryStream.Create;
try
MS.CopyFrom(Stream, L);
MS.Position := soFromBeginning;
Result.LoadFromStream(MS);
finally
MS.Free;
end;
end;
end;

procedure WriteGraphic(Stream: TStream; G: TGraphic);
var
L: Int64;
ClassName: string;
MS: TMemoryStream;
begin
ClassName := G.ClassName;
WriteStr(Stream, ClassName);
MS := TMemoryStream.Create;
try
G.SaveToStream(MS);
L := MS.Size;
Stream.WriteBuffer(L, SizeOf(Int64));
if L > 0 then
begin
MS.Position := soFromBeginning;
Stream.CopyFrom(MS, 0);
end;
finally
MS.Free;
end;
end;

{ TMultiGraphic }

constructor TMultiGraphic.Create;
begin
FGraphics := TObjectList.Create;
end;

destructor TMultiGraphic.Destroy;
begin
FGraphics.Free;
inherited;
end;

procedure TMultiGraphic.Clear;
begin
FGraphics.Clear;
end;

procedure TMultiGraphic.Add(Graphic: TGraphic);
begin
FGraphics.Add(Graphic);
end;

procedure TMultiGraphic.Delete(Index: Integer);
begin
FGraphics.Delete(Index);
end;

function TMultiGraphic.GetCount: Integer;
begin
Result := FGraphics.Count;
end;

function TMultiGraphic.GetItem(index: Integer): TGraphic;
begin
Result := FGraphics[index] as TGraphic;
end;

procedure TMultiGraphic.LoadFromStream(Stream: TStream);
var
lCount: Word;
I: Integer;
G: TGraphic;
begin
Clear;
lCount := ReadInt(Stream);
for I := 0 to lCount-1 do
begin
G := ReadGraphic(Stream);
Add(G);
end;
end;

procedure TMultiGraphic.SaveToStream(Stream: TStream);
var
lCount: Word;
I: Integer;
G: TGraphic;
begin
lCount := Count;
WriteInt(Stream, lCount);
for I := 0 to lCount-1 do
begin
G := Items;
WriteGraphic(Stream, G);
end;
end;

procedure TMultiGraphic.LoadFromFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
LoadFromStream(Stream);
finally
Stream.Free;
end;
end;

procedure TMultiGraphic.SaveToFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmCreate);
try
SaveToStream(Stream);
finally
Stream.Free;
end;
end;

begin
RegisterClasses([TBitmap, TIcon, TMetafile, TJPEGImage]);

end.

// 版权所有 cjsh
unit Main;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, jpeg, ImgList;

type
TfrmMain = class(TForm)
Button1: TButton;
Button2: TButton;
Panel2: TPanel;
Image2: TImage;
Panel1: TPanel;
Image1: TImage;
procedure Image1DblClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
frmMain: TfrmMain;

implementation

uses MGraphics;

{$R *.dfm}

procedure TfrmMain.Image1DblClick(Sender: TObject);
var
Dlg: TOpenDialog;
begin
Dlg := TOpenDialog.Create(nil);
try
if Dlg.Execute then
TImage(Sender).Picture.LoadFromFile(Dlg.FileName);
finally
Dlg.Free;
end;
end;

procedure TfrmMain.Button1Click(Sender: TObject);
var
MGraphic: TMultiGraphic;
Graphic: TGraphic;
begin
MGraphic := TMultiGraphic.Create;
try
Graphic := TGraphicClass(Image1.Picture.Graphic.ClassType).Create;
Graphic.Assign(Image1.Picture.Graphic);
MGraphic.Add(Graphic);
Graphic := TGraphicClass(Image2.Picture.Graphic.ClassType).Create;
Graphic.Assign(Image2.Picture.Graphic);
MGraphic.Add(Graphic);
MGraphic.SaveToFile('c:/m.dat');
finally
MGraphic.Free;
end;
end;

procedure TfrmMain.Button2Click(Sender: TObject);
var
MGraphic: TMultiGraphic;
Graphic: TGraphic;
I: Integer;
begin
MGraphic := TMultiGraphic.Create;
try
MGraphic.LoadFromFile('c:/m.dat');
for I := 0 to MGraphic.Count-1 do
begin
Graphic := MGraphic.Items;
if I = 0 then
Image1.Picture.Graphic := Graphic
else
Image2.Picture.Graphic := Graphic;
end;
finally
MGraphic.Free;
end;
end;

end.

object frmMain: TfrmMain
Left = 189
Top = 153
Width = 379
Height = 411
Caption = 'frmMain'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 201
Top = 115
Width = 75
Height = 25
Caption = 'Write'
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 201
Top = 151
Width = 75
Height = 25
Caption = 'Read'
TabOrder = 1
OnClick = Button2Click
end
object Panel2: TPanel
Left = 16
Top = 184
Width = 169
Height = 145
Caption = 'Panel1'
TabOrder = 2
object Image2: TImage
Left = 1
Top = 1
Width = 167
Height = 143
Align = alClient
OnDblClick = Image1DblClick
end
end
object Panel1: TPanel
Left = 16
Top = 16
Width = 169
Height = 145
Caption = 'Panel1'
TabOrder = 3
object Image1: TImage
Left = 1
Top = 1
Width = 167
Height = 143
Align = alClient
OnDblClick = Image1DblClick
end
end
end

以上的方法可以满足你的要求。