TreeViewTools (rund um Node.Text und Node-Path)

[Satty67]

Unter D5 ist VirtualTreeView nicht verfügbar, weshalb ich mich mit TTreeView begnügen musste. Dabei sind ein paar kleine Funktionen entstanden, die beim Anlegen und Verwalten der Nodes helfen (speziell Node.Text). Eine besonders zeitkritische Funktion wurde hier im Forum in diesem Thread optimiert.

Die Procedure/Functionsnamen sind im Prinzip selbsterklären, hier ein kleine Zusammenfassung:

function GetNodePath(aNode:TTreeNode; WithTailingDelimiter: Boolean): String;
Ermittelt für einen Node den Pfad-String, der übergeordnete Node-Namen und den eigenen enthält.

procedure NodesToPathList(aTreeView: TTreeView; aStringList: TStrings; WithTailingDelimiter: Boolean; DataTyp : TNodesToPathListTyp = ntpl_DataAll);
Dehnt die obige Funktion auf den ganzen TreeView aus. aStringlist enhält danach die Pfade und zugehörige Nodes als Objekt. Kann als Speicherliste, Referenzliste oder Auswahlhilfe verwendet werden. Durch filtern von Data kann z.B. auch nur eine Ordnerliste oder Datenliste gebildet werden.

function FindNodebyPath(aTreeView: TTreeView; aPath: AnsiString): TTreeNode;
Findet einen Node, nur durch Angabe des Pfades (wie er durch eine der obigen Funktionen erstellt wurde). Details zum Code findet man im o.a. Link, die Kernfunktion wurde von himitsu geschrieben.

function NodeTextExistsInTwig(aTreeView: TTreeView; aParentNode: TTreeNode; aText : String): Boolean;
Prüft, ob ein Bezeichner in einem TreeView-Zweig bereits existiert (case insensitive)

function GetUniqueNodeText(aTreeView: TTreeView; aParentNode: TTreeNode; aNodeText : String; OnlyInTwig : Boolean = True): String;
Erweiterung der letzten Funktion, mit der man sich gleich einen eindeutigen Namen zurückgeben lassen kann. Dabei kann die Eindeutigkeit auf einen Zweig oder den ganzen TreeView eingestellt werden.

Delphi-Quellcode:

unit TreeViewTools;

interface

uses SysUtils, ComCtrls, Classes;

type
  TNodesToPathListTyp = (ntpl_DataNil, ntpl_DataAssigned, ntpl_DataAll);
  TArrayOfString = array of String;

{<--- Funktion, die aus einem Node (mit Parents) ein PathStr bildet --->}
function GetNodePath(aNode:TTreeNode; WithTailingDelimiter: Boolean): String;
{<--- Trägt kompletten Pfad der Parent-Nodes eines TreeView in eine StringList --->}
procedure NodesToPathList(aTreeView: TTreeView; aStringList: TStrings; WithTailingDelimiter: Boolean;
                         DataTyp : TNodesToPathListTyp = ntpl_DataAll);
{<--- Findet einen Node durch Angabe des Pfadnamen --->}
function FindNodebyPath(aTreeView: TTreeView; aPath: AnsiString): TTreeNode;
{<--- Prüft, ob in einem TreeZweig ein Node.Text bereits exitiert --->}
function NodeTextExistsInTwig(aTreeView: TTreeView; aParentNode: TTreeNode; aText : String): Boolean;
{<--- Gibt ein unique NodeText zurück, entweder für Zweig oder ganzen Baum --->}
function GetUniqueNodeText(aTreeView: TTreeView; aParentNode: TTreeNode;
                           aNodeText : String; OnlyInTwig : Boolean = True): String;

implementation

