Как сохранить значение свойства в поток 2

Delphi , Компоненты и Классы , RTTI

Автор: Yoav
WEB-сайт: http://www.lmc-mediaagentur.de

The solution above will work, but it forces you to implement streaming support for each of the TStreamableObject objects. Delphi has already implemented this mechanism in for the TPersistent class and the TComponent class, and you can use this mechanism. The class I include here does the job. It holds classes that inherit from TUmbCollectionItem (which in turn inherits from Delphi TCollectionItem), and handles all the streaming of the items. As the items are written with the Delphi mechanism, all published data is streamed.

Notes: This class does not support working within the delphi IDE like TCollection. All objects inheriting from TUmbCollectionItem must be registered using the Classes.RegisterClass function. All objects inheriting from TUmbCollectionItem must implement the assign function. By default, the TUmbCollection owns its items (frees them when the collection is freed), but this functionality can be changed.

unit UmbCollection;

interface

uses
  Windows, Messages, SysUtils, Classes, contnrs;

type
  TUmbCollectionItemClass = class of TUmbCollectionItem;
  TUmbCollectionItem = class(TCollectionItem)
  private
    FPosition: Integer;
  public
    {when overriding this method, you must call the inherited assign.}
    procedure Assign(Source: TPersistent); override;
  published
    {the position property is used by the streaming mechanism to place the object in the
    right position when reading the items. do not use this property.}
    property Position: Integer read FPosition write FPosition;
  end;

  TUmbCollection = class(TObjectList)
  private
    procedure SetItems(Index: Integer; Value: TUmbCollectionItem);
    function GetItems(Index: Integer): TUmbCollectionItem;
  public
    function Add(AObject: TUmbCollectionItem): Integer;
    function Remove(AObject: TUmbCollectionItem): Integer;
    function IndexOf(AObject: TUmbCollectionItem): Integer;
    function FindInstanceOf(AClass: TUmbCollectionItemClass; AExact: Boolean =
      True;
      AStartAt: Integer = 0): Integer;
    procedure Insert(Index: Integer; AObject: TUmbCollectionItem);

    procedure WriteToStream(AStream: TStream); virtual;
    procedure ReadFromStream(AStream: TStream); virtual;

    property Items[Index: Integer]: TUmbCollectionItem read GetItems write
      SetItems; default;
  published
    property OwnsObjects;
  end;

implementation

{ TUmbCollection }

function ItemsCompare(Item1, Item2: Pointer): Integer;
begin
  Result := TUmbCollectionItem(Item1).Position -
    TUmbCollectionItem(Item2).Position;
end;

function TUmbCollection.Add(AObject: TUmbCollectionItem): Integer;
begin
  Result := inherited Add(AObject);
end;

function TUmbCollection.FindInstanceOf(AClass: TUmbCollectionItemClass;
  AExact: Boolean; AStartAt: Integer): Integer;
begin
  Result := inherited FindInstanceOf(AClass, AExact, AStartAt);
end;

function TUmbCollection.GetItems(Index: Integer): TUmbCollectionItem;
begin
  Result := inherited Items[Index] as TUmbCollectionItem;
end;

function TUmbCollection.IndexOf(AObject: TUmbCollectionItem): Integer;
begin
  Result := inherited IndexOf(AObject);
end;

procedure TUmbCollection.Insert(Index: Integer; AObject: TUmbCollectionItem);
begin
  inherited Insert(Index, AObject);
end;

procedure TUmbCollection.ReadFromStream(AStream: TStream);
var
  Reader: TReader;
  Collection: TCollection;
  ItemClassName: string;
  ItemClass: TUmbCollectionItemClass;
  Item: TUmbCollectionItem;
  i: Integer;
begin
  Clear;
  Reader := TReader.Create(AStream, 1024);
  try
    Reader.ReadListBegin;
    while not Reader.EndOfList do
    begin
      ItemClassName := Reader.ReadString;
      ItemClass := TUmbCollectionItemClass(FindClass(ItemClassName));
      Collection := TCollection.Create(ItemClass);
      try
        Reader.ReadValue;
        Reader.ReadCollection(Collection);
        for i := 0 to Collection.Count - 1 do
        begin
          item := ItemClass.Create(nil);
          item.Assign(Collection.Items[i]);
          Add(Item);
        end;
      finally
        Collection.Free;
      end;
    end;
    Sort(ItemsCompare);
    Reader.ReadListEnd;
  finally
    Reader.Free;
  end;
end;

function TUmbCollection.Remove(AObject: TUmbCollectionItem): Integer;
begin
  Result := inherited Remove(AObject);
end;

procedure TUmbCollection.SetItems(Index: Integer; Value: TUmbCollectionItem);
begin
  inherited Items[Index] := Value;
end;

procedure TUmbCollection.WriteToStream(AStream: TStream);
var
  Writer: TWriter;
  CollectionList: TObjectList;
  Collection: TCollection;
  ItemClass: TUmbCollectionItemClass;
  ObjectWritten: array of Boolean;
  i, j: Integer;
