Baumstruktur mit ObjectList

[flosoft]

Hallo,

bin gerade dabei eine "baumartige" Struktur (3 Ebenen) aus Objekten aufzubauen.
Im Prinzip wie eine TTreeView-Struktur - nur eben mit Objekten.

Einen ersten Ansatz habe ich hier http://www.delphipraxis.net/768187-post12.html bei Angos (s. Quellcode unten) gefunden.

Delphi-Quellcode:

type
  TMyObject = class(TObject)
  private
    FNAme: String;
  public
    property Name: String read FName write FName;
  end;

type
  TMyObjectList = class(TObjectList)
  private
    function GetItem(ndx: Integer): TMyObject;
    procedure SetItem(ndx: Integer; AValue: TMyObject);
  public
    property items[ndx: Integer]:TMyObject read GetItem write SetItem;
    
  end;
  
  
implementation

function TMyObjectList.GetItem(ndx: Integer): TMyObject;
begin
  Result := TMyObject(inherited items[ndx]);
end;

procedure TMyObjectList.SetItem(ndx: Integer; AValue: TMyObject);
begin
  items[ndx] := AValue;
end;

Erste Frage:
Sehe ich den Wald vor Bäumen nicht und in Delphi 2007 gibt es bereits eine "fertige" Lösung (TTreeView??)? :oops:

Zweite Frage:
Kann ich einfach den Ansatz von oben erweiten?
Etwa so:

Delphi-Quellcode:

type
  TMyObject = class(TObject)
  private
    FNAme: String;
  public
    property Name: String read FName write FName;
  end;

type
  TMyObjectList1 = class(TObjectList)
  private
    function GetItem(ndx: Integer): TMyObject;
    procedure SetItem(ndx: Integer; AValue: TMyObject);
  public
    property items[ndx: Integer]:TMyObject read GetItem write SetItem;
    
  end;

type
  TMyObjectList2 = class(TObjectList)
  private
    function GetItem(ndx: Integer): TMyObjectList1;
    procedure SetItem(ndx: Integer; AValue: TMyObjectList1);
  public
    property items[ndx: Integer]:TMyObjectList1 read GetItem write SetItem;
    
  end;
  
  
implementation

Danke für Eure Hilfe...

[spaxxn]

Kann es sein, dass du etwas in dieser Richtung suchst?

Delphi-Quellcode:

interface
uses
  SysUtils,Contnrs;

type
  TMyObjectList = class;

  TMyObject = class(TObject)
  private
    FList: TMyObjectList;
  public
    constructor Create;
    destructor Destroy; override;
    property Items: TMyObjectList read FList;
  end;

  TMyObjectList = class(TObject)
  private
    FList: TObjectList;
    function GetItem(Index: Integer): TMyObject;
  public
    constructor Create;
    destructor Destroy; override;
    function Add(aItem: TMyObject): integer;
    procedure Delete(aIndex: Integer);
    procedure Clear;
    function Count: integer;
    function IndexOf(aItem: TMyObject): integer;
    property Items[Index: Integer]:TMyObject read GetItem; default;
  end;

implementation

{ TMyObjectList }

function TMyObjectList.Add(aItem: TMyObject): integer;
begin
  Result := FList.Add(aItem);
end;

procedure TMyObjectList.Clear;
begin
  while Count > 0 do
    Delete(0);
end;

function TMyObjectList.Count: integer;
begin
  Result:= FList.Count;
end;

constructor TMyObjectList.Create;
begin
  inherited Create;
  FList := TObjectList.Create(false);
end;

procedure TMyObjectList.Delete(aIndex: Integer);
var o: TMyObject;
begin
  o := FList[aIndex] as TMyObject;
  FList.Delete(aIndex);
  o.Free;
end;

destructor TMyObjectList.Destroy;
begin
  Clear;
  FreeAndNil(FList);
  inherited Destroy;
end;

function TMyObjectList.GetItem(Index: Integer): TMyObject;
begin
  Result := FList[Index] as TMyObject;
end;

function TMyObjectList.IndexOf(aItem: TMyObject): integer;
begin
  for Result := 0 to Count -1 do begin
    if aItem = Items[Result] then
      Exit;
  end;
  Result := -1;
end;

{ TMyObject }

constructor TMyObject.Create;
begin
  inherited Create;
  FList := TMyObjectList.Create;
end;

destructor TMyObject.Destroy;
begin
  FreeAndNil(FList);
  inherited Destroy;
end;

Aber kein Gewähr, ist nur runtergeschrieben...

Du kannst dir eine Liste erzeugen und ihr Objekte hinzufügen. Jedes Objekt hat selbst wiederrum eine Liste, der du wieder Objekte hinzufügen kannst. usw usw.

[Popov]

Also ich würde einen simple Klasse erstellen (vereinfacht)

Delphi-Quellcode:

type
  TMyObject = class
    Obj: TObject;
    constructor Create;
    destructor Destroy;
  end;

