How to use DefineProperties in a custom Class Object for 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 Arrays of both integer and strings data types as well.

I understand that Arrays, amongst other data types can't be published properties because Delphi doesn't know how to stream them, I was led to believe you need to use DefineProperties to accomplish this, I've created a test Array of String as a Public property, I can read and write to it just fine, however I need to stream it to disk so i can save it for future use.

The only thing i can find that touches on this subject is here:

Array of a custom class as a property

I've attempted to copy this code and manipulate it to archive what I need but I cannot get it to save, I'm seemingly missing something obvious, my test code I'm using is below, I get no errors with this code, published properties stream to disk ok but my private array does not. Any help would be greatly appreciated.

Thanks.

unit UnitDataSet;

//------------------------------------------------------------------------------

interface

uses System.Classes;
 {$M+}

//------------------------------------------------------------------------------

type
  TDataStrings = Array [1..50] of String;

  TDataSet = class(TComponent)
  protected
    procedure DefineProperties(Filer: TFiler); override;
    procedure ReadArray(Reader: TReader);
    procedure WriteArray(Writer: TWriter);

  private
    FArrayToSave : TDataStrings;
    FPStr        : String;

    function  GetItem(I: Integer): String;
    procedure SetItem(I: Integer; Value: string);

  public
    constructor Create(aOwner: TComponent); override;
    destructor  Destroy; override;

    procedure LoadFromStream(const Stream: TStream);
    procedure LoadFromFile(const FileName: string);
    procedure SaveToStream(const Stream: TStream);
    procedure SaveToFile(const FileName: string);

    property Items[I: Integer]: String read GetItem write SetItem;

  published

    property StringItem : String read FPStr write FPStr;

  end;

//------------------------------------------------------------------------------

var
  DataSet: TDataSet;

implementation

uses TypInfo, Sysutils;

{ TDataSet }

//------------------------------------------------------------------------------

procedure TDataSet.DefineProperties(Filer: TFiler);
begin
  inherited;
  Filer.DefineProperty('DataArray', ReadArray, WriteArray, True);
end;

//------------------------------------------------------------------------------

destructor TDataSet.Destroy;
begin
  inherited;
end;

//------------------------------------------------------------------------------

function TDataSet.GetItem(I: Integer): string;
begin
  Result := '';
  if (I > 0) and (I < Length(FArrayToSave)) then
    Result := FArrayToSave[I];
end;

//------------------------------------------------------------------------------

procedure TDataSet.SetItem(I: Integer; Value: string);
begin
  if (I > 0) and (I < Length(FArrayToSave)) then
    FArrayToSave[I] := Value;
end;

//------------------------------------------------------------------------------

procedure TDataSet.LoadFromFile(const FileName: string);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

//------------------------------------------------------------------------------

procedure TDataSet.LoadFromStream(const Stream: TStream);
var
  Reader: TReader;
  PropName, PropValue: string;
begin
  Reader := TReader.Create(Stream, $FFF);
  Stream.Position := 0;
  Reader.ReadListBegin;

  while not Reader.EndOfList do
  begin
    PropName := Reader.ReadString;
    PropValue := Reader.ReadString;
    SetPropValue(Self, PropName, PropValue);
  end;
   FreeAndNil(Reader);
end;

//------------------------------------------------------------------------------

procedure TDataSet.SaveToFile(const FileName: string);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(Stream);
  finally
    Stream.Free;
  end;
end;

//------------------------------------------------------------------------------

procedure TDataSet.SaveToStream(const Stream: TStream);
var
  PropName, PropValue: string;
  cnt: Integer;
  lPropInfo: PPropInfo;
  lPropCount: Integer;
  lPropList: PPropList;
  lPropType: PPTypeInfo;
  Writer: TWriter;
begin
  lPropCount := GetPropList(PTypeInfo(ClassInfo), lPropList);
  Writer := TWriter.Create(Stream, $FFF);
  Stream.Size := 0;
  Writer.WriteListBegin;
  for cnt := 0 to lPropCount - 1 do
  begin
    lPropInfo := lPropList^[cnt];
    lPropType := lPropInfo^.PropType;
    if lPropType^.Kind = tkMethod then Continue;
     PropName := lPropInfo.Name;
    PropValue := GetPropValue(Self, lPropInfo);
    Writer.WriteString(PropName);
    Writer.WriteString(PropValue);
  end;
  Writer.WriteListEnd;
  FreeAndNil(Writer);
end;

//------------------------------------------------------------------------------

constructor TDataSet.Create(aOwner: TComponent);
begin
  inherited;

end;

//------------------------------------------------------------------------------

procedure TDataSet.ReadArray(Reader: TReader);
var
  N: Integer;
begin
  N := 0;
  Reader.ReadListBegin;
  while not Reader.EndOfList do begin
    Reader.ReadListBegin;
    FArrayToSave[N] := Reader.ReadString;
    Reader.ReadListEnd;
    Inc(N);
  end;
  Reader.ReadListEnd;

end;

//------------------------------------------------------------------------------

procedure TDataSet.WriteArray(Writer: TWriter);
var
  I: Integer;
