如何在动态数组的自定义类对象中使用DefineProperties - Delphi

Question

我正在尝试创建自己的类对象并使用它来为我的应用程序存储各种数据类型，这在使用已发布的属性时工作正常，我可以将这些流传输到磁盘并且没有任何问题。但我也需要流式传输一些动态整数类型的数组。

            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;
              published
                property intval: integer read fIntVal write fIntVal;
                property intArr: TArrayOfInteger read fIntArr write fIntArr;
              end;

            { TSetting }

            procedure TSetting.DefineProperties(Filer: TFiler);
            begin
              inherited;
              Filer.DefineProperty('intArr', ReadIntArr, WriteIntArr, true);
            end;
            procedure TSetting.ReadIntArr(Reader: TReader);
            var
              i: integer;
              lvVal:Integer;
            begin
              i:=low(fintArr);
              Reader.ReadListBegin;
              {j := Reader.ReadInteger();
              setlength(fIntArr, j);
              for i := 0 to j - 1 do
              begin
                fIntArr[i] := Reader.ReadInteger();
              end;}
            while not Reader.EndOfList do begin
                fIntArr[i]:=Reader.ReadInteger;
                Inc(i);
              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;pvComponent:TComponent):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(pvComponent); //*****Exception Fired*****
                //result:=outStream.ReadComponent(pvComponent);
              finally
                FreeAndNil(inStream);
                FreeAndNil(outStream);
              end;

            end;

            =============
            //test
            procedure TForm1.btn5Click(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,lvObj));
                if (lv1.intval>0) then
                mmo1.Text:=lvStr;
              finally
                FreeAndNil(lvObj);
              end;
              // WriteComponentResFile(ExtractFilePath(ParamStr(0))+ 'd.res',self);
            end;

            //First chance exception at $77925B68. Exception class EReadError with message 'Property  does not exist'. Process Project1.exe (23512)

            //First chance exception at $77925B68. Exception class EReadError with message 'Error reading TSetting.: Property  does not exist'. Process Project1.exe (23512)


result:=outStream.ReadComponentRes(pvComponent); //*****Exception Fired*****

Answer 1

您在阅读时没有分配数组。你可以这样做：

procedure TSetting.ReadIntArr(Reader: TReader);
begin
  fIntArr := nil;
  Reader.ReadListBegin;
  while not Reader.EndOfList do begin
    SetLength(fIntArr, Length(fIntArr) + 1);
    fIntArr[high(fIntArr)] := Reader.ReadInteger;
  end;
  Reader.ReadListEnd;
end;

您需要做的另一项更改是将intArr移至公共财产。您无法发布它，也可以在DefineProperties中定义具有相同名称的属性。

我对你使用AnsiString有点怀疑。如果是非ASCII字符，我会期望UTF-8编码的字节。也许您应该使用指定了适当编码的字符串流。

就我个人而言，我对使用表单流以这种方式持怀疑态度。我更喜欢使用标准格式，如JSON。

Answer 2

在将数据读入数据之前，您没有分配数组。你是在正确的轨道上WriteIntArr()保存数组长度和ReadIntArr()根据该值分配数组，所以你应该重新启用该逻辑，例如：

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;

{ TSetting }

procedure TSetting.DefineProperties(Filer: TFiler);
begin
  inherited;
  Filer.DefineProperty('intArr', ReadIntArr, WriteIntArr, true);
end;

procedure TSetting.ReadIntArr(Reader: TReader);
var
  i: integer;
begin
  i := Reader.ReadInteger;
  SetLength(fIntArr, i);
  for i := Low(fIntArr) to High(fIntArr) do
    fIntArr[i] := Reader.ReadInteger;
end;

procedure TSetting.WriteIntArr(Writer: TWriter);
var
  i: integer;
begin
  Writer.WriteInteger(Length(fIntArr));
  for i := Low(fIntArr) to High(fIntArr) do
    Writer.WriteInteger(fIntArr[i]);
end;

可替换地：

type
  TArrayOfInteger = array of integer;

  TSetting = class(TComponent)
  private
    fIntVal: integer;
    fIntArr: TArrayOfInteger;
    procedure ReadIntArr(Stream: TStream);
    procedure WriteIntArr(Stream: TStream);
  protected
    procedure DefineProperties(Filer: TFiler); override;
  public
    property intArr: TArrayOfInteger read fIntArr write fIntArr;
  published
    property intval: integer read fIntVal write fIntVal;
  end;

{ TSetting }

procedure TSetting.DefineProperties(Filer: TFiler);
begin
  inherited;
  Filer.DefineBinaryProperty('intArr', ReadIntArr, WriteIntArr, true);
end;

procedure TSetting.ReadIntArr(Stream: TStream);
var
  i: integer;
begin
  Stream.ReadBuffer(i, SizeOf(Integer));
  SetLength(fIntArr, i);
  for i := Low(fIntArr) to High(fIntArr) do
    Stream.ReadBuffer(fIntArr[i], SizeOf(Integer));
end;

procedure TSetting.WriteIntArr(Stream: TStream);
var
  i: integer;
begin
  i := Length(fIntArr);
  Stream.WriteBuffer(i, SizeOf(Integer));
  for i := Low(fIntArr) to High(fIntArr) do
    Stream.WriteBuffer(fIntArr[i], SizeOf(Integer));
end;

Answer 3

我修改了源代码，它给了一个如何克隆用户类并克隆表单的恶魔。它奏效了。

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.