Einzelnen Beitrag anzeigen

Andreas L.

Registriert seit: 23. Mai 2011
Ort: Furth im Wald
308 Beiträge
 
Delphi 11 Alexandria
 
#1

TCollectionItem mit einer Collection - Wie?

  Alt 28. Feb 2019, 13:51
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?
Andreas Lauß
Blog
  Mit Zitat antworten Zitat