RTTI : Endlosschleifen beim rekursiven Auslesen eines Objects

[moelski]

Moin !

Ich bin gerade dabei einen kleinen RTTI Browser zu erstellen um die eingerichteten Objekte in unserer Software darzustellen. Dazu baue ich mir einen Tree mit den Objekten auf und wenn man eins anklickt, dann werden die Values des Objekts angezeigt.

Soweit sogut ... Probleme machen mir aber "Querverweise" in den Objekten. Aber der Reihe nach

Zunächst mal gibt es eine Procedure um die Values eines Objekts anzuzeigen (funzt auch super) :

Delphi-Quellcode:

procedure TForm_RTTI_Browser.InspectObject( AObject : TObject);
var context   : TRttiContext;
    TypInfo   : TRttiType;
    field     : TRttiField;
    methode   : TRttiMethod;
    value     : TValue;
begin
  Memo.Clear;

  context := TRttiContext.Create;
  TypInfo := context.GetType(AObject.ClassType);

  Memo.Lines.Add(TypInfo.ToString + '  UNIT : ' + AObject.UnitName);
  Memo.Lines.Add('> FIELDS ');
  for field in TypInfo.GetFields do begin
    value := field.GetValue(AObject);
    Memo.Lines.Add(Format('%20s', [field.Name]) + ' = ' +
                   Format('%35s', [value.ToString]) + '  [Class: ' + value.TypeInfo.Name + ']');
  end;

  context.Free;
end;

Dann gibt es aber die Funktion zum Auflisten der Objekte und deren Listen-Unterobjekte. Und da habe ich ein kleines Problem mit ...

Delphi-Quellcode:

procedure TForm_RTTI_Browser.ListObjects  (AObject : TObject ; ParentNode : TTreeNode);
var context   : TRttiContext;
    TypInfo   : TRttiType;
    field     : TRttiField;
    value     : TValue;
    Node, SubNode : TTreeNode;

  procedure ListInsideItems(BObject : TObject ; ParentNode : TTreeNode);
  var i : Integer;
  begin
    if BObject.InheritsFrom(TList) then
      for I := 0 to TList(BObject).Count - 1 do begin
        ListObjects(TList(BObject)[I], ParentNode);
      end;
  end;
begin
  context := TRttiContext.Create;
  TypInfo := context.GetType(AObject.ClassType);

  Node := TreeView1.Items.AddChild(ParentNode, TypInfo.ToString);
  SiMain.LogVerbose('TypInfo.ToString' + TypInfo.ToString);
  Node.Data := AObject;
  for field in TypInfo.GetFields do begin
    value := field.GetValue(AObject);

    // Rekursion für TObjectList
    if value.IsInstanceOf(TList) then begin
      SubNode := TreeView1.Items.AddChild(Node, value.ToString); // > TObjectList
      SiMain.LogVerbose('SubNode' + value.ToString);
      SubNode.Data := value.AsObject;

      ListInsideItems(value.AsObject, SubNode);

      SubNode.Expand(True);
    end;
  end;

  Node.Expand(True);
  context.Free;
end;

Das ganze soll rekursiv stattfinden und genau da liegt auch ein Problem.
Bsp:
Wenn ich eine TChart Instanz aufdröseln lasse, dann komme ich irgendwann zu den TAxisItems.
TAxisItems beinhaltet eine Liste mit TAxisItem.
Die werden auch aufgelistet und wir gehen durch die Felder von TAxisItem. Dort gibt es wieder eine Referenz auf die eigentliche Liste TAxisItems.
Und schon hat man eine "runde" Sache und es läuft endlos ...

Frage ist nun, was kann ich machen um solche Rekursionsendlosschleifen zu verhindern?

Das Problem mit TAxisItems ist dabei noch eher einfach. Schlimmer wird es aber wenn man bei jedem Verweis auf das zugrundeliegende Chart immer wieder das Chart neu aufdröseln würde. Also als Beispiel sowas:

Code:

Chart
--> Kurve
----> Achse
      > Field mit Verweis auf Chart

[stahli]

Einfachste Lösung m.E:
"HabschSchonList" anlegen und alle angezeigten Controls dort ablegen.
Bereits enthaltene Controls (Pointer) nicht nochmal anzeigen.

[himitsu]

Du müßtest halt nachsehn, ob etwas schon vorhanden ist, bevor es eingefügt/ausgelesen werden soll.

> entweder irgendwo in einer Liste merken, was aktuell schon angezeigt wurde
> oder jeweils im TreeView danach suchen

Wenn es gefunden wurde, dann nur den Namen anzeigen und dazuschreiben, daß es sich hier um eine zirkuläre Referenz handelt und eventuell könnte man auch noch den Eintrag als Link darstellen und beim Anklicken auf den vorhandenen Eintrag umleiten.

[SirThornberry]

Eine Ordentliche Lösung gibt es nicht. Du könntest, bevor du ein Objekt durchläufst, schauen ob dieses bereits in der Baumstruktur vorhanden ist. Allerdings solltest du das durchlaufen nur abbrechen wenn das Objekt in einer tieferen Verschachtelung gefunden wurde.

[moelski]

Männers, ich bedanke euch

Und falls mal jemand etwas ähnliches vor hat. So könnte man es machen

Delphi-Quellcode:

unit RTTI_Browser;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls,

  Rtti, TypInfo, Contnrs,

  Chart, Series, TeEngine, TeeProcs, SiAuto;

type
  TForm_RTTI_Browser = class(TForm)
    Panel1: TPanel;
    Splitter1: TSplitter;
    TreeView1: TTreeView;
    Memo: TMemo;
    procedure TreeView1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
    procedure InspectObject(AObject : TObject );
    procedure ListObjects  (AObject : TObject ; ParentNode : TTreeNode);

    Function  ObjectInList(AObject : TObject) : Boolean;
  end;

