Delphi的RTL自身就带有一套非常好的资源持久化保存(IDE设计窗口时,保存为DFM格式及编译到EXE里面的资源文件)及恢复机制(EXE启动时对窗口资源的载入),那么应不是必需再额外用xml/json格式保存程序的參数了。我们大能够将參数集中在一个參数类里面,然后通过这套机制进行保存及恢复。
因为我们的參数类型可能五花八门。除了传统的整数、小数、字符串、true/false、还有可能是数组、列表、枚举等,则须要override DefineProperties这个函数来自己定义属性的保存及恢复。
废话少说,给出代码,此代码演示了怎样自己定义数据的保存及恢复、以及保存整个Form:
go
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TArrayOfInteger = array of integer;
TSetting = class(TComponent)
private
fIntVal: integer;
fIntArr: TArrayOfInteger;
procedure ReadIntArr(Reader: TReader);
procedure WriteIntArr(Writer: TWriter);
protected
procedure DefineProperties(Filer: TFiler); override;
public
property intArr: TArrayOfInteger read fIntArr write fIntArr;
published
property intval: integer read fIntVal write fIntVal;
end;
TForm1 = class(TForm)
btnCloneClass: TButton;
mmo1: TMemo;
btnCloneForm: TButton;
procedure btnCloneClassClick(Sender: TObject);
procedure btnCloneFormClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TSetting }
procedure TSetting.DefineProperties(Filer: TFiler);
begin
inherited;
Filer.DefineProperty('intArr', ReadIntArr, WriteIntArr, true);
end;
procedure TSetting.ReadIntArr(Reader: TReader);
var
lvIdx: integer;
begin
fIntArr := nil;
Reader.ReadListBegin;
SetLength(fIntArr,Reader.ReadInteger);
lvIdx:=low(fIntArr);
while not Reader.EndOfList do
begin
fIntArr[lvIdx] := Reader.ReadInteger;
inc(lvIdx);
end;
Reader.ReadListEnd;
end;
procedure TSetting.WriteIntArr(Writer: TWriter);
var
i: integer;
begin
Writer.WriteListBegin;
Writer.WriteInteger(integer(Length(fIntArr)));
for i := Low(fIntArr) to High(fIntArr) do
begin
Writer.WriteInteger(fIntArr[i]);
end;
Writer.WriteListEnd;
end;
function ClassToStr(pvClass: TComponent): ansiString;
var
inStream, outStream: TMemoryStream;
begin
inStream := TMemoryStream.Create;
outStream := TMemoryStream.Create;
try
inStream.WriteComponentRes(pvClass.ClassName, pvClass);
// inStream.WriteComponent(pvClass);
inStream.Position := 0;
ObjectResourceToText(inStream, outStream);
// ObjectBinaryToText(inStream,outStream);
outStream.Position := 0;
SetLength(Result, outStream.Size + 1);
FillChar(Result[1], outStream.Size + 1, 0);
outStream.ReadBuffer(Result[1], outStream.Size);
finally
FreeAndNil(inStream);
FreeAndNil(outStream);
end;
end;
function StrToClass(pvStr: ansiString; pvCmpToSetProperties: TComponent=nil): TComponent;
var
inStream, outStream: TMemoryStream;
begin
inStream := TMemoryStream.Create;
outStream := TMemoryStream.Create;
try
if (pvStr <> '') then
inStream.WriteBuffer(pvStr[1], length(pvStr));
inStream.Position := 0;
ObjectTextToResource(inStream, outStream);
// ObjectTextToBinary(inStream,outStream);
outStream.Position := 0;
Result := outStream.ReadComponentRes(pvCmpToSetProperties);
finally
FreeAndNil(inStream);
FreeAndNil(outStream);
end;
end;
procedure TForm1.btnCloneClassClick(Sender: TObject);
var
lvObj, lv1: TSetting;
lvStr: String;
lvArr: TArrayOfInteger;
begin
lvObj := TSetting.Create(nil);
try
lvObj.intval := 12345;
SetLength(lvArr, 3);
lvArr[0] := 222;
lvArr[1] := 333;
lvArr[2] := 444;
lvObj.intArr := lvArr;
lvStr := ClassToStr(lvObj);
RegisterClass(TSetting);
lvObj.intval := 1;
lv1 := TSetting(StrToClass(lvStr, nil));
if (lv1.intval > lvObj.intval) then
mmo1.Text := lvStr;
finally
FreeAndNil(lvObj);
FreeAndNil(lv1);
end;
// WriteComponentResFile(ExtractFilePath(ParamStr(0))+ 'd.res',self);
end;
procedure TForm1.btnCloneFormClick(Sender: TObject);
var lvNewForm:TForm1;
lvRes:string;
begin
lvRes:=ClassToStr(self);
RegisterClass(TForm1);
lvNewForm:=TForm1.CreateNew(application);
StrToClass(lvRes,lvNewForm);
lvNewForm.Left:=self.Left+50;
lvNewForm.Top:=self.Top+50;
end;
end.