Nach meiner Ansicht kannst du es dann unendlich zusammenfügen.

[spaxxn]

Zitat:

Zitat von Popov (Beitrag 1169714)

Also ich würde einen simple Klasse erstellen (vereinfacht)

Delphi-Quellcode:

type
  TMyObject = class
    Obj: TObject;
    constructor Create;
    destructor Destroy;
  end;

Nach meiner Ansicht kannst du es dann unendlich zusammenfügen.

Dann müsste er aber schon Ahnung vom Prinzip der doppelt verketteten Liste haben...

[shmia]

Um Baumstrukturen aufzubauen kann man das Komposite Design Pattern verwenden.

Was aber kaum bekannt ist: mit der Klasse

Delphi-Quellcode:

TComponent

kann man mit wenig Aufwand eine Baumstruktur aufbauen:

Delphi-Quellcode:

TDatenObjekt = class(TComponent)
public
  Bezeichnung : string;
end;

var
  wurzel : TComponent;
  t : TDatenObjekt;
begin
  wurzel := TComponent.Create(nil);
  t := TDatenObjekt.Create(wurzel);
  t.Bezeichnung := 'Zweig A';
  t := TDatenObjekt.Create(wurzel);
  t.Bezeichnung := 'Zweig B';
  
  t := TDatenObjekt.Create(t);
  t.Bezeichnung := 'Blatt 1 an Zweig B';

  t := TDatenObjekt.Create(t.Owner);
  t.Bezeichnung := 'Blatt 2 an Zweig B';

In dem man an der Wurzel einsteigt und über das Array

Delphi-Quellcode:

Components[]

iteriert, kann man auf alle Knoten der Baumstruktur zugreifen.
Die Anzahl der Objekte bekommt man über das Property

Delphi-Quellcode:

ComponentCount

.

Delphi-Quellcode:

// Alle Knoten rekursiv besuchen
procedure BaumAnzeigen(c:TComponent);
var
  i : Integer;
begin
  if not Assigned(c) then
    exit;
  if c is TDataObjekt then
     writeln(TDataObjekt(c).Bezeichnung)
  else
     writeln('?');
  for i := 0 to c.ComponentCount-1 do
    BaumAnzeigen(c.Components[i]);
end;

...
BaumAnzeigen(wurzel);

[flosoft]

Hallo,

danke für die Tips.

@spaxxn
Das sieht schon sehr gut aus. Werde ich mir anschauen...

@spaxxn und Popov
Ich wollte eben keine Listen benutzen - die kenne ich schon...
Habe den Ehrgeiz das vollständig mit Objekten zu machen. :roll:
Vielleicht nicht clever, aber ...

@shmia
Auch das sieht gut aus!


So, mit den beiden Ansätzen komme ich sicher weiter!
Werde die heute mal testen.

Ziel des Ganzen ist es übrigens eine Fuzzy-Regelung-Klasse zu erstellen. :oops:
Ja, ja nicht mehr hip, aber ...

Danke

[flosoft]

Hallo,

so, habe die Lösung von spaxxn genommen.
Copy&Paste...und funktioniert.

Chapeau! :thumb:

Habe wieder viel gelernt...

Grüße
flosoft


Hier meine ganz, ganz leicht modifizierte Version von spaxxn:

Delphi-Quellcode:

unit Fuzzy;

interface

uses SysUtils, Contnrs;

type
  TMyObjectList = class;

  TMyObject = class(TObject)
   private
     FName: String;
     FList: TMyObjectList;
     procedure SetName(Value: String);
   public
     constructor Create;
     destructor Destroy; override;
     property Name: String read FName write SetName;
     property Items: TMyObjectList read FList;
   end;

   TMyObjectList = class(TObject)
   private
     FName: String;
     FList: TObjectList;
     procedure SetName(Value: String);
     function GetItem(Index: Integer): TMyObject;
   public
     constructor Create;
     destructor Destroy; override;
     function Add(aItem: TMyObject): Integer;
     procedure Delete(aIndex: Integer);
     function Count: Integer;
     procedure Clear;
     function IndexOf(aItem: TMyObject): Integer;
     property Name: String read FName write SetName;
     property Items[Index: Integer]: TMyObject read GetItem; default;
   end;

implementation


//// TMyObjectList -------------------------------------------------------------
//-------------------------------
constructor TMyObjectList.Create;
//-------------------------------
begin
  inherited Create;
  FList:=TObjectList.Create(false);
end;

//-------------------------------
destructor TMyObjectList.Destroy;
//-------------------------------
begin
   Clear;
   FreeAndNil(FList);
   inherited Destroy;
end;

//----------------------------------------------
procedure  TMyObjectList.SetName(Value: String);
//----------------------------------------------
begin
  FName:=Value;
end;

//----------------------------------------------------
function TMyObjectList.Add(aItem: TMyObject): Integer;
//----------------------------------------------------
begin
  Result:=FList.Add(aItem);
end;