var
  Form_RTTI_Browser : TForm_RTTI_Browser;
  ObjectsDone       : TObjectList;

implementation

{$R *.dfm}

procedure TForm_RTTI_Browser.FormCreate(Sender: TObject);
begin
  ObjectsDone := TObjectList.Create;
  ObjectsDone.OwnsObjects := False;
end;

procedure TForm_RTTI_Browser.FormDestroy(Sender: TObject);
begin
  ObjectsDone.Free;
end;

Function TForm_RTTI_Browser.ObjectInList(AObject : TObject) : Boolean;
var I: Integer;
begin
  Result := False;
  for I := 0 to ObjectsDone.Count - 1 do
    if ObjectsDone[I] = AObject then begin
      Result := True;
      Exit;
    end;
end;

procedure TForm_RTTI_Browser.ListObjects  (AObject : TObject ; ParentNode : TTreeNode);
var context   : TRttiContext;
    TypInfo   : TRttiType;
    field     : TRttiField;
    value     : TValue;
    Node, SubNode : TTreeNode;

  procedure ListInsideItems(BObject : TObject ; ParentNode : TTreeNode);
  var i : Integer;
  begin
    if BObject.InheritsFrom(TList) then
      for I := 0 to TList(BObject).Count - 1 do begin
        ListObjects(TList(BObject)[I], ParentNode);
      end;
  end;
begin
  if ObjectInList(AObject) then
    Exit;
  ObjectsDone.Add(AObject);

  context := TRttiContext.Create;
  TypInfo := context.GetType(AObject.ClassType);

  Node := TreeView1.Items.AddChild(ParentNode, TypInfo.ToString);
//  SiMain.LogVerbose('TypInfo : ' + TypInfo.ToString);
  Node.Data := AObject;

//  for field in TypInfo.GetDeclaredFields do begin
  for field in TypInfo.GetFields do begin
    value := field.GetValue(AObject);
//    SiMain.LogVerbose(field.ToString + ' ' + Value.ToString);
    // Rekursion für TObjectList
    if value.IsInstanceOf(TList) then begin
//      Simain.LogSeparator;
      SubNode := TreeView1.Items.AddChild(Node, value.ToString); // > TObjectList
//      SiMain.LogVerbose('SubNode ' + value.ToString);
      SubNode.Data := value.AsObject;

      ListInsideItems(value.AsObject, SubNode);

      SubNode.Expand(True);
    end;
  end;

  Node.Expand(True);
  context.Free;
end;

procedure TForm_RTTI_Browser.TreeView1Click(Sender: TObject);
var node : TTreeNode;
begin
  Node := TreeView1.Selected;
  if Node = NIL then Exit;
  if Node.Data = NIL then Exit;

  InspectObject(node.Data);
end;

procedure TForm_RTTI_Browser.InspectObject( AObject : TObject);
var context   : TRttiContext;
    TypInfo   : TRttiType;
    field     : TRttiField;
    methode   : TRttiMethod;
//    prop      : TRttiProperty;
    value     : TValue;
//    I, j      : Integer;
begin
  Memo.Clear;

  context := TRttiContext.Create;
  TypInfo := context.GetType(AObject.ClassType);

  Memo.Lines.Add(TypInfo.ToString + '  UNIT : ' + AObject.UnitName);
  Memo.Lines.Add('> FIELDS ');
//  for field in TypInfo.GetDeclaredFields do begin
  for field in TypInfo.GetFields do begin
    value := field.GetValue(AObject);
    Memo.Lines.Add(Format('%20s', [field.Name]) + ' = ' +
                   Format('%35s', [value.ToString]) + '  [Class: ' + value.TypeInfo.Name + ']');
  end;

//  if CheckBox1.Checked then begin
//    Memo.Lines.Add(#13#10 +'> METHODS ');
//  //  for methode in TypInfo.GetDeclaredMethods do begin
//    for methode in TypInfo.GetMethods do begin
//      memo.Lines.Add( methode.Name + ': ' + methode.ToString )
//    end;
//  end;

  context.Free;
end;

end.

[SirThornberry]

Das ganze funktioniert aber nur bedingt so das es ein gutes Ergebnis liefert. Du hast folgendes nicht beachtet:

Zitat:

Allerdings solltest du das durchlaufen nur abbrechen wenn das Objekt in einer tieferen Verschachtelung gefunden wurde.

Angenommen du inspizierst ein Formular auf dem ein TreeView liegt und eine Imageliste (die dem Treeview zugwiesen wurde)

Code:

- TreeView
  - Imagelist1
    - property1 from ImageList
    - property2 from Imagelist
- Imagelist1

Dann würdest du wie es oben aufgelistet ist die Imagelist innerhalb des Treeviews expandieren aber die Imagelist auf dem Formular nicht mehr?
In dem Fall solltest du lieber die Expandierung innerhalb des Treeviews aufheben und dafür in der Imagelist selbst die Eigenschaften anzeigen.

[moelski]

Moin !

Jap da hast du vollkommen Recht.
In meinem Fall ist es aber nicht ganz so schlimm. Denn ich möchte vorrangig meine erzeugten Klassenkonstrukte damit zur Schau bringen. Das kann beim Debuggen manchmal hilfreich sein

Das was du ansprichst passiert erst recht spät bei mir - z.B. bei einem zugewiesenen TChart.
Aber in der Tiefe ist es nicht so tragisch wenn da etwas "verschoben" ist.

Ich habe jetzt auch noch einen Filter eingebaut um bestimmte Klassen nur in der Tiefe aufzulisten.
Damit kommt dein beschriebenes Problem (bei mir) kaum noch zum tragen.