Delphi 持久化

在论坛上常见到有帖子问如何拷贝控件的问题。其实Delphi提供了非常好的持久化机制，笔者写了一个类，提供两个方法，一个是将多个控件保存到流中，另一个是从流中读出控件。

下面是源代码：

unit ComPersist;

interface

uses

Windows, Classes, Controls;

type

TComPersister = class

private

FRoot: TComponent;

protected

function UniqueName(BaseName: string): string; virtual;

procedure ReaderSetName(Reader: TReader; Component: TComponent;

var Name: string);

procedure ReaderReadComponent(Component: TComponent); virtual;

public

procedure SaveComsToStream(AStream: TStream; ComList: TList);

procedure LoadComsFromStream(AStream: TStream; AParent: TWinControl);

constructor Create(ARoot: TComponent);

property Root: TComponent read FRoot write FRoot;

end;

implementation

uses

SysUtils;

{ TComPersister }

constructor TComPersister.Create(ARoot: TComponent);

begin

FRoot := ARoot;

end;

procedure TComPersister.LoadComsFromStream(AStream: TStream;

AParent: TWinControl);

var

Reader: TReader;

begin

Reader := TReader.Create(AStream, 1024);

try

Reader.OnSetName := ReaderSetName;

Reader.ReadComponents(FRoot, AParent, ReaderReadComponent);

finally

Reader.Free;

end;

procedure TComPersister.ReaderReadComponent(Component: TComponent);

function ControlExist (AParent: TWinControl; ALeft, ATop: Integer): Boolean;

var

LI: Integer;

begin

Result := False;

for LI := 0 to AParent.ControlCount - 1 do

if AParent.Controls [LI] <> Component then

with AParent.Controls [LI] do

if (Left = ALeft) and (Top = ATop) then

begin

Result := True;

Break;

end;

var

LNewLeft, LNewTop: Integer;

begin

if Component is TControl then

with TControl(Component) do

begin

if Parent <> nil then

begin

LNewLeft := Left;

LNewTop := Top;

while ControlExist(Parent, LNewLeft, LNewTop) do

begin

Inc (LNewLeft, 8);

Inc (LNewTop, 8);

end;

SetBounds (LNewLeft, LNewTop, Width, Height);

end;

procedure TComPersister.ReaderSetName(Reader: TReader;

Component: TComponent; var Name: string);

begin

//给控件取一个唯一的名字

if FRoot.FindComponent (Name) <> nil then

Name := UniqueName(Component.ClassName);

end;

procedure TComPersister.SaveComsToStream(AStream: TStream; ComList: TList);

var

Writer: TWriter;

i: Integer;

begin

Writer := TWriter.Create(AStream, 1024);

try

Writer.Root := FRoot;

for i := 0 to ComList.Count - 1 do

begin

Writer.WriteSignature;

Writer.WriteComponent(ComList[i]);

end;

Writer.WriteListEnd;

finally

Writer.Free;

end;

function TComPersister.UniqueName(BaseName: string): string;

var

i: Integer;

LS: string;

begin

if (Length(BaseName) >= 2) and (BaseName[1] in ['t', 'T']) then

LS := Copy (BaseName, 2, MaxInt);

i := 0;

repeat

Inc(i);

Result := LS + IntToStr(i);

until FRoot.FindComponent (Result) = nil;

end;

end.

下面是新建一个窗体，代码如下：

TForm1 = class(TForm)

BtnSave: TButton;

BtnLoad: TButton;

Button3: TButton;

Panel1: TPanel;

Button4: TButton;

procedure BtnSaveClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure BtnLoadClick(Sender: TObject);

private

{ Private declarations }

ComPersist: TComPersister;

MStream: TMemoryStream;

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.BtnSaveClick(Sender: TObject);

var

List: TList;

begin

List := TList.Create;

MStream.Clear;

try

List.Clear;

List.Add(Panel1);

List.Add(Button3);

ComPersist.SaveComsToStream(MStream, List);

finally

List.Free;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

ComPersist := TComPersister.Create(self);

MStream := TMemoryStream.Create;

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

ComPersist.Free;

MStream.Free;

end;

procedure TForm1.BtnLoadClick(Sender: TObject);

begin

MStream.Position := 0;

ComPersist.LoadComsFromStream(MStream, Self);

end;

end.

说明：类中有一个FRoot成员，在类的构造方法中指明，是指拷贝的控件的根和最终拥有者，一般情况下都是窗体，所以一般要在构造方法中传入窗体类，像上面那样：

ComPersist := TComPersister.Create(self);

将控件保存为流的方法是建一个List类，将要保存的控件加进去，然后调用：

ComPersist.SaveComsToStream(MStream, List);其中的MStream即是最后保存的流。

要将控件从流中读出来，只需要：

MStream.Position := 0;

ComPersist.LoadComsFromStream(MStream, Self);

其中的Self是指控件读出来后的Parent，如果把Self改为Panel1，则读出的控件最后将显示在Panel1当中。

另外，如果要做到真正意义上的拷贝，粘贴，和剪切，则需要剪贴板的知识，定义一个自己的格式，然后将流中的数据保存到剪贴板上，这就是拷贝，如果要粘贴，则从剪贴板上读出流，再调用上面的方法还原为控件。用剪贴板的好处是即使程序关闭了，下次打开，也可以从剪贴板中取出控件来。Delphi的IDE就是这样做。有兴趣者自己完成吧。