Имеется объект MyCollection — наследник TCollection. Содержит элементы MyCollectionItem —
наследники TCollectionItem. Необходимо сохранить MyCollection при закрытии формы, а при
следующем запуске восстановить, как будто программа не закрывалась. Я делаю следующим
образом:


*** main.pas ***

Uses
  rw
  
  ...
  
procedure TForm1.acSaveExecute(Sender: TObject);
var                                             
  MemStream : TMemoryStream;                    
begin                                           
  MemStream:=TMemoryStream.Create;              
  try                                           
    WriteCollection(MemStream,MyGroups);        
    MemStream.SaveToFile(DataFile);             
  finally                                       
    MemStream.Free;                             
  end;                                          
end;                                            

procedure TForm1.acLoadExecute(Sender: TObject);
var                                             
  MemStream : TMemoryStream;                    
begin                                           
  if not FileExists(DataFile) then exit;        
  MemStream:=TMemoryStream.Create;              
  try                                           
    MemStream.LoadFromFile(DataFile);           
    ReadCollection(MemStream,MyGroups);         
  finally                                       
    MemStream.Free;                             
  end;                                          
end;

*** rw.pas ***

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

  ...

procedure WriteCollection(Stream: TStream; Instance: TCollection);
begin                                                             
 with TWriterAccess.Create(Stream, 1024) do try                   
   WriteCollection(Instance);                                     
 finally                                                          
   Free                                                           
 end                                                              
end;                                                              
                                                                  
procedure ReadCollection(Stream: TStream; Instance: TCollection); 
begin                                                             
 with TReaderAccess.Create(Stream, 1024) do try                   
   if ReadValue = vaCollection then ReadCollection(Instance);     
 finally                                                          
   Free                                                           
 end                                                              
end;

В принципе, неплохой способ сохранять объекты. Но при данном подходе не сохраняется свойство
MyCollectionItem.ID, наследуемое от TCollectionItem и являющееся Read-only. А мне важно,
чтобы оно сохранялось и данному экземпляру всегда соответствовал определенный ID. Как можно
это сделать? Или проще добавить в MyCollectionItem свойство к примеру 'key' и самому за ним
следить?

Здравствуйте, Аноним, Вы писали:

А> Или проще добавить в MyCollectionItem свойство к примеру 'key' и самому за ним

Именно так. Намного удобнее работать с тем, что полностью контролируешь.

Здравствуйте, Аноним, Вы писали:

Сделай что типа этого:

procedure WriteCollection(Stream: TStream; Instance: TCollection);
begin                                                             
 with TWriterAccess.Create(Stream, 1024) do try                   
   WriteListBegin;
   WriteProperties (Instance);
   WriteListEnd;
   WriteCollection(Instance);
 finally                                                          
   Free;
 end                                                              
end;                                                              
                                                                  
procedure ReadCollection(Stream: TStream; Instance: TCollection); 
begin                                                             
 with TReaderAccess.Create(Stream, 1024) do try
   if ReadValue = vaList then begin
     while not EndOfList do ReadProperty(Instance);
     ReadListEnd;
   end;
   if ReadValue = vaCollection then
     ReadCollection(Instance);
 finally                                                          
   Free;                                                           
 end                                                              
end;

Здравствуйте, Danchik, Вы писали:

D>Сделай что типа этого:
D> ...

С этого я и начал. Так сохраняется наследник TPersistent. А если так сохранить наследника TCollection, ошибки не будет (TCollection является наследником TPersistent), но и толку тоже нет — файл получается размером 2 байта. Недаром ведь у класса TWriter есть специальный метод WriteCollection...

Здравствуйте, Аноним, Вы писали:

А>Здравствуйте, Danchik, Вы писали:

D>>Сделай что типа этого:
D>> ...

А>С этого я и начал. Так сохраняется наследник TPersistent. А если так сохранить наследника TCollection, ошибки не будет (TCollection является наследником TPersistent), но и толку тоже нет — файл получается размером 2 байта. Недаром ведь у класса TWriter есть специальный метод WriteCollection...

Хм, чесно не понял что ты хотел этим сказать....
Не записывается? Не читается? Лишние данные? Ты пишеш компоненту, в которой эта коллекция присутствует?

Здравствуйте, Danchik, Вы писали:

D>Хм, чесно не понял что ты хотел этим сказать....
D>Не записывается? Не читается? Лишние данные? Ты пишеш компоненту, в которой эта коллекция присутствует?

Не записывается.

Я пишу невизуальный класс — наследник TCollection. Хочу на его основе создать подобие таблицы — каждый TCollectionItem есть одна запись (т.е. строка) таблицы. TCollectionItem.ID — ключевое поле. Но оно ключевое только в течении сеанса. А при загрузке методом TReader.ReadCollection(MyCollection) поле MyCollectionItem.ID не восстанавливается (оно не было сохранено), а заполняется с нуля, как будто бы я просто добавил в пустую коллекцию элементы.

Здравствуйте, Аноним, Вы писали:

А>Здравствуйте, Danchik, Вы писали:

D>>Хм, чесно не понял что ты хотел этим сказать....
D>>Не записывается? Не читается? Лишние данные? Ты пишеш компоненту, в которой эта коллекция присутствует?

А>Не записывается.

А>Я пишу невизуальный класс — наследник TCollection. Хочу на его основе создать подобие таблицы — каждый TCollectionItem есть одна запись (т.е. строка) таблицы. TCollectionItem.ID — ключевое поле. Но оно ключевое только в течении сеанса. А при загрузке методом TReader.ReadCollection(MyCollection) поле MyCollectionItem.ID не восстанавливается (оно не было сохранено), а заполняется с нуля, как будто бы я просто добавил в пустую коллекцию элементы.

Как, говорится, проблема в твоем коде. Вырежи свой класс TMyCollectionItem и свою TMyCollection. Запостай сюда, будем посмотреть...
Но... сначала посмотри published ли твое свойство ID. Если нет......

Здравствуйте, Danchik, Вы писали:

D>Но... сначала посмотри published ли твое свойство ID. Если нет......

Это свойство не мое. Я его не переопределяю. Пробовал переопределять — оно вообще заполняться перестало. А в classes.pas оно объявлено следующим образом:

  TCollectionItem = class(TPersistent)                                    
  private                                                                 
    FID: Integer;                                                         
    ...
  protected                                                               
    ...
  public                                                                  
    ...
    property ID: Integer read FID;                                        
    ...
  end;

Кроме того, там же в классе TCollection есть поле

  TCollection = class(TPersistent)   
  private                            
    ...
    FNextID: Integer;                
    ...
    procedure InsertItem(Item: TCollectionItem);
    ...
  protected                                                               
    ...
  public                                                                  
    ...
  end;                                                                    

  ...

procedure TCollection.InsertItem(Item: TCollectionItem);             
begin                                                                
  if not (Item is FItemClass) then TList.Error(@SInvalidProperty, 0);
  FItems.Add(Item);                                                  
  Item.FCollection := Self;                                          
  Item.FID := FNextID;                                               
  Inc(FNextID);                                                      
  SetItemName(Item);                                                 
  Changed;                                                           
  NotifyDesigner(Self, Item, opInsert);                              
end;

Тут мне вообще непонятно:

  Item.FID := FNextID;

он напрямую обращается к полю, объявленному в секции private другого класса !?!

Вобщем, задача сводится к тому, чтобы заставить его сохранять и восстанавливать поля TCollection.FNextID и TCollectionItem.FID, находящиеся в секции private каждый своего класса. Или переопределить эти поля, но так, чтобы встроенные методы не потеряли доступа к ним.

Здравствуйте, Аноним, Вы писали:

А>Здравствуйте, Danchik, Вы писали:

D>>Но... сначала посмотри published ли твое свойство ID. Если нет......

А>Это свойство не мое. Я его не переопределяю. Пробовал переопределять — оно вообще заполняться перестало. А в classes.pas оно объявлено следующим образом:

А>...

А>Вобщем, задача сводится к тому, чтобы заставить его сохранять и восстанавливать поля TCollection.FNextID и TCollectionItem.FID, находящиеся в секции private каждый своего класса. Или переопределить эти поля, но так, чтобы встроенные методы не потеряли доступа к ним.

Как я и думал проблема в твоем коде

С этими ID у тебя ничего не получится. Они действительны только для текущей сесии. A то что ID не published, да еще и ReadOnly не даст ее записать в поток. Тут нужно делать свое свойство, да еще и Published и чтоб write тоже присутствовало.

