How to use DefineProperties in a custom Class Object for dynamic Arrays - Delphi

Question

I'm trying to create my own class object and use it to store various data types for my application, this all works fine when using Published Properties, I can stream these to disk and back with no problems. But I need to stream some dynamic Arrays of integer types as well.

            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

I modified the source, it give a demon that how to clone a user class and clone a form . It worked.

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.

Answer 2

You are not allocating the array before reading data into it. You were on the right track to have WriteIntArr() save the array length and ReadIntArr() to allocate the array based on that value, so you should re-enable that logic, eg:

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;

Alternatively:

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

You are not allocating the array when reading it. You could do that like so:

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;

The other change that you need to make is to move intArr to be a public property. You cannot have it published, and also define a property with the same name in DefineProperties.

I am somewhat dubious of your use of AnsiString. I would have expected UTF-8 encoded bytes in case of non-ASCII characters. Perhaps you should be using a string stream with the appropriate encoding specified.

Personally I am rather sceptical of using form streaming in this way. I would prefer to use a standard format such as JSON.