begin
  Writer := TWriter.Create(AStream, 1024);
  CollectionList := TObjectList.Create(True);
  try
    Writer.WriteListBegin;
    {init the flag array and the position property of the TCollectionItem objects.}
    SetLength(ObjectWritten, Count);
    for i := 0 to Count - 1 do
    begin
      ObjectWritten[i] := False;
      Items[i].Position := i;
    end;
    {write the TCollectionItem objects. we write first the name of the objects class,
    then write all the object of the same class.}
    for i := 0 to Count - 1 do
    begin
      if ObjectWritten[i] then
        Continue;
      ItemClass := TUmbCollectionItemClass(Items[i].ClassType);
      Collection := TCollection.Create(ItemClass);
      CollectionList.Add(Collection);
      {write the items class name}
      Writer.WriteString(Items[i].ClassName);
      {insert the items to the collection}
      for j := i to Count - 1 do
        if ItemClass = Items[j].ClassType then
        begin
          ObjectWritten[j] := True;
          (Collection.Add as ItemClass).Assign(Items[j]);
        end;
      {write the collection}
      Writer.WriteCollection(Collection);
    end;
  finally
    CollectionList.Free;
    Writer.WriteListEnd;
    Writer.Free;
  end;
end;

{ TUmbCollectionItem }

procedure TUmbCollectionItem.Assign(Source: TPersistent);
begin
  if Source is TUmbCollectionItem then
    Position := (Source as TUmbCollectionItem).Position
  else
    inherited;
end;

end.

Программный код на Delphi реализует класс коллекции (TUmbCollection), который может хранить и управлять объектами типа TUmbCollectionItem, которые в свою очередь наследуются от TCollectionItem. Коллекция обеспечивает методы для добавления, удаления, поиска, вставки, сортировки, чтения и записи элементов в/из поток.

Основной функцией этой реализации является возможность сериализировать и десериализировать объекты типа TUmbCollectionItem в и из потока, включая их опубликованные свойства. Это достигается путем переопределения метода Assign в TUmbCollectionItem для установки свойства Position при присваивании объекта, а также реализации методов WriteToStream и ReadFromStream в TUmbCollection.

Вот некоторые заметки по этой реализации:

1. Класс коллекции (TUmbCollection) использует TObjectList как механизм внутреннего хранения.
2. Метод Assign в TUmbCollectionItem переопределен для установки свойства Position при присваивании объекта, что обеспечивает сохранение позиции каждого элемента во время сериализации и десериализации.
3. Метод WriteToStream в TUmbCollection записывает объекты в коллекции в поток, включая их классные имена и опубликованные свойства. Он также устанавливает флаговый массив для отслеживания уже записанных элементов.
4. Метод ReadFromStream в TUmbCollection читает объекты из потока и добавляет их в коллекцию. Он использует флаговый массив для определения, был ли элемент уже прочитан.

Чтобы использовать эту реализацию, вам нужно зарегистрировать классы, которые наследуются от TUmbCollectionItem, используя функцию Classes.RegisterClass. Вам также нужно реализовать метод Assign в каждом из этих классов для установки свойства Position при присваивании объекта.

Вот пример использования этой реализации:

type
  TMyObject = class(TUmbCollectionItem)
    procedure Assign(Source: TPersistent); override;
    published
      property MyProperty: Integer read FMyProperty write FMyProperty;
  end;

implementation

procedure TMyObject.Assign(Source: TPersistent);
begin
  if Source is TMyObject then
    inherited Assign(Source);
end;

var
  MyCollection: TUmbCollection;
  MyObject1, MyObject2: TMyObject;

procedure TForm1.Button1Click(Sender: TObject);
begin
  MyCollection := TUmbCollection.Create;
  MyObject1 := TMyObject.Create(nil);
  MyObject2 := TMyObject.Create(nil);
  MyObject1.MyProperty := 10;
  MyObject2.MyProperty := 20;
  MyCollection.Add(MyObject1);
  MyCollection.Add(MyObject2);
  Stream := TMemoryStream.Create;
  try
    MyCollection.WriteToStream(Stream);
    // Do something with the stream...
  finally
    FreeAndNil(Stream);
  end;

  // Later, when you want to read the objects from the stream:
  Stream := TMemoryStream.Create;
  try
    MyCollection.ReadFromStream(Stream);
    // Now you can access the objects in the collection:
    ShowMessage(IntToStr(MyObject1.MyProperty));
    ShowMessage(IntToStr(MyObject2.MyProperty));
  finally
    FreeAndNil(Stream);
  end;

  // Don't forget to free the objects and collection:
  MyCollection.Free;
  MyObject1.Free;
  MyObject2.Free;
end.

В этом примере мы создаем коллекцию TUmbCollection и добавляем в нее два объекта TMyObject. Затем мы записываем коллекцию в поток с помощью WriteToStream и читаем ее обратно с помощью ReadFromStream. Наконец, мы отображаем значения свойства MyProperty для каждого объекта в коллекции.

Сохранить значение свойства в поток 2 можно с помощью класса TUmbCollection, который обеспечивает сохранение и чтение объектов в потоке.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: RTTI ::