Freepascal AVLTree, Binären Baum allgemein verstehen?

[Fiete45]

Moin,
in meinem Archiv habe ich noch eine Demo anno 1990 gefunden.
Programmiert in TP 4

PROGRAM AVL_BAUMDEMONSTRATION;
USES CRT;
CONST MAX=3;
TYPE BAUMINHALT=STRING[MAX];
SEITE=(LEFT,NONE,RIGHT);
BAUMZEIGER=^KNOTEN;
KNOTEN=RECORD
INHALT:BAUMINHALT;
LINKS,RECHTS:BAUMZEIGER;
SCHIEFE:SEITE
END;
VAR BAUM,SBAUM:BAUMZEIGER;
EINGABE:BAUMINHALT;
AUSWAHL:CHAR;
FELD:BYTE;
ZUSTAND:BOOLEAN;
PROCEDURE AUSGABE(X:INTEGER);
BEGIN
GOTOXY(41,18);WRITE('Stichwort ');
CASE X OF
0 : WRITE('wurde nicht gefunden.');
1 : WRITE('wird eingetragen.');
2 : WRITE('wird geloescht.');
3 : WRITE('wurde gefunden.');
4 : WRITE('ist schon vorhanden')
END;
CLREOL;GOTOXY(1,24);WRITE('Weiter mit <RETURN>');READ;GOTOXY(1,24);CLREOL
END;
PROCEDURE ROT_R(VAR BAUM:BAUMZEIGER);
VAR AST:BAUMZEIGER;
BEGIN
AST:=BAUM^.LINKS;BAUM^.LINKS:=AST^.RECHTS;AST^.REC HTS:=BAUM;BAUM:=AST
END;
PROCEDURE ROT_L(VAR BAUM:BAUMZEIGER);
VAR AST:BAUMZEIGER;
BEGIN
AST:=BAUM^.RECHTS;BAUM^.RECHTS:=AST^.LINKS;AST^.LI NKS:=BAUM;BAUM:=AST
END;
PROCEDURE ROT_LR(VAR BAUM:BAUMZEIGER);
VAR AST1,AST2:BAUMZEIGER;
BEGIN
AST1:=BAUM^.LINKS;AST2:=BAUM^.RECHTS;AST1^.RECHTS: =AST2^.LINKS;
AST2^.LINKS:=AST1;BAUM^.LINKS:=AST2^.RECHTS;AST2^. RECHTS:=BAUM;
IF AST2^.SCHIEFE=LEFT THEN BAUM^.SCHIEFE:=RIGHT ELSE BAUM^.SCHIEFE:=NONE;
IF AST2^.SCHIEFE=RIGHT THEN AST1^.SCHIEFE:=LEFT ELSE AST1^.SCHIEFE:=NONE;
BAUM:=AST2
END;
PROCEDURE ROT_RL(VAR BAUM:BAUMZEIGER);
VAR AST1,AST2:BAUMZEIGER;
BEGIN
AST1:=BAUM^.RECHTS;AST2:=BAUM^.LINKS;AST1^.LINKS:= AST2^.RECHTS;
AST2^.RECHTS:=AST1;BAUM^.RECHTS:=AST2^.LINKS;AST2^ .LINKS:=BAUM;
IF AST2^.SCHIEFE=RIGHT THEN BAUM^.SCHIEFE:=LEFT ELSE BAUM^.SCHIEFE:=NONE;
IF AST2^.SCHIEFE=LEFT THEN AST1^.SCHIEFE:=RIGHT ELSE AST1^.SCHIEFE:=NONE;
BAUM:=AST2
END;
PROCEDURE EINFUEGEN(VAR BAUM:BAUMZEIGER;STICHWORT:BAUMINHALT;VAR GEWACHSEN:BOOLEAN);
PROCEDURE ERZEUGEN(VAR BAUM:BAUMZEIGER;STICHWORT:BAUMINHALT;VAR GEWACHSEN:BOOLEAN);
BEGIN
NEW(BAUM);GEWACHSEN:=TRUE;BAUM^.INHALT:=STICHWORT; AUSGABE(1);
WITH BAUM^ DO BEGIN LINKS:=NIL;RECHTS:=NIL;SCHIEFE:=NONE END
END;
PROCEDURE WEITER_LINKS(VAR BAUM:BAUMZEIGER;STICHWORT:BAUMINHALT;VAR GEWACHSEN:BOOLEAN);
BEGIN
EINFUEGEN(BAUM^.LINKS,STICHWORT,GEWACHSEN);
IF GEWACHSEN THEN
CASE BAUM^.SCHIEFE OF
RIGHT: BEGIN BAUM^.SCHIEFE:=NONE;GEWACHSEN:=FALSE END;
NONE : BAUM^.SCHIEFE:=LEFT;
LEFT : BEGIN
IF BAUM^.LINKS^.SCHIEFE=LEFT THEN
BEGIN ROT_R(BAUM);BAUM^.RECHTS^.SCHIEFE:=NONE END
ELSE ROT_LR(BAUM);
BAUM^.SCHIEFE:=NONE;GEWACHSEN:=FALSE
END
END
END;
PROCEDURE WEITER_RECHTS(VAR BAUM:BAUMZEIGER;STICHWORT:BAUMINHALT;VAR GEWACHSEN:BOOLEAN);
BEGIN
EINFUEGEN(BAUM^.RECHTS,STICHWORT,GEWACHSEN);
IF GEWACHSEN THEN
CASE BAUM^.SCHIEFE OF
RIGHT: BEGIN
IF BAUM^.RECHTS^.SCHIEFE=RIGHT THEN
BEGIN ROT_L(BAUM);BAUM^.LINKS^.SCHIEFE:=NONE END
ELSE ROT_RL(BAUM);
BAUM^.SCHIEFE:=NONE;GEWACHSEN:=FALSE
END;
NONE : BAUM^.SCHIEFE:=RIGHT;
LEFT : BEGIN BAUM^.SCHIEFE:=NONE;GEWACHSEN:=FALSE END
END
END;
BEGIN(* OF EINFUEGEN *)
IF BAUM=NIL THEN ERZEUGEN(BAUM,STICHWORT,GEWACHSEN)
ELSE IF BAUM^.INHALT>STICHWORT THEN WEITER_LINKS(BAUM,STICHWORT,GEWACHSEN)
ELSE IF BAUM^.INHALT<STICHWORT THEN WEITER_RECHTS(BAUM,STICHWORT,GEWACHSEN)
ELSE BEGIN AUSGABE(4);GEWACHSEN:=FALSE END (* SCHON VORHANDEN *)
END;(* OF EINFUEGEN *)
PROCEDURE LOESCHEN(VAR BAUM:BAUMZEIGER;STICHWORT:BAUMINHALT;VAR GESCHRUMPFT:BOOLEAN);
VAR KNOTEN:BAUMZEIGER;
PROCEDURE AUSGL_RECHTS(VAR BAUM:BAUMZEIGER;VAR GESCHRUMPFT:BOOLEAN);
BEGIN
CASE BAUM^.SCHIEFE OF
LEFT : CASE BAUM^.LINKS^.SCHIEFE OF
LEFT : BEGIN
ROT_R(BAUM);BAUM^.SCHIEFE:=NONE;BAUM^.RECHTS^.SCHI EFE:=NONE
END;
NONE : BEGIN
ROT_R(BAUM);BAUM^.SCHIEFE:=RIGHT;BAUM^.RECHTS^.SCH IEFE:=LEFT;
GESCHRUMPFT:=FALSE
END;
RIGHT: BEGIN ROT_LR(BAUM);BAUM^.SCHIEFE:=NONE END;
END;
NONE : BEGIN BAUM^.SCHIEFE:=LEFT;GESCHRUMPFT:=FALSE END;
RIGHT: BAUM^.SCHIEFE:=NONE
END
END;
PROCEDURE AUSGL_LINKS(VAR BAUM:BAUMZEIGER;VAR GESCHRUMPFT:BOOLEAN);
BEGIN
CASE BAUM^.SCHIEFE OF
RIGHT : CASE BAUM^.RECHTS^.SCHIEFE OF
RIGHT : BEGIN
ROT_L(BAUM);BAUM^.SCHIEFE:=NONE;BAUM^.LINKS^.SCHIE FE:=NONE
END;
NONE : BEGIN
ROT_L(BAUM);BAUM^.SCHIEFE:=LEFT;BAUM^.LINKS^.SCHIE FE:=RIGHT;
GESCHRUMPFT:=FALSE
END;
LEFT: BEGIN ROT_RL(BAUM);BAUM^.SCHIEFE:=NONE END;
END;
NONE : BEGIN BAUM^.SCHIEFE:=RIGHT;GESCHRUMPFT:=FALSE END;
LEFT: BAUM^.SCHIEFE:=NONE
END
END;
PROCEDURE KLEINSTEN_HOLEN(VAR ZWEIG:BAUMZEIGER;VAR GESCHRUMPFT:BOOLEAN);
BEGIN
IF ZWEIG^.LINKS=NIL THEN
BEGIN
BAUM^.INHALT:=ZWEIG^.INHALT;KNOTEN:=ZWEIG;ZWEIG:=Z WEIG^.RECHTS;
GESCHRUMPFT:=TRUE
END
ELSE BEGIN
KLEINSTEN_HOLEN(ZWEIG^.LINKS,GESCHRUMPFT);
IF GESCHRUMPFT THEN AUSGL_LINKS(ZWEIG,GESCHRUMPFT)
END
END;
PROCEDURE ENTFERNEN(VAR BAUM:BAUMZEIGER;VAR GESCHRUMPFT:BOOLEAN);
BEGIN
KNOTEN:=BAUM;
IF BAUM^.RECHTS=NIL THEN BEGIN BAUM:=BAUM^.LINKS;GESCHRUMPFT:=TRUE END
ELSE IF BAUM^.LINKS=NIL THEN BEGIN BAUM:=BAUM^.RECHTS;GESCHRUMPFT:=TRUE END
ELSE BEGIN
KLEINSTEN_HOLEN(BAUM^.RECHTS,GESCHRUMPFT);
IF GESCHRUMPFT THEN AUSGL_RECHTS(BAUM,GESCHRUMPFT)
END;
DISPOSE(KNOTEN)
END;
BEGIN(* OF LOESCHEN *)
IF BAUM=NIL THEN BEGIN AUSGABE(0);GESCHRUMPFT:=FALSE END (* NICHT VORHANDEN *)
ELSE IF BAUM^.INHALT>STICHWORT THEN
BEGIN
LOESCHEN(BAUM^.LINKS,STICHWORT,GESCHRUMPFT);
IF GESCHRUMPFT THEN AUSGL_LINKS(BAUM,GESCHRUMPFT)
END
ELSE IF BAUM^.INHALT<STICHWORT THEN
BEGIN
LOESCHEN(BAUM^.RECHTS,STICHWORT,GESCHRUMPFT);
IF GESCHRUMPFT THEN AUSGL_RECHTS(BAUM,GESCHRUMPFT)
END
ELSE BEGIN AUSGABE(2);ENTFERNEN(BAUM,GESCHRUMPFT) END (* WIRD GELOESCHT *)
END;(* OF LOESCHEN *)
PROCEDURE SUCHEN(TREE:BAUMZEIGER;VAR BAUM:BAUMZEIGER;STICHWORT:BAUMINHALT);
BEGIN
BAUM:=TREE;
IF BAUM=NIL THEN AUSGABE(0)
ELSE IF BAUM^.INHALT>STICHWORT THEN SUCHEN(BAUM^.LINKS,BAUM,STICHWORT)
ELSE IF BAUM^.INHALT<STICHWORT THEN SUCHEN(BAUM^.RECHTS,BAUM,STICHWORT)
ELSE AUSGABE(3)
END;
PROCEDURE LINIE(VON,BIS,ZEILE:INTEGER);
VAR I:INTEGER;
BEGIN
IF VON<BIS THEN FOR I:=VON TO BIS DO BEGIN GOTOXY(I,ZEILE);WRITE('-') END
ELSE FOR I:=VON DOWNTO BIS DO BEGIN GOTOXY(I,ZEILE);WRITE('-') END;
GOTOXY(BIS,ZEILE+1);WRITE('I')
END;
PROCEDURE KOPF;
BEGIN
CLRSCR;
WRITELN('Demonstration eines AVL-Baumes':58);
WRITELN('------------------------------':58)
END;
PROCEDURE SCHREIBBAUM(B:BAUMZEIGER;X,Y,BREITE:INTEGER);
VAR H:BYTE;
BEGIN
IF B<>NIL THEN
BEGIN
IF B^.LINKS<>NIL THEN BEGIN
LINIE(X-FELD+1,X-BREITE DIV 2,Y);
SCHREIBBAUM(B^.LINKS,X-BREITE DIV 2,Y+2,BREITE DIV 2)
END;
GOTOXY(X-FELD DIV 2,Y);WRITE(COPY(B^.INHALT,1,FELD));
IF B^.RECHTS<>NIL THEN BEGIN
H:=0;IF FELD=1 THEN H:=1;
LINIE(X+FELD-1+H,X+BREITE DIV 2,Y);
SCHREIBBAUM(B^.RECHTS,X+BREITE DIV 2,Y+2,BREITE DIV 2)
END
END
END;
PROCEDURE PREORDER(B:BAUMZEIGER);
BEGIN
IF B<>NIL THEN
BEGIN
WRITE(B^.INHALT:FELD+1);PREORDER(B^.LINKS);PREORDE R(B^.RECHTS)
END
END;
PROCEDURE INORDER(B:BAUMZEIGER);
BEGIN
IF B<>NIL THEN
BEGIN
INORDER(B^.LINKS);WRITE(B^.INHALT:FELD+1);INORDER( B^.RECHTS)
END
END;
PROCEDURE POSTORDER(B:BAUMZEIGER);
BEGIN
IF B<>NIL THEN
BEGIN
POSTORDER(B^.LINKS);POSTORDER(B^.RECHTS);WRITE(B^. INHALT:FELD+1)
END
END;
BEGIN(* OF MAIN *)
CLRSCR;
REPEAT
WRITE('MAXIMALE EINGABELAENGE (1-',MAX:1,') ? ');READLN(FELD)
UNTIL FELD IN[1..MAX];
KOPF;BAUM:=NIL;
REPEAT
GOTOXY(1,23);CLREOL;GOTOXY(1,23);
WRITE('(E)inf�gen (L)”schen (S)uchen (Q)uit : ');CLREOL;
REPEAT
AUSWAHL:=UPCASE(READKEY)
UNTIL AUSWAHL IN['E','L','S','Q'];WRITELN(AUSWAHL);
IF AUSWAHL<>'Q' THEN
BEGIN
REPEAT
GOTOXY(1,24);CLREOL;GOTOXY(1,24);
WRITE('Dein Begriff : ');READLN(EINGABE)
UNTIL LENGTH(EINGABE)>0;
EINGABE:=COPY(EINGABE,1,FELD);
CASE AUSWAHL OF
'E': BEGIN EINFUEGEN(BAUM,EINGABE,ZUSTAND);KOPF;SCHREIBBAUM(B AUM,40,5,40) END;
'L': BEGIN LOESCHEN(BAUM,EINGABE,ZUSTAND);KOPF;SCHREIBBAUM(BA UM,40,5,40) END;
'S': BEGIN
SUCHEN(BAUM,SBAUM,EINGABE);KOPF;
IF SBAUM<>NIL THEN SCHREIBBAUM(SBAUM,40,5,40)
END
END;
GOTOXY(20,24);WRITE('Weiter mit <ENTER>');READLN;GOTOXY(1,24);CLREOL;
SCHREIBBAUM(BAUM,40,5,40);
GOTOXY(1,16);WRITE('Preorder :');PREORDER(BAUM);
GOTOXY(1,18);WRITE('Inorder :');INORDER(BAUM);
GOTOXY(1,20);WRITE('Postorder :');POSTORDER(BAUM)
END
UNTIL AUSWAHL='Q'
END.