begin
  Writer.WriteListBegin;
  for I := 1 to High(FArrayToSave) do begin
    Writer.WriteListBegin;
    Writer.WriteString(FArrayToSave[I]);
    Writer.WriteListEnd;
  end;
  Writer.WriteListEnd;
end;


//------------------------------------------------------------------------------

initialization
  DataSet := TDataSet.Create(Nil);
finalization
  FreeAndNil(DataSet);
end.

//------------------------------------------------------------------------------

Here is my Class code re-written with Arioch's suggested code modifications from below:

unit UnitCharSett;

interface

//------------------------------------------------------------------------------

uses System.Classes;

//------------------------------------------------------------------------------

type

  TCustomDatSetA = Array [0..99] of String;

  TCustomCharSet = class(TComponent)
  public
    procedure LoadFromStream(const Stream: TStream);
    procedure LoadFromFile(const FileName: string);
    procedure SaveToStream(const Stream: TStream);
    procedure SaveToFile(const FileName: string);
  end;

  TZCharSet = class(TCustomCharSet)

  private

    FFullArray : TCustomDatSetA;
    function  GetItem(I: Integer): String;
    procedure SetItem(I: Integer; Value: string);

  protected

    procedure DefineProperties(Filer: TFiler); override;
    procedure ReadArray(Reader:TReader);
    procedure WriteArray(Writer:TWriter);

  public

    property Items[Index: Integer]: string read GetItem write SetItem;

  published

  end;

//------------------------------------------------------------------------------

implementation

uses

  System.TypInfo, System.SysUtils;

//------------------------------------------------------------------------------

procedure TCustomCharSet.LoadFromFile(const FileName: string);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

//------------------------------------------------------------------------------

procedure TCustomCharSet.LoadFromStream(const Stream: TStream);
begin
  Stream.ReadComponent(Self);
end;

//------------------------------------------------------------------------------

procedure TCustomCharSet.SaveToFile(const FileName: string);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(Stream);
  finally
    Stream.Free;
  end;
end;

//------------------------------------------------------------------------------

procedure TCustomCharSet.SaveToStream(const Stream: TStream);
begin
 Stream.WriteComponent(Self);
end;

//------------------------------------------------------------------------------

{ TZCharSett }

//------------------------------------------------------------------------------

procedure TZCharSet.DefineProperties(Filer: TFiler);
begin
  inherited;
  Filer.DefineProperty('DataArray', ReadArray, WriteArray, True);
end;

//------------------------------------------------------------------------------

function TZCharSet.GetItem(I: Integer): string;
begin
  Result := '';
  if (I > -1) and (I < Length(FFullArray)) then
    Result := FFullArray[I];
end;

//------------------------------------------------------------------------------

procedure TZCharSet.ReadArray(Reader: TReader);
var
  N: Integer;
  S: String;
begin
  for N := Low(FFullArray) to High(FFullArray) do begin
    FFullArray[N] := '';
  end;
  Reader.ReadListBegin;
  N := Reader.ReadInteger;
  if N = Length(FFullArray) then
   begin
     N := Low(FFullArray);
     while not Reader.EndOfList do
      begin
       S := Reader.ReadString;
       if N <= High(FFullArray) then
         FFullArray[N] := S;
       Inc(N);
      end;
  end;
  Reader.ReadListEnd;
end;

//------------------------------------------------------------------------------

procedure TZCharSet.SetItem(I: Integer; Value: string);
begin
  if (I > -1) and (I < Length(FFullArray)) then
    FFullArray[I] := Value;
end;

//------------------------------------------------------------------------------

procedure TZCharSet.WriteArray(Writer: TWriter);
var
  I: Integer;
begin
  Writer.WriteListBegin;
  Writer.WriteInteger(Length(FFullArray));
  for I := Low(FFullArray) to High(FFullArray) do begin
    Writer.WriteString(FFullArray[I]);
  end;
  Writer.WriteListEnd;
end;

//------------------------------------------------------------------------------

initialization

  RegisterClasses([TZCharSet]);

//------------------------------------------------------------------------------

end.

Surely the simple answer to your actual question is to create a TFileStream and call WriteComponent. — David Heffernan
– David Heffernan, Commented Dec 18, 2013 at 16:16
The indexing in ReadArray is off by one. It starts at zero. Incidentally, using 1-based arrays in Delphi is asking for confusion. Prefer zero based arrays. In fact, prefer dynamic arrays. FArrayToSave appears to be badly named. Looks rather odd when you use it in ReadArray. The if statements in GetItem and SetItem look bad. They encourage consumers of the code to pass invalid indices and never find out that they got it wrong. I think you need to fix the basics before you proceed. — David Heffernan
– David Heffernan, Commented Dec 18, 2013 at 16:27
"for I := 1 to High(FArrayToSave)" - weird, either "1 to 50" or "Low to High". And Read array should hav sanity check to not write elements 51, 52, etc (if corrupt DFM or new version of component would create dfm with longer arrays) — Arioch 'The
– Arioch 'The, Commented Dec 18, 2013 at 16:29
won't the name of the class TDataSet clash wth a STOCK TDataSet ? — Arioch 'The
– Arioch 'The, Commented Dec 18, 2013 at 16:33

