TCollectionItem mit einer Collection - Wie?

[Andreas L.]

Hallo,
ich habe bei einer Komponente eine Collection als Published-Property definiert. Im Objekt-Inspector lässt sich die Collection auch öffnen und bearbeiten. Nun brauche ich in dem CollectionItem dieser Collection wiederrum eine Collection (selbe Collection). Im Objekt-Inspector sehe ich bei dem CollectionItem auch die published Eigenschaft Childs. Aber wenn ich drauf klicke geht kein Editor auf. Ich kann diese Collection nicht via IDE bearbeiten.

Ich habe aber schon bei anderen Komponente gesehen das dies möglich ist. z. B. hat TDataSet eine Property FieldDefs (Typ: TFieldDefs = TOwnedCollection). Die Items dieser Collection (TFieldDef) enthalten eine Property ChildDefs (TFieldDefs). Der Code dieser Komponente habe ich auch als "Vorlage" für folgenden Code verwendet.

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(Owner: TTestCollection;
      const Name: string); reintroduce; overload; virtual;
    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(Owner: TTestCollection;
  const Name: string);
begin
  FName := Name;
  inherited Create(Owner);
  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.

Leider kann ich die Childs nicht via OI ändern. Wisst ihr was ich falsch mache? Wie bekomme ich das hin?

[Dennis07]

Ein paar Kleinigkeiten vorweg:

• Es heißt korrekterweise "Children" und nicht "Childs" im Englischen.
• Nach dem inherited brauchst du nur den Methodennamen schreiben, wenn sich die Parameterliste der Methoden unterscheidet. Auch brauchst du es überhaupt nicht anzugeben, wenn eine Methode überhaupt nicht überschrieben oder neu eingeführt wurde.
• Die Kombination der direktiven reintroduce; overload; virtual; in einer einzigen Methode mag vielleicht vom Kompiler akzeptiert werden, ergibt aber rein logisch betrachtet wenig Sinn.
• Klassen-und Recordfelder sowie Arrayelemente oder Strings brauchen nicht initialisiert zu werden (genau wie globale Variablen), wenn sie den Standardwert Default(DataType) haben sollen.
• Nenne Parameter oder lokale Variablen niemals gleich wie Objekt-oder Klassenbezeichner!

So, nun aber zu deinem Problem, das auch mit dem 3. Punkt zusammen hängt:
Der Design Editor erzeugt Collection-Items immer über den virtuellen Konstruktor
constructor Create(Collection: TCollection); .
Wenn du diesen überschreibst, dann weiß die Collection immer, wie sie ein neues Item erzeugen kann (nämlich mit genau jenem Konstruktor). Wenn du ihn allerdings nicht überschreibst (override ), sondern neu einführst (reintroduce oder nichts explizites) oder überlädst (overload ), dann kann die Collection diesen ja nicht aufrufen, weil sie ihn (und seine Parameter) nicht kennt. Somit wird er nicht aufgerufen, was dazu führt, dass die Collection für Childs niemals erzeugt wird und somit auch im OI nicht zur Verfügung steht. Du musst die Methode TTestCollectionItem.Create also überschreiben. Deshalb darfst du ihre Signatur nicht ändern, sie muss also folgendermaßen deklariert werden:
constructor Create(Collection: TCollection); override; .

Wenn du das unter keinen Umständen willst, musst du die Collectionklasse so abändern, dass sie den neuen Konstruktor anstelle des alten verwendet.

[einbeliebigername]

Hallo,

Zitat von Dennis07:

• Die Kombination der direktiven reintroduce; overload; virtual; in einer einzigen Methode mag vielleicht vom Kompiler akzeptiert werden, ergibt aber rein logisch betrachtet wenig Sinn.

Oh doch, es ist sinnvoll, wenn der Create-Constructor der Elternklasse noch überschrieben wird.

Delphi-Quellcode:

  TTestCollectionItem = class(TCollectionItem)
    ...
  public
    constructor Create(Collection: TCollection); overload; override;
    constructor Create(Owner: TTestCollection;
      const Name: string); reintroduce; overload; virtual;
   ...
  end;

...

constructor TTestCollectionItem.Create(Owner: TTestCollection;
  const Name: string);
begin
  FName := Name;
  inherited Create(Owner);
  FChilds := TTestCollection.Create(Self);
end;

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

Ohne das reintroduce; gibt es die Warnung "[dcc32 Warnung] Dp199898Unit1.pas(37): W1010 Methode 'Create' verbirgt virtuelle Methode vom Basistyp 'TCollectionItem'", welche bei mir ein Fehler darstellt (und in den Projekt-Optionen immer auf Fehler eingestellt ist). Denn wenn der Compiler die Warnung bringt, hat der Entwickler was vergessen. Mitunter, dass die Elternklasse eine virtuelle Methode mit dem Name hat. Bei der Fehlersuche kann man richtig viel Zeit versenken.