Gruß Fiete

[MPeters]

Danke zuerst für Eure Antworten.

@Fiete, Deinen Entwurf schau ich mir jetzt in den nächsten Tagen an.

Ich habe jetzt erst mal folgenden Entwurf für eine Baumstruktur, die aber noch nicht funktioniert wie sie soll. In meinem TMemo wird nichts ausgegeben. Hatte in der FormCreate Methode die Prozedur CreateNodes vergessen, aufzurufen, nun aber bekomme ich eine Schutzverletzung an Adresse $00615729.

Hier der Code:

Zuerst der Baum:

Delphi-Quellcode:

unit ugentree;

interface

uses classes;

type
  TCompareStrFunc = function(s1,s2: String): Integer;
  TCompareIntFunc = function(i1,i2: Integer): Integer;
  TCompareFunc = function(p1,p2: String): Integer;

  TNode = class;

  TNodeData = class(TObject)
    FKey: Integer;
    FKeyStr: String;
    FData: Pointer;
    FNode: TNode;
    constructor Create(aKey: Integer; aKeyStr: String; aData: Pointer; var aNode: TNode);
    property Key: Integer read FKey write FKey;
    property KeyStr: String read FKeyStr write FKeyStr;
    property Data: Pointer read FData write FData;
    property Node: TNode read FNode write FNode;
  end;

  TNodes = class(TList)
  private
    function GetNodes(Index: Integer): TNode;
  public
    function Add(aNode: TNode): Integer;
    property Nodes[Index: Integer]: TNode read GetNodes;
  end;

  TNode = class(TObject)
  private
    FCompare: TCompareFunc;
    FData: TNodeData;
    FParent: TNode;
    FSubnodes: TNodes;

    function GetCount: Integer;
    function GetNodes(Index: Integer): TNode;
    procedure SetData(const Value: TNodeData);
  public
    constructor Create(CompareFunc: TCompareFunc);
    destructor Destroy; override;

    procedure Add(ParentNode: TNode; aData: TNodeData);
    procedure AddSubnode(aNode: TNode; aData: TNodeData);                         //Neuen Sub Knoten hinzufügen

    property Data: TNodeData read FData write SetData;                            //Datenihnalt dieses ersten Konotens oder der Wurzel
    property Nodes[Index: Integer]: TNode read GetNodes;                          //Die Blätter
    property Count: Integer read GetCount;                                        //Anzahl Blätter
    property Parent: TNode read FParent write FParent;
  end;