(***************************************************************************
  Funktion, die aus einem Node (mit Parents) ein PathStr bildet
  Achtung! aNode-Pointer wird innerhalb verändert
***************************************************************************)
// himitsu: umgeschrieben, weniger .Parent und übersichtlicher
function GetNodePath(aNode:TTreeNode; WithTailingDelimiter: Boolean): String;
begin
  Result := '';
  while Assigned(aNode) do begin
    Result := aNode.Text + '\' + Result;
    aNode := aNode.Parent;
  end;
  if not WithTailingDelimiter then Delete(Result, Length(Result), 1);
end; 
(*
function GetNodePath(aNode:TTreeNode; WithDelimiter: Boolean): String;
begin
  if Assigned(aNode) then begin
    if WithDelimiter then Result := aNode.Text +'\'
      else Result := aNode.Text;
    aNode := aNode.Parent;

    while assigned(aNode) do begin
      Result := aNode.text + '\' + Result;
      aNode := aNode.Parent;
    end;
  end else Result := '';  // himitsu : Zuweisung nur wenn nötig
end;
*)
(***************************************************************************
  Trägt kompletten Pfad der Parent-Nodes eines TreeView in eine StringList,
  die DataTyp erfüllen.
  Der Basis-Node selbst wird in Objects gespeichert
***************************************************************************)
procedure NodesToPathList(aTreeView: TTreeView; aStringList: TStrings; WithTailingDelimiter: Boolean;
                          DataTyp : TNodesToPathListTyp = ntpl_DataAll);
var
  i : Integer;
  guilty : Boolean;
begin
  with aTreeView do begin

    for i := 0 to Items.Count-1 do begin
      // Node ist gültig zum Eintrag in die Liste?
      case DataTyp of
        ntpl_DataNil : guilty := Items[i].Data = NIL;
        ntpl_DataAssigned : guilty := Items[i].Data <> NIL;
      else
        guilty := True; // ntpl_DataAll
      end;
      // Pfad zusammenbauen
      if guilty then
        aStringList.AddObject(GetNodePath(Items[i], WithTailingDelimiter),Items[i]);
    end;

  end;
end;

(***************************************************************************
  Findet einen Node durch Angabe des Pfadnamen
  Achtung! aPath-Wert wird innerhalb verändert

  Dank an himitsu @ Delphi-Praxis
***************************************************************************)
Function FindNodeByPath(aTreeView: TTreeView; aPath: String): TTreeNode;
Var
  Path: TArrayOfString;
  i, i2: Integer;
Begin
  Result := nil;
  if aPath='' then exit;

  //Path := Mixed.Explode('\', ExcludeTrailingBackslash(aPath));
  aPath := IncludeTrailingBackslash(aPath);
  while aPath <> '' do begin
    i2 := Pos('\', aPath);            // himitsu: lokale Variable
    i := Length(Path);                // statt mehrfacher Funktionsaufruf
    SetLength(Path, i+1);
    Path[i] := Copy(aPath, 1, i2-1); 
    Delete(aPath, 1, i2);            
  end;

  Result := aTreeView.Items.GetFirstNode;
  i      := 0;
  While Assigned(Result) do Begin
    //If CompareStr(Result.Text,Path[i])=0 Then Begin
    if Result.Text = Path[i] Then Begin
      If i < High(Path) Then Begin
        Inc(i);
        Result := Result.getFirstChild;
      End Else Exit;
    End Else Result := Result.getNextSibling;
  End;
End;

(***************************************************************************
  Prüft, ob in einem TreeZweig ein Node.Text bereits exitiert
  ist kein Zweig ausgewählt, prüft es die erste Ebene
***************************************************************************)
function NodeTextExistsInTwig(aTreeView: TTreeView; aParentNode: TTreeNode; aText : String): Boolean;
var
  aNode : TTreeNode;
begin
  Result := False;
  aText := AnsiUpperCase(aText); // himitsu: späterer Mehrfachaufruf verhindern
  aNode := NIL;

  // richtigen FirstNode ermitteln
  if Assigned(aParentNode) then aNode := aParentNode.GetFirstChild
    else if Assigned(aTreeView) then aNode := aTreeView.TopItem;

  // StartNode und SchwesterNodes prüfen
  while Assigned(aNode) do begin
    if AnsiUpperCase(aNode.Text) = aText then begin
      Result := True;
      Exit; // Break ginge auch, nächste aNode-Zuweisung würde verworfen
    end;
    aNode := aNode.getNextSibling;
  end;
end;

(***************************************************************************
  Prüft, ob ein NodeText schon existiert (entweder im Zweig oder ganzen Baum)
  und gibt einen UniqueNamen zurück, erweitert um [x]
  Die erste Ebene wird dabei wie ein Zweig (von Root) behandelt
***************************************************************************)
function GetUniqueNodeText(aTreeView: TTreeView; aParentNode: TTreeNode;
                           aNodeText : String; OnlyInTwig : Boolean = True): String;
var
  i : Integer;
  sl : TStringList;
begin
  Result := aNodeText;

  {<--- Prüft nur einen Zweig bzw. erste Ebene --->}
  if OnlyInTwig then begin

    i := 0;
    while NodeTextExistsInTwig(aTreeView, aParentNode, Result) do begin
      inc(i);
      Result := aNodeText+'['+IntToStr(i)+']';
    end;

  {<--- Prüft alle Nodes --->}
  end else begin

    sl := TStringList.Create;
    try
      // Namen sammeln, damit Items nicht x-mal durchlaufen werden muss
      // Aufwand relativiert sich bei großen Bäumen
      for i := 0 to aTreeView.Items.Count-1 do
        if Pos(AnsiUpperCase(aNodeText), AnsiUpperCase(aTreeView.Items[i].text)) > 0 then
          sl.Add(AnsiUpperCase(aTreeView.Items[i].text));

      // Prüfen und gg. erweitern
      i := 0;
      while sl.IndexOf(AnsiUpperCase(Result)) >= 0 do begin
        inc(i);
        Result := aNodeText+'['+IntToStr(i)+']';
      end;

    finally
      sl.Free;
    end;

  end;
end;

end.

Ich bin kein Profi, also ein kritischer Blick auf den Code schadet nicht

[himitsu]

hab erstmal nur kurz reingeblickt: (Änderungen mit <<< markiert)

Delphi-Quellcode:

function GetNodePath(aNode:TTreeNode; WithDelimiter: Boolean): String;
begin
  if Assigned(aNode) then begin
    if WithDelimiter then Result := aNode.Text +'\'
      else Result := aNode.Text;
    aNode := aNode.Parent;
    while assigned(aNode) do begin
      Result := aNode.text + '\' + Result;
      aNode := aNode.Parent;
    end;
  end else Result := '';  <<<<<
end;
// ist jetzt nichts Schlimmes, aber Result war sonst "sinnlos",
// da es in [i]if WithDelimiter then ...[/i] eh überschrieben wurde

Function FindNodeByPath(aTreeView: TTreeView; aPath: String): TTreeNode;
Var
  Path: TArrayOfString;
  i, i2: Integer;
Begin
  Result := nil;
  if aPath='' then exit;

  //Path := Mixed.Explode('\', ExcludeTrailingBackslash(aPath));
  aPath := IncludeTrailingBackslash(aPath);
  while aPath <> '' do begin
    i2 := Pos('\', aPath);            <<<<<
    i := Length(Path);
    SetLength(Path, i+1);
    Path[i] := Copy(aPath, 1, i2-1);  <<<<<
    Delete(aPath, 1, i2);             <<<<<
  end;

  Result := aTreeView.Items.GetFirstNode;
  i      := 0;
  While Assigned(Result) do Begin
    if Result.Text = Path[i] Then Begin
      If i < High(Path) Then Begin
        Inc(i);
        Result := Result.getFirstChild;
      End Else Exit;
    End Else Result := Result.getNextSibling;
  End;
End;

function NodeTextExistsInTwig(aTreeView: TTreeView; aParentNode: TTreeNode; aText : String): Boolean;
var
  aNode : TTreeNode;
begin
  Result := False;
  aText := AnsiUpperCase(aText);  <<<<<<<<<
  aNode := NIL;

  // richtigen FirstNode ermitteln
  if Assigned(aParentNode) then aNode := aParentNode.GetFirstChild
    else if Assigned(aTreeView) then aNode := aTreeView.TopItem;

  // StartNode und SchwesterNodes prüfen
  while Assigned(aNode) do begin
    if AnsiUpperCase(aNode.Text) = aText then begin  <<<<<<<<<<
      Result := True;
      Exit; // Break ginge auch, nächste aNode-Zuweisung würde verworfen
    end;
    aNode := aNode.getNextSibling;
  end;
end;

[Satty67]

Hallo himitsu,

zu 1)... das kommt wohl, weil ich immer erst Result "initialisiere", sonst vergesse ich das. Passe ich an.

zu 2) Lokale Variable statt 3x der gleich Funktionsaufruf, übernehme ich natürlich (glaube die Art von Optimierung könnte man bei allen meinen Quelltexten machen)

zu 3) Zuweisung vorab, Mehrfachaufruf verhindert

[RWarnecke]

Deine Funktion GetNodePath kann man auch so schreiben :

Delphi-Quellcode:

function TreeNodePath(node: TTreeNode; delimiter: Char = PathDelim): string;
begin
  if Assigned(node) then
    Result := TreeNodePath(node.Parent, delimiter) + delimiter + node.Text
  else
    Result := '';
end;

[Satty67]

Rekursiv, sieht schlank aus, auch wenn ich jetzt eine Weile schauen musste, bis ich es gemerkt hab'.

Wie implementiere ich die Aufgabe, manche Node mit und mache ohne abschließenden '\' zu liefern? Außerhalb lösen?

[himitsu]

Schlanker mag es aussehn, aber dafür sind dort mehrere Prozeduraufrufe und Rückprünge drin und es wird ein klein bissl mehr Speicher benötigt.

Delphi-Quellcode:

function GetNodePath(aNode:TTreeNode; WithTailingDelimiter: Boolean): String;
begin
  Result := '';
  while Assigned(aNode) do begin
    Result := aNode.Text + '\' + Result;
    aNode := aNode.Parent;
  end;
  if not WithDelimiter then Delete(Result, Length(Result), 1);
end; 


// falls aNode nie NIL ist, dann auch so möglich

function GetNodePath(aNode:TTreeNode; WithTailingDelimiter: Boolean): String;
begin
  if WithDelimiter then Result := aNode.Text + '\' else Result := aNode.Text;
  aNode := aNode.Parent;
  while assigned(aNode) do begin
    Result := aNode.Text + '\' + Result;
    aNode := aNode.Parent;
  end;
end;

ach ja, .Parent ruft .GetParent auf, was wiederum intern einiges macht ... drum hab ich das in der Schleife nur noch einmal drin.

Zitat von Satty67:

Wie implementiere ich die Aufgabe, manche Node mit und mache ohne abschließenden '\' zu liefern? Außerhalb lösen?

Delphi-Quellcode:

function GetNodePath(Node: TTreeNode; WithTailingDelimiter: Boolean): String;
begin
  if Assigned(Node) then begin
    if WithTailingDelimiter then
      Result := GetNodePath(Node.Parent, True) + Node.Text + '\'
    else Result := GetNodePath(Node.Parent, True) + Node.Text;
  end else Result := '';
end;

// oder

function GetNodePath(Node: TTreeNode; WithTailingDelimiter: Boolean): String;
begin
  if Assigned(Node) then begin
    Result := GetNodePath(Node.Parent, True) + Node.Text;
    if WithTailingDelimiter then Result := Result + '\';
  end else Result := '';
end;

[himitsu]

Zitat von himitsu:

Schlanker mag es aussehn, aber dafür sind dort mehrere Prozeduraufrufe und Rückprünge drin und es wird ein klein bissl mehr Speicher benötigt.

Delphi-Quellcode:

function GetNodePath(aNode:TTreeNode; WithTailingDelimiter: Boolean): String;
begin
  Result := '';
  while Assigned(aNode) do begin
    Result := aNode.Text + '\' + Result;
    aNode := aNode.Parent;
  end;
  if not WithDelimiter then Delete(Result, Length(Result), 1);
end; 


// falls aNode nie NIL ist, dann auch so möglich

function GetNodePath(aNode:TTreeNode; WithTailingDelimiter: Boolean): String;
begin
  if WithDelimiter then Result := aNode.Text + '\' else Result := aNode.Text;
  aNode := aNode.Parent;
  while assigned(aNode) do begin
    Result := aNode.Text + '\' + Result;
    aNode := aNode.Parent;
  end;
end;

ach ja, .Parent ruft .GetParent auf, was wiederum intern einiges macht ... drum hab ich das in der Schleife nur noch einmal drin.

Zitat von Satty67:

Wie implementiere ich die Aufgabe, manche Node mit und mache ohne abschließenden '\' zu liefern? Außerhalb lösen?

Delphi-Quellcode:

function GetNodePath(Node: TTreeNode; WithTailingDelimiter: Boolean): String;
begin
  if Assigned(Node) then begin
    if WithTailingDelimiter then
      Result := GetNodePath(Node.Parent, True) + Node.Text + '\'
    else Result := GetNodePath(Node.Parent, True) + Node.Text;
  end else Result := '';
end;

// oder

function GetNodePath(Node: TTreeNode; WithTailingDelimiter: Boolean): String;
begin
  if Assigned(Node) then begin
    Result := GetNodePath(Node.Parent, True) + Node.Text;
    if WithTailingDelimiter then Result := Result + '\';
  end else Result := '';
end;

[add]
noch länger, aber dafür wohl noch schneller ...

Delphi-Quellcode:

Function GetNodePath(Node: TTreeNode; WithTailingDelimiter: Boolean): String;
  Var L:  Integer;
    Temp: TTreeNode;
    P:    PChar;

  Begin
    If Assigned(Node) Then Begin
      L    := 0;
      Temp := Node;
      While Assigned(Temp) do Begin
        Inc(L, Length(Temp.Text) + 1);
        Temp := Temp.Parent;
      End;
      If not WithTailingDelimiter Then Dec(L);
      SetLength(Result, L * SizeOf(Char));
      P := PChar(Result);
      While Assigned(Node) do Begin
        MoveMemory(P, PChar(Temp.Text), Length(Temp.Text) * SizeOf(Char));
        Inc(P, Length(Temp.Text));
        Node := Node.Parent;
        If Assigned(Node) or WithTailingDelimiter Then Begin
          P^ := '\';
          Inc(P);
        End;
      End;
    End Else Result := False;
  End;

ungetestet, aber sollte so stimmen

[Satty67]

Also die Variante:

Delphi-Quellcode:

function GetNodePath(aNode:TTreeNode; WithTailingDelimiter: Boolean): String;
begin
  Result := '';
  while Assigned(aNode) do begin
    Result := aNode.Text + '\' + Result;
    aNode := aNode.Parent;
  end;
  if not WithTailingDelimiter then Delete(Result, Length(Result), 1);
end;

gefällt mir am Besten (rein vom Verständnis).

"WithDelimiter" ändere ich auch in with "WithTailingDelimiter", weil es ja wirklich nur um den abschließenden '\' geht.

Noch bin ich guter Hoffnung, das da noch etwas Code aus meiner Schreibe übrig bleibt

[Satty67]

uses TDBmain; im implementation-Teil entfernt (war das Testprogramm)