Ohne overload gibts direkt einen Fehler.

Und das virtual braucht man, wenn in einer Kindklasse dieser Constructor überschrieben werden soll.

[ConnorMcLeod]

Zitat von Dennis07:

Nach dem inherited brauchst du nur den Methodennamen schreiben, wenn sich die Parameterliste der Methoden unterscheidet. Auch brauchst du es überhaupt nicht anzugeben, wenn eine Methode überhaupt nicht überschrieben oder neu eingeführt wurde.

Es ist allerdings good practice, es trotz allem anzugeben. Dadurch ist immer klar, welche Methode aufgerufen wird. Ist ein ähnliches Thema wie <with>
Außerdem könntest Du mit gutem Gewissen <inherited;> schreiben in dem Glauben, daß auch tatsächlich etwas passiert - der Compiler akzeptiert das, aber wenn es gar keine Elternmethode gibt (oder sie dort abstrakt ist), dann wird nichts aufgerufen (auch kein Code erzeugt) und Du merkst nichts davon.

[Andreas L.]

Zitat von Dennis07:

Die Kombination der direktiven reintroduce; overload; virtual; in einer einzigen Methode mag vielleicht vom Kompiler akzeptiert werden, ergibt aber rein logisch betrachtet wenig Sinn.

Ich habe diese Deklaration 1:1 von TFieldDefs übernommen. Ich schau mal ob Änderungen helfen.

Zitat von Dennis07:

Klassen-und Recordfelder sowie Arrayelemente oder Strings brauchen nicht initialisiert zu werden (genau wie globale Variablen), wenn sie den Standardwert Default(DataType) haben sollen.

...

Nenne Parameter oder lokale Variablen niemals gleich wie Objekt-oder Klassenbezeichner!

Das ist mir bewusst. Du meinst bestimmt folgende Stelle:

Delphi-Quellcode:

constructor TTestCollection.Create(AOwner: TPersistent);
begin
  FParentItem := nil;

bzw.

Delphi-Quellcode:

constructor TTestCollectionItem.Create(Owner: TTestCollection;
  const Name: string);
begin
  FName := Name;
  inherited Create(Owner);
  FChilds := TTestCollection.Create(Self);
end;

Auch das habe ich von TFieldDefs kopiert. Wird aber natürlich im "richtigen" Code nicht so gemacht. Ich habe einfach die TFieldDefs als Vorlage benutzt und möglichst viel "Original" belassen.

Zitat von Dennis07:

Der Design Editor erzeugt Collection-Items immer über den virtuellen Konstruktor
constructor Create(Collection: TCollection); .
Wenn du diesen überschreibst, dann weiß die Collection immer, wie sie ein neues Item erzeugen kann (nämlich mit genau jenem Konstruktor). Wenn du ihn allerdings nicht überschreibst (override ), sondern neu einführst (reintroduce oder nichts explizites) oder überlädst (overload ), dann kann die Collection diesen ja nicht aufrufen, weil sie ihn (und seine Parameter) nicht kennt. Somit wird er nicht aufgerufen, was dazu führt, dass die Collection für Childs niemals erzeugt wird und somit auch im OI nicht zur Verfügung steht. Du musst die Methode TTestCollectionItem.Create also überschreiben. Deshalb darfst du ihre Signatur nicht ändern, sie muss also folgendermaßen deklariert werden:
constructor Create(Collection: TCollection); override; .

Das wird wohl das Problem sein.

Vielen Dank für eure Antworten

Ich werde den Code überarbeiten und melde mich dann wieder.

[Andreas L.]

Ich habe nun alle Änderungen durchgeführt. Leider öffnet sich der Collection-Editor bei den Childs-Properties weiterhin nicht.

Als Workaround habe ich jedem CollectionItem eine Property ChildHolder gegeben (von TComponent abgeleitet). Diese Klasse hat eine published-Eigenschaft Childs (TTestCollection). Bei dieser Eigenschaft wird der Collection-Editor angezeigt.

Aber ich muss sämtlichen TTestCollectonItems, TTestCollectionChildHolder und TTestCollectons das Root (also TComponent1) übergeben. Wenn ich TTestCollectionChildHolder mit nil als Owner initialisiere, wird das Objekt nicht im Object-Inspector angezeigt.

Ist ein ziemliches Gefrickel. Gefällt mir nicht wirklich.

Habt Ihr noch eine Idee was ich machen könnte?

[Dennis07]

Zitat von Andreas L.:

Ich habe nun alle Änderungen durchgeführt. Leider öffnet sich der Collection-Editor bei den Childs-Properties weiterhin nicht.

Unmöglich, ich hatte es nämlich selber getestet. Kannst du mal bitte den Quelltext hier rein posten?

[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.

[Andreas L.]

Mit deinem Code funktioniert es einwandfrei. Da hab ich wohl irgendwo einen kleinen Tipp-Fehler. Vielen Dank