function CompareInt(a,b: Integer): Integer;
function CompareStr(s,t: String): Integer;

implementation

function CompareInt(a,b: Integer): Integer;
begin
  if a<b then Result := -1 else
  if a=b then Result :=  0 else
  Result := +1;
end;

function CompareStr(s,t: String): Integer;
begin
  if s<t then Result := -1 else
  if s=t then Result :=  0 else
  Result := +1;
end;

{ TNode }

procedure TNode.Add(ParentNode: TNode; aData: TNodeData);
begin

end;

procedure TNode.AddSubnode(aNode: TNode; aData: TNodeData);
begin
  FSubnodes.Add(aNode);
end;

constructor TNode.Create(CompareFunc: TCompareFunc);
var a: Pointer; b: TNode;
begin
  inherited Create;
  //FData := FData.Create(0,'',a,b);
  FSubnodes := TNodes.Create;

  FCompare := @CompareFunc;
end;

destructor TNode.Destroy;
begin
  FSubnodes.Free;
  FData.Free;
  inherited;
end;

function TNode.GetCount: Integer;
begin
  Result := FSubnodes.Count;
end;

function TNode.GetNodes(Index: Integer): TNode;
begin
  if Index < 0 then Result := NIL;
  if Index >= FSubnodes.Count then Result := NIL;

  if (Index < FSubnodes.Count) and (Index >= 0) then
    Result := FSubNodes.Nodes[Index];
