• Delphi语言怎样对自己定义类进行持久化保存及恢复 (性能远比json/xml高)


            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.
    	
    	


  • 相关阅读:
    XX需求分析系统每日进度(二)
    XX需求分析系统每日进度(一)
    周总结(二)
    Hyperleder Fabric chaincode生命周期
    【转】六种学术不端的引用行为
    引导学生,让学生不走神。
    MySQL 的常用引擎
    LeetCode283移动零问题java高效解法
    使用android studio进行springboot项目的开发
    android逆向反编译工具包下载
  • 原文地址:https://www.cnblogs.com/zsychanpin/p/7084228.html
Copyright © 2020-2023  润新知