Delphi的RTL自身就带有一套非常好的资源持久化保存(IDE设计窗口时,保存为DFM格式及编译到EXE里面的资源文件)及恢复机制(EXE启动时对窗口资源的载入),那么应不是必需再额外用xml/json格式保存程序的參数了。我们大能够将參数集中在一个參数类里面,然后通过这套机制进行保存及恢复。
因为我们的參数类型可能五花八门。除了传统的整数、小数、字符串、true/false、还有可能是数组、列表、枚举等,则须要override DefineProperties这个函数来自己定义属性的保存及恢复。
废话少说,给出代码,此代码演示了怎样自己定义数据的保存及恢复、以及保存整个Form:
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.