end;

procedure TNode.SetData(const Value: TNodeData);
begin
  FData := Value;
end;

{ TNodes }

function TNodes.Add(aNode: TNode): Integer;
begin
  Result := inherited Add(Pointer(aNode));
end;

function TNodes.GetNodes(Index: Integer): TNode;
begin
  Result := TNode(Items[Index]);
end;

{ TNodeData }

constructor TNodeData.Create(aKey: Integer; aKeyStr: String; aData: Pointer;
  var aNode: TNode);
begin
  inherited Create;
  //FNode := TNode.Create(CompareStr);
  FData := aData;
  FKeyStr := aKeyStr;
  FKey := aKey;
end;

end.

Nun die Formular Unit:

Delphi-Quellcode:

unit Utreeform;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, ugentree, Vcl.StdCtrls;

type
  TForm2 = class(TForm)
    Memo1: TMemo;
    lblComponents: TLabel;
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form2: TForm2;

  Root: TNode;
  myFirstNode: TNode;
  mySecondNode: TNode;
  MyThirdNode: TNode;

implementation

{$R *.dfm}

procedure CreateNodes;
var Data: TNodeData; Node: TNode;
begin
  Node := TNode.Create(CompareStr);
  Data := TNodeData.Create(0,'TButton',nil,Node);
  Data.KeyStr := 'TButton';
  Root.AddSubnode(TNode.Create(CompareStr),Data);

  Node := TNode.Create(CompareStr);
  Data := TNodeData.Create(0,'TEdit',nil,Node);
  Data.KeyStr := 'TEdit';
  Root.AddSubnode(TNode.Create(CompareStr),Data);

  Node := TNode.Create(CompareStr);
  Data := TNodeData.Create(0,'TGrid',nil,Node);
  Data.KeyStr := 'TGrid';
  Root.AddSubnode(TNode.Create(CompareStr),Data);