//----------------------------------------------
procedure TMyObjectList.Delete(aIndex: Integer);
//----------------------------------------------
var o: TMyObject;
begin
   o:=FList[aIndex] as TMyObject;
   FList.Delete(aIndex);
   o.Free;
end;

//------------------------------------
function TMyObjectList.Count: Integer;
//------------------------------------
begin
  Result:=FList.Count;
end;

//----------------------------
procedure TMyObjectList.Clear;
//----------------------------
begin
  while Count > 0 do Delete(0);
end;

//--------------------------------------------------------
function TMyObjectList.GetItem(Index: Integer): TMyObject;
//--------------------------------------------------------
begin
  Result:=FList[Index] as TMyObject;
end;

//--------------------------------------------------------
function TMyObjectList.IndexOf(aItem: TMyObject): Integer;
//--------------------------------------------------------
begin
  for Result:=0 to Count - 1 do
  begin
    if aItem = Items[Result] then Exit;
  end;
  Result:=-1;
end;


//// TMyObject -----------------------------------------------------------------
//---------------------------
constructor TMyObject.Create;
//---------------------------
begin
   inherited Create;
   FList:=TMyObjectList.Create;
end;

//---------------------------
destructor TMyObject.Destroy;
//---------------------------
begin
  FreeAndNil(FList);
  inherited Destroy;
end;

//------------------------------------------
procedure  TMyObject.SetName(Value: String);
//------------------------------------------
begin
  FName:=Value;
end;

end.

... und mein Test (sollte so zu verstehen sein :-D):

Delphi-Quellcode:

procedure TForm1.Button2Click(Sender: TObject);
var
  i: Integer;
  aObj: TMyObject;
begin
  aObj:=TMyObject.Create;
  aObj.Name:='Heizung';

  aObj.Items.Add(TMyObject.Create);
  aObj.Items[0].Name:='Fuzzy Variable 0(Temperatur)';
  aObj.Items.Add(TMyObject.Create);
  aObj.Items[1].Name:='Fuzzy Variable 1(Druck)';

  Label5.Caption:='Fuzzy Regelung: ' + aObj.Name;
  Label6.Caption:='Anzahl der Fuzzy Variablen: ' + IntToStr(aObj.Items.Count);
  for i:=0 to aObj.Items.Count - 1 do ListBox1.Items.Add(aObj.Items[i].Name);

  aObj.Items[0].Items.Add(TMyObject.Create);
  aObj.Items[0].Items[0].Name:='Fuzzy Term 0(kalt)';
  aObj.Items[0].Items.Add(TMyObject.Create);
  aObj.Items[0].Items[1].Name:='Fuzzy Term 1(lau)';
  aObj.Items[0].Items.Add(TMyObject.Create);
  aObj.Items[0].Items[2].Name:='Fuzzy Term 2(heiss)';

  Label8.Caption:='Anzahl der Fuzzy Terme (hier: Temperatur): ' + IntToStr(aObj.Items[0].Items.Count);
  for i:=0 to aObj.Items[0].Items.Count - 1 do ListBox2.Items.Add(aObj.Items[0].Items[i].Name);

  aObj.Items[0].Items[1].Items.Add(TMyObject.Create);
  aObj.Items[0].Items[1].Items[0].Name:='Eigenschaften/Methoden 0 von Fuzzy Term 1(lau)';
  aObj.Items[0].Items[1].Items.Add(TMyObject.Create);
  aObj.Items[0].Items[1].Items[1].Name:='Eigenschaften/Methoden 1 von Fuzzy Term 1(lau)';
  aObj.Items[0].Items[1].Items.Add(TMyObject.Create);
  aObj.Items[0].Items[1].Items[2].Name:='Eigenschaften/Methoden 2 von Fuzzy Term 1(lau)';
  aObj.Items[0].Items[1].Items.Add(TMyObject.Create);
  aObj.Items[0].Items[1].Items[3].Name:='Eigenschaften/Methoden 3 von Fuzzy Term 1(lau)';

  Label10.Caption:='Anzahl der E/M der Terme (hier: lau): ' + IntToStr(aObj.Items[0].Items[1].Items.Count);
  for i:=0 to aObj.Items[0].Items[1].Items.Count - 1 do ListBox3.Items.Add(aObj.Items[0].Items[1].Items[i].Name);
end;

[DeddyH]

Setz doch mal testhalber ReportMemoryLeaksOnShutdown auf true.

[spaxxn]

DeddyH, ich bin mir zwar ziemlich sicher, dass das leckfrei ist, aber wie oben beschrieben, ist das nur runtergeschrieben gewesen. Habs nicht ein mal getestet, von daher kann ich es nicht ausschliessen...

Oder spielst du darauf an, dass "aObj" nicht wieder freigegeben wird in Button2Click?

[DeddyH]

Zum Einen das und zum Anderen: wieso wird OwnsObjects auf false gesetzt beim Erzeugen der Objektliste. Hab ich etwas übersehen, was das erforderlich macht?