TCollectionItem mit einer Collection - Wie?

[Dennis07]

Hier nochmal der Quelltext mit der notwendigen Änderung von mir vorgenommen, funktioniert einwandfrei:

Delphi-Quellcode:

unit Component1;

interface

uses
  SysUtils, Classes, ContNrs, WideStrings;

type
  TTestCollectionItem = class;

  TTestCollection = class(TOwnedCollection)
  private
    FParentItem: TTestCollectionItem;
    function GetTestItem(Index: Integer): TTestCollectionItem;
    procedure SetTestItem(Index: Integer; Value: TTestCollectionItem);
  protected
    procedure SetItemName(AItem: TCollectionItem); override;
  public
    constructor Create(AOwner: TPersistent); virtual;
    procedure GetItemNames(List: Tstrings); overload;
    procedure GetItemNames(List: TWideStrings); overload;
    property TestItems[Index: Integer]: TTestCollectionItem read GetTestItem write SetTestItem; default;
    property ParentItem: TTestCollectionItem read FParentItem;
  end;

  TTestCollectionItem = class(TCollectionItem)
  private
    FName: String;
    FText: String;
    FChilds: TTestCollection;
    procedure SetChilds(Value: TTestCollection);
  protected
    function GetDisplayName: string; override;
    procedure SetDisplayName(const Value: string); reintroduce;
  public
    constructor Create(Collection: TCollection); override; // <-- HIER
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function HasChilds: Boolean;
  published
    property Text: String read FText write FText;
    property Childs: TTestCollection read FChilds write SetChilds stored HasChilds;
    property Name: string read FName write SetDisplayName;
  end;

  TComponent1 = class(TComponent)
  private
    FRoot: TTestCollection;
  protected
    procedure SetRoot(Value: TTestCollection);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AssignTo(Dest: TPersistent); override;
  published
    property Root: TTestCollection read FRoot write SetRoot;
  end;

procedure Register;

implementation

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

constructor TTestCollection.Create(AOwner: TPersistent);
begin
  FParentItem := nil;
  if AOwner is TTestCollectionItem then
    FParentItem := TTestCollectionItem(AOwner);

  inherited Create(AOwner, TTestCollectionItem);
end;

procedure TTestCollection.GetItemNames(List: TWideStrings);
var
  I: Integer;
begin
  List.BeginUpdate;
  try
    List.Clear;
    for I := 0 to Count - 1 do
      with TTestCollectionItem(Items[I]) do
        if Name <> '' then List.Add(Name);
  finally
    List.EndUpdate;
  end;
end;

procedure TTestCollection.GetItemNames(List: TStrings);
var
  wList: TWIdeStringList;
begin
  wList := TWIdeStringList.Create;
  try
    GetItemNames(wList);
    List.Assign(wList);
  finally
    wList.Free;
  end;
end;

function TTestCollection.GetTestItem(Index: Integer): TTestCollectionItem;
begin
  Result := TTestCollectionItem(inherited Items[Index]);
end;

procedure TTestCollection.SetTestItem(Index: Integer; Value: TTestCollectionItem);
begin
  inherited Items[Index] := Value;
end;

procedure TTestCollection.SetItemName(AItem: TCollectionItem);
begin
  inherited SetItemName(AItem);
// if Value is TTestCollectionItem then
// begin
// if TTestCollectionItem(AItem).Name = '' then
// TTestCollectionItem(AItem).Name := Copy(ClassName, 2, 5) + IntToStr(ID + 1);
// end;
end;

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

constructor TTestCollectionItem.Create(Collection: TCollection);
begin
  //FName := Name;
  inherited Create(Collection);
  FChilds := TTestCollection.Create(Self);
end;

destructor TTestCollectionItem.Destroy;
begin
  inherited Destroy;
  FChilds.Free;
end;

function TTestCollectionItem.HasChilds: Boolean;
begin
  Result := (FChilds <> nil) and (FChilds.Count > 0);
end;

procedure TTestCollectionItem.Assign(Source: TPersistent);
var
  I: Integer;
  S: TTestCollectionItem;
begin
  if Source is TTestCollectionItem then
  begin
    if Collection <> nil then Collection.BeginUpdate;
    try
      S := TTestCollectionItem(Source);
      Name := S.Name;
      Text := S.Text;
      if HasChilds then Childs.Clear;
      if S.HasChilds then
        for I := 0 to S.Childs.Count - 1 do
          Childs.Add.Assign(S.Childs[I]);
    finally
      if Collection <> nil then Collection.EndUpdate;
    end;
  end else inherited;
end;

function TTestCollectionItem.GetDisplayName: string;
begin
  Result := FName;
end;

procedure TTestCollectionItem.SetDisplayName(const Value: string);
begin
  FName := Value;
  inherited SetDisplayName(Value);
end;

procedure TTestCollectionItem.SetChilds(Value: TTestCollection);
begin
  FChilds.Assign(Value);
end;

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

constructor TComponent1.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FRoot := TTestCollection.Create(Self);
end;

destructor TComponent1.Destroy;
begin
  Freeandnil(FRoot);
  inherited Destroy;
end;

procedure TComponent1.AssignTo(Dest: TPersistent);
begin
  if Dest is TComponent1 then
  begin
    TComponent1(Dest).FRoot.Assign(FRoot);
  end
  else
    inherited AssignTo(Dest);
end;

procedure TComponent1.SetRoot(Value: TTestCollection);
begin
  FRoot.Assign(Value);
end;

end.