end;


procedure TForm2.FormCreate(Sender: TObject);
var i: Integer; D: TNodeData;
begin
  CreateNodes;
  for i := 0 to Root.Count-1 do
  begin
    D := Root.Nodes[i].Data;
    Memo1.Lines.Add(D.KeyStr);
  end;
end;

initialization
   Root := TNode.Create(CompareStr);

finalization

end.

Ich will die Knoten an seine Blätter hängen, die als TList realisiert sind um nicht nur Links und Rechts zu haben sondern beliebig viele Unterknoten. Die will ich nun an Root anhängen.

Leider funktioniert das noch nicht und hier komme ich alleine nicht weiter. Was muss ich hier anders machen?

[hoika]

Hallo,
F5, F7, F8 benutzen?

[Gausi]

Delphi-Quellcode:

Node := TNode.Create(CompareStr);
Data := TNodeData.Create(0,'TButton',nil,Node);
Data.KeyStr := 'TButton';
Root.AddSubnode(TNode.Create(CompareStr),Data);  // ???

Warum erzeugst du an der markierten Stelle einen neuen Knoten? Das führt doch dazu, dass du an Root einen Knoten einfügst, der ein Data-Objekt enthält, das auf einen Knoten Node verweist, der nach Ablauf der Prozedur CreateNodes gar nicht mehr da ist.