Arioch 'The · Accepted Answer · 2013-12-30 14:50:07Z

2

HOW do you actually try to read and write it ? I think you're trying to make complex incompatible things when there instead of using standard methods.

Why not to use standard VCL streaming procedures?

procedure TMyDataSet.SaveToStream(const Stream: TStream);
begin
   Stream.WriteComponent(self);
end;

procedure TMyDataSet.LoadFromStream(const Stream: TStream);
begin
   Stream.ReadComponent(self);
end;

However if instead of using TFiler and standard VCL streamer you make your custom code using RTTI (GetPropList) - then it would not call those virtual properties APi custom to TFiler and would only show real properties.

So my advice is just to use standard emthods like shown above and to streamline and harden the code.

And since RegisterClass works by the classname you'd better choose another name, not clashing with a real TDataSet from stock DB unit.

Fix the name and do register the class, so VCL streamer could find it by name! For example:

procedure TMyDataSet.ReadArray(Reader: TReader);
var
  N: Integer; S: String;
begin
  N := Low(FArrayToSave);
  Reader.ReadListBegin;
  while not Reader.EndOfList do begin
    S := Reader.ReadString; // even if we would not save it - we should remove it from the input
    if N <= High(FArrayToSave) then
       FArrayToSave[N] := S;
    Inc(N);
  end;
  Reader.ReadListEnd;
end;

procedure TMyDataSet.WriteArray(Writer: TWriter);
var
  I: Integer;
begin
  Writer.WriteListBegin;
  for I := Low(FArrayToSave) to High(FArrayToSave) do begin
    Writer.WriteString(FArrayToSave[I]);
  end;
  Writer.WriteListEnd;
end;

initialization
  DataSet := TMyDataSet.Create(Nil);
  RegisterClasses([TMyDataSet]);

finalization
  DataSet.Free;
end.

Additionally, i think you'd better - for future extensibility - save the array length in DFM.

procedure TMyDataSet.WriteArray(Writer: TWriter);
var
  I: Integer;
begin
  Writer.WriteInteger(Length(FArrayToSave));
  Writer.WriteListBegin;
  for I := Low(FArrayToSave) to High(FArrayToSave) do begin

....

procedure TMyDataSet.ReadArray(Reader: TReader);
var
  N: Integer;  S: String;
begin
  for N := Low(FArrayToSave) to High(FArrayToSave) do begin
      FArrayToSave := ''; // in case DFM would have less elements than 50
  N := Reader.ReadInteger;
  if N <> Length(FArrayToSave) then... recovery from unexpected DFM version error

  N := Low(FArrayToSave);
  Reader.ReadListBegin;
  while not Reader.EndOfList do begin

PS. you do not need {$M+} there since TComponent already is derived from TPersistent

PPS. Wanted to comment upon update in the question, but the phone refuses to do (too long?) so putting it here.

1: since we moved away from using RTTI, the Typinfo unit no more needed in uses. 2: if N = Length(FFullArray) then lacks ELSE path. Okay, now we learned that DFM is broken or incompatible, what then? I think we better raise some error. Or try to remove list of N strings, so next property could be read. Or even remove the list of elements of any type/quantity until list end. Future compatibly is never warranted, but at least some attempt can be done, even just to explicitly halt with error. Skipping reading and silently leaving the reader inside middle of property, so next properties would get crazy, I think is not the way to do it.

And generally David is correct about ignoring incorrect indices in the setter and getter. Unless you would intentionally come with some unusual pattern of implicit item creation from default template in sparse array by setting or getting with "free" "unbound" index (which is no code for either) the better approach at least in Delphi would be "fail early". That is what users of your class would expect by default. So kinda

  Procedure class.CheckArrayIdx(const i: integer);
  Var mx, mn : integer;
  Begin 
       Mn := low(myarray) ; Mx := high(myarray);
       If (i <= mx) and (I >= mn) then exit;
       Raise ERangeError.CreateFmt('%s.Items index should be %d <= %d <= %d',  [
             Self.ClassName, mn, I, mx]) ;
   End;

This procedure can be called as 1st line in both setter and getter. Then you can just work with surely correct index value.

edited Dec 30, 2013 at 14:50

answered Dec 18, 2013 at 16:30

Arioch 'The

16.2k39 silver badges67 bronze badges

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

9 Comments

Sertac Akyuz Over a year ago

However weird it is, the reader seems to have the same logic (although reading into wrong index).

David Heffernan Over a year ago

Sound advice, but why would this change behaviour? Other than the bogus index on the reader.

Arioch 'The Over a year ago

@SertacAkyuz are you sure how would EndOfList behave right after the inner list read ?

Sertac Akyuz Over a year ago

@Arioch - No, actually I'm not.

Arioch 'The Over a year ago

@DavidHeffernan there are three advices actually (+ name and registering). And the non-typical senseless using of lists may drive VCL into unexpected badly tested code path.

|

Collectives™ on Stack Overflow

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

1 Answer 1

9 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

9 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related