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*****

David Heffernan · Accepted Answer · 2016-03-17 11:55:51Z

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.

edited Mar 17, 2016 at 11:55

answered Mar 17, 2016 at 11:38

David Heffernan

616k46 gold badges1.1k silver badges1.5k bronze badges

Sign up to request clarification or add additional context in comments.

3 Comments

Remy Lebeau Over a year ago

Since the array is being custom-streamed anyway, I would suggest having WriteIntArr() write the array count before writing the actual array data. Then ReadIntArr() can read the count first and pre-allocate the array one time before then filling it, instead of re-allocating it on each loop iteration. This would also allow removing the ListBegin and ListEnd markers from the DFM as well.

David Heffernan Over a year ago

If it were me I'd probably opt for TList<T>, the Add method, and avoid having to write of redundant length info.

David Heffernan Over a year ago

@Remy No, it doesn't do that. It grows the list with a Capacity that can differ from the Count.

Remy Lebeau · Accepted Answer · 2016-03-18 03:04:54Z

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;

zlee · Accepted Answer · 2016-03-18 03:19:51Z

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.

Collectives™ on Stack Overflow

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

3 Answers 3

3 Comments

Comments

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

3 Comments

Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Related