So sollte es funktionieren:

Root.AddSubnode(Node, Data);

[MPeters]

@Gausi: Danke, aber leider funktioniert auch das nicht.

Auch mit dieser Änderung funkt der Code nicht

Delphi-Quellcode:

function TForm2.CreateNodes: TNode;
var
  Data: TNodeData; Node: TNode;
begin

  Node := TNode.Create(CompareStr);
  Data := TNodeData.Create(0,'TButton',nil);
  //Data.KeyStr := 'TButton';

  Root.AddSubnode(TNode.Create(CompareStr),Data);

  Node := TNode.Create(CompareStr);
  Data := TNodeData.Create(0,'TEdit',nil);
  //Data.KeyStr := 'TEdit';

  Root.AddSubnode(TNode.Create(CompareStr),Data);

  Node := TNode.Create(CompareStr);
  Data := TNodeData.Create(0,'TGrid',nil);
  //Data.KeyStr := 'TGrid';

  Root.AddSubnode(TNode.Create(CompareStr),Data);
  Result := Root;
end;


procedure TForm2.FormCreate(Sender: TObject);
var i: Integer; D: TNodeData; N: TNode;
begin
  N:=CreateNodes();


  for i := 0 to N.Count-1 do
  begin
    D := N.Nodes[i].Data;
    Memo1.Lines.Add(D.KeyStr);
  end;

end;

Hier noch der geänderte Constructor für TNodeData. Node wird nun innerhalb des Konstruktors nicht mehr erzeugt.

Delphi-Quellcode:

constructor TNodeData.Create(aKey: Integer; aKeyStr: String; aData: Pointer);
begin
  inherited Create;
  //FNode := TNode.Create(CompareStr);  //wurde nun entfernt
  FData := aData;
  FKeyStr := aKeyStr;
  FKey := aKey;
end;

Ich erhalte eine Schutzverletzung, der Debugger bleibt auf

Memo1.Lines.Add(D.KeyStr);

in der Methode FormCreate stehen.

Warum? Was mache ich da noch falsch? Ich will doch die Knoten als Subknoten an Root anhängen. Alles Andere folgt später, wenn das hier klappt.

Der Code ist mit Ausnahme der Codeausschnitte hier gleich dem im Eingangsbeitrag geblieben, die Änderungen sind nun hier in diesem Beitrag.

[Gausi]

Wenn ich das richtig sehe, wird jetzt an keiner Stelle mehr die Eigenschaft Data der Nodes gesetzt. D.h. du erzeugst zwar Objekte vom Typ TNodeData und TNode, die Nodes wissen aber nichts von NodData. Wenn du dann auf Nodes[i].Data zugreifst, dann knallt es halt ...

[MPeters]

Ich habe das Problem jetzt so hier gelöst.

Delphi-Quellcode:

unit ugentree;

interface

uses classes;

type
  TCompareStrFunc = function(s1,s2: String): Integer;
  TCompareIntFunc = function(i1,i2: Integer): Integer;
  TCompareFunc = function(p1,p2: String): Integer;

  TNode = class;

  TNodeData = class(TObject)
    FKey: Integer;
    FKeyStr: String;
    FData: Pointer;

    constructor Create(aKey: Integer; aKeyStr: String);
    property Key: Integer read FKey write FKey;
    property KeyStr: String read FKeyStr write FKeyStr;
   // property Data: Pointer read FData write FData;
   // property Node: TNode read FNode write FNode;
  end;

  TNodes = class(TList)
  private
    function GetNodes(Index: Integer): TNode;
  public
    function Add(aNode: TNode): Integer;
    property Nodes[Index: Integer]: TNode read GetNodes;
  end;

  TNode = class(TObject)
  private
    FCompare: TCompareFunc;
    FCaption: String;
    FParent: TNode;
    FSubnodes: TNodes;

    function GetCount: Integer;
    function GetNodes(Index: Integer): TNode;
  public
    constructor Create(aParent: TNode; CompareFunc: TCompareFunc; aCaption: String);
    destructor Destroy; override;

    procedure Add(ParentNode: TNode; aNode: TNode);
    procedure AddSubnode(aParentNode: TNode; aNode: TNode);                         //Neuen Sub Knoten hinzufügen

    property Caption: String read FCaption write FCaption;
    property Nodes[Index: Integer]: TNode read GetNodes;                          //Die Blätter
    property Count: Integer read GetCount;                                        //Anzahl Blätter
    property Parent: TNode read FParent write FParent;
  end;

function CompareInt(a,b: Integer): Integer;
function CompareStr(s,t: String): Integer;

implementation

function CompareInt(a,b: Integer): Integer;
begin
  if a<b then Result := -1 else
  if a=b then Result :=  0 else
  Result := +1;
end;

function CompareStr(s,t: String): Integer;
begin
  if s<t then Result := -1 else
  if s=t then Result :=  0 else
  Result := +1;
end;

{ TNode }

procedure TNode.Add(ParentNode: TNode; aNode: TNode);
begin
  ParentNode.Nodes[ParentNode.FSubNodes.Count-1].AddSubNode(ParentNode,aNode);
end;

procedure TNode.AddSubnode(aParentNode: TNode; ANode: TNode);
begin
  aNode.Parent := aParentNode;
  FSubNodes.Add(aNode);
end;

constructor TNode.Create(aParent: TNode; CompareFunc: TCompareFunc; aCaption: String);
var a: Pointer; b: TNode;
begin
  inherited Create;
  FParent := aParent;
  FCaption := aCaption;
  FSubnodes := TNodes.Create;  //Zeiger auf Subnodes als Liste realisiert
  FCompare := @CompareFunc;
end;

destructor TNode.Destroy;
begin
  FSubnodes.Free;
  inherited;
end;

function TNode.GetCount: Integer;
begin
  Result := FSubnodes.Count;
end;

function TNode.GetNodes(Index: Integer): TNode;
begin
  if Index < 0 then Result := NIL;
  if Index >= FSubnodes.Count then Result := NIL;

  if (Index < FSubnodes.Count) and (Index >= 0) then
    Result := FSubNodes.Nodes[Index];
end;


{ TNodes }

function TNodes.Add(aNode: TNode): Integer;
begin
  Result := inherited Add(Pointer(aNode));
end;

function TNodes.GetNodes(Index: Integer): TNode;
begin
  Result := TNode(Items[Index]);
end;

{ TNodeData }

constructor TNodeData.Create(aKey: Integer; aKeyStr: String);
begin
  inherited Create;

  FKeyStr := aKeyStr;
  FKey := aKey;
end;

end.

Delphi-Quellcode:

unit Utreeform;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, ugentree, Vcl.StdCtrls;

type
  TForm2 = class(TForm)
    Memo1: TMemo;
    lblComponents: TLabel;
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
    function CreateNodes: TNode;
  end;

var
  Form2: TForm2;

  Root: TNode;
  myFirstNode: TNode;
  mySecondNode: TNode;
  MyThirdNode: TNode;

implementation

{$R *.dfm}

function TForm2.CreateNodes: TNode;
var
  Data: TNodeData; Node: TNode;
begin
  Root.AddSubNode(nil,TNode.Create(Root,CompareStr,'TButton'));

  Root.AddSubnode(nil,TNode.Create(Root,CompareStr,'TEdit'));


  //Data.KeyStr := 'TEdit';

  Root.AddSubnode(nil,TNode.Create(Root,CompareStr,'TGrid'));

  //Node := TNode.Create(CompareStr);

  //Data.KeyStr := 'TGrid';

  Root.AddSubnode(nil,TNode.Create(Root,CompareStr,'TComboBox'));

  Node := TNode.Create(Root,CompareStr,'Zusätzlich');
  Node.AddSubNode(Root,TNode.Create(Root,CompareStr,'TPanel'));
  Node.AddSubnode(Root,TNode.Create(Root,CompareStr,'TTree'));
  Node.AddSubnode(Root,TNode.Create(Root,CompareStr,'TListbox'));
  Result := Node;
end;


procedure TForm2.FormCreate(Sender: TObject);
var i: Integer; D: TNodeData; N: TNode;
begin
  N:=CreateNodes();

  Memo1.Lines.Add(N.Caption);              //Zusätzlich
  //Memo1.Lines.Add(N.Parent.Caption);     //Standard
  //Ausgabe muss später rekursiv erfolgen
  for i := 0 to N.Count-1 do
  begin
    Memo1.Lines.Add(N.Nodes[i].Caption);  //auch hier rekursiv,
                                          //N.Nodes enthält das zuletzt formulierte,
                                          //N.Parent.Nodes das vorherige
  end;

  Memo1.Lines.Add(N.Parent.Caption);
  for i := 0 to N.Parent.Count-1 do
  begin
    Memo1.Lines.Add(N.Parent.Nodes[i].Caption);
  end;

end;

initialization
   Root := TNode.Create(nil,CompareStr,'Standard');

finalization

end.

Funktioniert so erst mal, Danke an Euch alle!

Jetzt guck ich mir Fietes Quellcode noch mal genauer an.