И еще, ты не сможеш нормально контроллировать когда элемент добавляется в коллекцию что бы поддерживать свое ID (назовем его KeyID).

Приведу один вариант как все можно замутить

Породится от TComponent — TMyCollection = class (TComponent), TMyCollectionItem = class (TComponent)

Сампл:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TMyCollectionItem = class;

  TMyCollection = class(TComponent)
  private
    FItems  : TList;
    FNextID : Integer;
    procedure AddItem (Item : TMyCollectionItem);
    function GetCount: Integer;
    function GetItems(Index: Integer): TMyCollectionItem;
    procedure RemoveItem (Item : TMyCollectionItem);
    procedure ValidateNewID (NewID : Integer);
    procedure UpdateNewID(NewID : Integer);
    procedure ReadNextID(Reader : TReader);
    procedure WriteNextID(Writer: TWriter);
  protected
    procedure DefineProperties(Filer: TFiler); override;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  public
    constructor Create (AOwner : TComponent); override;
    destructor Destroy; override;
    function Add: TMyCollectionItem;
    procedure Clear;
    function FindByID (ID : Integer) : TMyCollectionItem;
    procedure ResetNextID;
    property Count: Integer read GetCount;
    property Items[Index: Integer]: TMyCollectionItem read GetItems; default;
    property NextID: Integer read FNextID;
  end;

  TMyCollectionItem = class(TComponent)
  private
    FCollection: TMyCollection;
    FID: Integer;
    function GetID: Integer;
    procedure SetCollection(const Value: TMyCollection);
    procedure SetID(const Value: Integer);
  protected
    procedure SetParentComponent(Value: TComponent); override;
  public
    constructor Create (AOwner : TComponent); override;
    destructor Destroy; override;
    function GetParentComponent: TComponent; override;
    property Collection: TMyCollection read FCollection write SetCollection;
  published
    property ID: Integer read GetID write SetID default -1;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//==================================================================================================
// class TMyCollection
//==================================================================================================

constructor TMyCollection.Create(AOwner: TComponent);
begin
  inherited;
  FItems := TList.Create;
end;

destructor TMyCollection.Destroy;
begin
  Clear;
  FItems.Free;
  inherited;
end;

function TMyCollection.Add: TMyCollectionItem;
begin
  Result := TMyCollectionItem.Create (nil);
  Result.Collection := Self;
end;

procedure TMyCollection.AddItem(Item: TMyCollectionItem);
begin
  if FItems.IndexOf (Item) >= 0 then
    Exit;

  if not (csLoading in ComponentState) then
    if Item.ID >= 0 then
      ValidateNewID(Item.ID);

  FItems.Add (Item);
  Item.FCollection := Self;

  if not (csLoading in ComponentState) then
    if Item.ID < 0 then begin
      Item.FID := NextID;
      Inc (FNextID);
    end else
      UpdateNewID (Item.ID);
end;

procedure TMyCollection.Clear;
begin
  while FItems.Count > 0 do
    TObject (FItems [FItems.Count - 1]).Free;
  FItems.Clear;
end;

procedure TMyCollection.DefineProperties(Filer: TFiler);
begin
  inherited;
  Filer.DefineProperty('NextID', ReadNextID, WriteNextID, FNextID > 0);
end;

function TMyCollection.FindByID(ID: Integer): TMyCollectionItem;
var
  K : Integer;
begin
  for K := 0 to Count - 1 do begin
    Result := Items [K];
    if Result.ID = ID then
      Exit;
  end;
  Result := nil;
end;

procedure TMyCollection.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
  K : Integer;
begin
  for K := 0 to Count - 1 do
    Proc (Items [K]);
end;

function TMyCollection.GetCount: Integer;
begin
  Result := FItems.Count;
end;

function TMyCollection.GetItems(Index: Integer): TMyCollectionItem;
begin
  Result := FItems [Index];
end;

procedure TMyCollection.RemoveItem(Item: TMyCollectionItem);
begin
  FItems.Remove (Item);
  Item.FCollection := nil;
end;

procedure TMyCollection.ResetNextID;
begin
  FNextID := 0;
end;

procedure TMyCollection.ValidateNewID(NewID : Integer);
begin
  if FindByID (NewID) <> nil then
    raise Exception.CreateFmt ('Item with ID [%d] already exists', [NewID]);
end;

//==================================================================================================
// class TMyCollectionItem
//==================================================================================================

constructor TMyCollectionItem.Create(AOwner: TComponent);
begin
  inherited;
  FID := -1;
end;

destructor TMyCollectionItem.Destroy;
begin
  Collection := nil;
  inherited;
end;

function TMyCollectionItem.GetID: Integer;
begin
  Result := FID;
end;

function TMyCollectionItem.GetParentComponent: TComponent;
begin
  Result := Collection;
end;

procedure TMyCollectionItem.SetCollection(const Value: TMyCollection);
begin
  if FCollection <> Value then
  begin
    if FCollection <> nil then
      FCollection.RemoveItem(Self);
    if Value <> nil then
      Value.AddItem (Self);
  end;
end;

procedure TMyCollectionItem.SetID(const Value: Integer);
begin
  if FID = Value then
    Exit;
  if not (csLoading in ComponentState) then
    if Collection <> nil then begin
      Collection.ValidateNewID (Value);
      Collection.UpdateNewID (Value);
    end;
  FID := Value;
end;

procedure TMyCollectionItem.SetParentComponent(Value: TComponent);
begin
  if (Collection <> Value) and (Value is TMyCollection) then
    Collection := TMyCollection (Value);
end;

procedure TMyCollection.ReadNextID(Reader: TReader);
begin
  FNextID := Reader.ReadInteger;
end;

procedure TMyCollection.UpdateNewID(NewID : Integer);
begin
  if FNextID <= NewID then
    FNextID := NewID + 1;
end;

procedure TMyCollection.WriteNextID(Writer: TWriter);
begin
  Writer.WriteInteger (FNextID);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  aCollection : TMyCollection;
  aLoadedCollection : TMyCollection;
  aStream : TStream;
  aTextStream : TStringStream;
begin
  aCollection := TMyCollection.Create (nil);
  try
    aCollection.Add;
    aCollection.Add;
    aCollection.Add;
    aCollection.Add.ID := 10;
    aStream := TMemoryStream.Create;
    try
      aStream.WriteComponent(aCollection);
      aStream.Position := 0;
      aTextStream := TStringStream.Create ('');
      try
        ObjectBinaryToText(aStream, aTextStream);
        ShowMessage(aTextStream.DataString);
      finally
        aTextStream.Free;
      end;

      aLoadedCollection := nil;
      aStream.Position := 0;
      aLoadedCollection := TMyCollection (aStream.ReadComponent(nil));
      try
        ShowMessageFmt ('NextID: %d, Count: %d', [aLoadedCollection.NextID, aLoadedCollection.Count]);
      finally
        aLoadedCollection.Free;
      end;
    finally
      aStream.Free;
    end;
  finally
    aCollection.Free;
  end;
end;

initialization
  RegisterClasses([TMyCollection, TMyCollectionItem]);
end.

Здравствуйте, Danchik, Вы писали:

D>Приведу один вариант как все можно замутить

Премного благодарен, что проявили участие к моей проблеме. Вот уж не ожидал таких развернутых ответов.

Отдельное спасибо за пример целого юнита. В принципе я предполагал, что с встроенными свойствами ничего не выйдет, ну а Вы развеяли мои сомнения.

Ухожу из форума до завтра — буду реализовывать Вашу и некоторые свои идеи.

ЗЫ. Раз уж Вы проявили такое внимание ко мне, полагаю Вам небезынтересно будет узнать, чем все закончится. Предлагаю переписываться по e-mail. Мой адрес vcoder собака yandex.ru.

Здравствуйте, Аноним, Вы писали:

А>Здравствуйте, Danchik, Вы писали:

D>>Приведу один вариант как все можно замутить

А> Премного благодарен, что проявили участие к моей проблеме. Вот уж не ожидал таких развернутых ответов.

А>Отдельное спасибо за пример целого юнита. В принципе я предполагал, что с встроенными свойствами ничего не выйдет, ну а Вы развеяли мои сомнения.

А>Ухожу из форума до завтра — буду реализовывать Вашу и некоторые свои идеи.

А>ЗЫ. Раз уж Вы проявили такое внимание ко мне, полагаю Вам небезынтересно будет узнать, чем все закончится. Предлагаю переписываться по e-mail. Мой адрес vcoder собака yandex.ru.
Будем посмотреть...

Давно в делфовские потоки не сериализировал. XML — вот это завсегда