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;

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;

  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;

    end;

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;

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;

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就是这样做。有兴趣者自己完成吧。