Как загрузить объект правильного типа в коллекцию перед выполнением процедуры «TRead.ReadProp» - PullRequest
Новая
       12

Как загрузить объект правильного типа в коллекцию перед выполнением процедуры «TRead.ReadProp»

0 голосов
/ 14 января 2020

Я создаю набор свойств в элементе коллекции. Каждый элемент имеет различный набор свойств в зависимости от его типа: 

  type
    TMyProps = class(TPersistent)
  private
    Fcommom: boolean;
    procedure Setcommom(const Value: boolean);
    published
      property commom: boolean read Fcommom write Setcommom;
    end;
    TMyPropsClass = class of TMyProps;

    TFieldPropsFloat = class(TMyProps)
  private
    FDecimalplaces: integer;
    procedure SetDecimalplaces(const Value: integer);
    published
      property Decimalplaces: integer read FDecimalplaces write SetDecimalplaces;
    end;

    TFieldPropsStr = class(TMyProps)
  private
    FLength: integer;
    procedure SetLength(const Value: integer);
    published
      property Length: integer read FLength write SetLength;
    end;

    TMyCollection = class(TOwnedCollection)
    end;

    TMyItem = class(TCollectionItem)
    private
      FMyPropsClass: TMyPropsClass;
      FMyProps: TMyProps;
      procedure ReadMyProps(Reader: TReader);
      procedure WriteMyProps(Writer: TWriter);
      procedure RecreateMyProps;
    procedure SetMyProps(const Value: TMyProps);
    procedure SetMyPropsClass(const Value: TMyPropsClass);
    protected
      procedure DefineProperties(Filer: TFiler); override;
    public
      procedure AfterConstruction; override;
    published
      property MyPropsClass: TMyPropsClass read FMyPropsClass write SetMyPropsClass;
      property MyProps: TMyProps read FMyProps write SetMyProps stored false;
    end;

в «TMyItem» возникает ошибка при загрузке свойств, записанных в файл «.dfm», поскольку «MyProps» еще не был создан с помощью « Свойства MyPropsClass, которые еще не были загружены из файла .dfm

1005 * Как решить эту проблему? Это лучший подход?

Редактировать: Кроме того, я пытаюсь следовать совету, который дал мне Реми Лебо (комментарии ниже), но я не могу писать в каждом пункте списка. 

///...

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TMyComponent]);
end;


procedure TMyItem.AfterConstruction;
begin
  inherited;
  FMyPropsClass := TFieldPropsStr;
  RecreateMyProps;
end;

procedure TMyItem.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('MyProps', ReadMyProps, WriteMyProps, True);
end;

type
 TReaderAccess = class(TReader);
 TWriterAccess = class(TWriter);

procedure TMyItem.ReadMyProps(Reader: TReader);
begin
  MyProps := TMyPropsClass(FindClass(Reader.ReadString)).Create;
  Reader.CheckValue(vaCollection);
  Reader.ReadListBegin;
  while not Reader.EndOfList do
    TReaderAccess(Reader).ReadProperty(MyProps);
  Reader.ReadListEnd;
  Reader.ReadListEnd;
end;

procedure TMyItem.RecreateMyProps;
begin
  if FMyProps <> nil then
     FMyProps.Free;

  FMyProps := FMyPropsClass.Create;
end;

procedure TMyItem.SetMyProps(const Value: TMyProps);
begin
  FMyProps := Value;
end;

procedure TMyItem.SetMyPropsClass(const Value: TMyPropsClass);
begin
  if FMyPropsClass <> Value then
  begin
    FMyPropsClass := Value;
    RecreateMyProps;
  end;
end;

procedure TMyItem.WriteMyProps(Writer: TWriter);
begin
  Writer.WriteString(MyProps.ClassName); //if comments this line, write fine

  TWriterAccess(Writer).WriteValue(vaCollection);
  Writer.WriteListBegin;
  Writer.WriteProperties(MyProps);
  Writer.WriteListEnd;
  Writer.WriteListEnd;
end;


{ TMyProps }

procedure TMyProps.Setcommom(const Value: boolean);
begin
  Fcommom := Value;
end;

{ TFieldPropsFloat }

procedure TFieldPropsFloat.SetDecimalplaces(const Value: integer);
begin
  FDecimalplaces := Value;
end;

{ TFieldPropsStr }

procedure TFieldPropsStr.SetLength(const Value: integer);
begin
  FLength := Value;
end;

{ TButton1 }

procedure TMyComponent.AfterConstruction;
begin
  inherited;
  FMyCollection := TMyCollection.Create(Self, TMyItem);
end;

procedure TMyComponent.SetMyCollection(const Value: TMyCollection);
begin
  FMyCollection := Value;
end;

Как правильно реализовать ReadMyProps и WriteMyProps процедуры для каждого элемента коллекции?

1 Ответ

0 голосов
/ 21 января 2020

Отметьте свойство MyProps как stored=false (или вообще не устанавливайте его published), а затем переопределите виртуальный метод DefineProperties() для потоковой передачи данных MyProps вручную. См. Хранение и загрузка неопубликованных свойств: переопределение метода DefineProperties в DocWiki Embarcadero и Потоковые неопубликованные свойства TPersistent - лучший способ в блоге Delphi Codesmith.

Например: 

type
  TMyItem = class(TCollectionItem)
  private
    procedure ReadMyProps(Reader: TReader);
    procedure WriteMyProps(Writer: TWriter);
  protected
    procedure DefineProperties(Filer: TFiler); override;
  published
    MyPropsClass: TMyPropsClass;
    MyProps: TMyProps stored false;
  end;

procedure TMyItem.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('MyProps', ReadMyProps, WriteMyProps, True);
end;

type
 TReaderAccess = class(TReader);
 TWriterAccess = class(TWriter);

procedure TMyItem.ReadMyProps(Reader: TReader);
begin
  MyProps := TMyPropsClass(FindClass(Reader.ReadString)).Create;
  Reader.CheckValue(vaCollection);
  Reader.ReadListBegin;
  while not Reader.EndOfList do
    TReaderAccess(Reader).ReadProperty(MyProps);
  Reader.ReadListEnd;
  Reader.ReadListEnd;
end;

procedure TMyItem.WriteMyProps(Writer: TWriter);
begin
  Writer.WriteString(MyProps.ClassName);
  TWriterAccess(Writer).WriteValue(vaCollection);
  Writer.WriteListBegin;
  Writer.WriteProperties(MyProps);
  Writer.WriteListEnd;
  Writer.WriteListEnd;
end;
...