AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

TCollectionItem mit einer Collection - Wie?

Ein Thema von Andreas L. · begonnen am 28. Feb 2019 · letzter Beitrag vom 3. Mär 2019
 
Dennis07

Registriert seit: 19. Sep 2011
Ort: Deutschland
496 Beiträge
 
Delphi 12 Athens
 
#8

AW: TCollectionItem mit einer Collection - Wie?

  Alt 2. Mär 2019, 15:51
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.
Dennis
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 21:27 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz