(*****************************************************)
(* Name: TreeViewRoutines                            *)
(* Last Revision: 09 Dec. 2001                       *)
(* Version: 1.3                                      *)
(*                                                   *)
(* Copyright © 2001 by Christian Aaangel             *)
(*****************************************************)

unit TreeViewRoutines;

interface

Uses
 Classes,
 Comctrls,
 SysUtils;

Const
 Sep = ';';

Function GetTreePath(Node: TTreeNode): String;
// Supplies a treepath like a directory path eg.
// Settings\System\Colors\Foregound Color
Function GetNode(aTreeview: TTreeView; aPath: String): TTreeNode;
Function GetNodeIndex(aTreeview: TTreeView; aPath: String): Integer;
// Provides the node to the path, if any
Function CreateNodes(aTreeview: TTreeView; AtNode: TTreeNode; Path: String): Integer;
// Creates the path in the treeview - With all subnodes
Function AddNodes(aTreeview: TTreeView; aPath: string; Var Index: Integer): Boolean;

Function StepBack(CurrentNode: TTreenode; Levels: Integer): TTreenode;
// Provides the parent x levels before currentnode
Procedure CompleteList(var List: TStrings); overload;
Procedure CompleteList(var List: TStringList); overload;
// Finishes a list to include all leading steps for the createtreefromlist routines to work
Procedure ListCleanUp(Var List: TStrings); overload;
Procedure ListCleanUp(Var List: TStringList); overload;
Procedure CreateTreeFromList(aTreeview: TTreeview; List: TStrings; Separator: Char = Sep); overload;
Procedure CreateTreeFromList(aTreeview: TTreeview; List: TStringList; Separator: Char = Sep); overload;

implementation

Function PathToOk(APath: String): String;
Begin
 If APath = '' Then begin
  Result := APath;
  Exit;
 End;
 If APath[length(APath)] <> '\' Then APath := APath + '\';
 Result := APath;
End;

Function CountFilt(From: String; Seperator: Char = Sep): Integer;
var
 Res, IC: Integer;
Begin
 Res := 0;
 If Length(From) > 0 Then begin
  Res := 1;
  For IC := 1 to length(From) do begin
   If From[IC] = Seperator Then Inc(Res);
  End;
 End;
 Result := Res;
End;

Function GetFilt(From: String; Number: Integer; Seperator: Char = Sep): String;
Var
 LastRecorded, CStart, CSlut, ATF, IC: Integer;
 Res: String;
Begin
 Res := '';
 If Number > CountFilt(From, Seperator) Then Begin
  Result := Res;
  Exit;
 End;
 If Length(From) > 0 Then begin
  If (From[1] = Seperator) And (Number = 1) Then Begin
   Result := Res;
   Exit;
  End;
  CStart := 0;
  CSlut := 0;
  ATF := 1;
  LastRecorded := 0;
  If Number = 1 Then CStart := 1;
  For IC := 1 to length(From) do begin
   LastRecorded := IC;
   If From[IC] = Seperator Then begin
    Inc(ATF);
    If ATF = Number Then CStart := IC + 1;
    If ATF = Number + 1 Then CSlut := IC - 1;
   End;
  End;
  If (CStart <> 0) And (CSlut = 0) Then CSlut := LastRecorded;
  Res := Copy(From, CStart, CSlut - CStart + 1);
 End;
 Result := Res;
End;

Function StepBack(CurrentNode: TTreenode; Levels: Integer): TTreenode;
Var
 Res: TTreenode;
 I: Integer;
Begin
 Res := CurrentNode;
 For I := 1 to Levels do begin
  Res := Res.Parent;
 End;
 Result := Res;
End;

Function GetTreePath(Node: TTreeNode): String;
Var
 I: Integer;
 Res: String;
 TempNode: TTreeNode;
Begin
 If Node = nil Then Exit;
 TempNode := Node;
 Res := TempNode.Text;
 For I := Node.Level downto 1 do begin
  TempNode := TempNode.Parent;
  Res := TempNode.Text + '\' + Res;
 End;
 Result := Res;
End;

Function GetNode(aTreeview: TTreeView; aPath: String): TTreeNode;
Var
 I: Integer;
Begin
 Result := nil;
 For I := 0 to aTreeview.Items.Count - 1 do begin
  If Uppercase(GetTreePath(aTreeView.Items[I])) = Uppercase(aPath) Then Begin
   Result := aTreeView.Items[I];
   Exit;
  End;
 End;
End;

Function GetNodeIndex(aTreeview: TTreeView; aPath: String): Integer;
Var
 I: Integer;
Begin
 Result := -1;
 For I := 0 to aTreeview.Items.Count - 1 do begin
  If Uppercase(GetTreePath(aTreeView.Items[I])) = Uppercase(aPath) Then Begin
   Result := I;
   Exit;
  End;
 End;
End;

function CreateNodes(aTreeview: TTreeView; AtNode: TTreeNode; Path: String): Integer;
Var
 Node: TTreeNode;
 I: Integer;
Begin
 Result := -1;
 Node := AtNode;
  For I := 1 to countfilt(Path, '\') do begin
   Node := aTreeview.Items.AddChild(Node, GetFilt(Path, I, '\'));
   Result := Node.AbsoluteIndex;
  End;
End;

Function AddNodes(aTreeview: TTreeView; aPath: string; Var Index: Integer): Boolean;
Var
 I2, I: Integer;
 Add: String;
 SearchFor: String;
 Ok: Boolean;
 AddAt, LastAddAt: Integer;
begin
 Result := False;
 Add := '';
 SearchFor := '';
 I := 1;
 Ok := False;
 LastAddAt := -1;
 Repeat
  Add := PathToOk(Add) + GetFilt(aPath, I, '\');
  AddAt := GetNodeIndex(aTreeview, Add);
  If AddAt = -1 Then Begin
   Ok := True;
   For I2 := I to CountFilt(aPath, '\') do
    searchfor := PathToOk(SearchFor) + GetFilt(aPath, I2, '\');
  end;
  Inc(I);
  If Not Ok Then LastAddAt := AddAt;
 Until (I-1 = countFilt(aPath, '\')) or (Ok);
 If Ok Then Begin
  If LastAddAt = -1 Then
  Index := CreateNodes(aTreeview, Nil, SearchFor)
   Else
  Index := CreateNodes(aTreeview, aTreeview.Items[LastAddAt], SearchFor);
  Result := True;
 End;
end;

Procedure CompleteList(var List: TStrings);
Var
 I, II: Integer;
 CurLevel, PreLevel: Integer;
 CurS, PreS: String;
 S: String;
 S1, S2: String;
 bjStart: Integer;
 BlockJumping: boolean;
Const
 // PC = Possible Cause
 pcBlockJumping = 0; // Maintains same level but changes content
 pcLeadingBlockMissing = 1; // The preleminary step to this level is missing

Begin
 CurS := '';
 PreS := '';
// Listbox1.Items.Insert(0, 'Backstreet Boys');
 If List.Count = 0 Then Exit;
 S1 := List[0];
 If CountFilt(S1, '\') > 1 Then Begin
  List.Insert(0, GetFilt(S1, 1, '\'));
 End;
 I := 1;
 Repeat
  CurS := List[I];
  PreS := List[I-1];
  CurLevel := CountFilt(CurS, '\');
  PreLevel := CountFilt(PreS, '\');
  If CurLevel > PreLevel + 1 Then Begin
   BlockJumping := False;
   bjStart := -1;
   For II := 1 to CurLevel do begin
    S1 := GetFilt(CurS, II, '\');
    S2 := GetFilt(PreS, II, '\');
    If (S1 <> S2) and (Not BlockJumping) Then Begin
     BlockJumping := True;
     bjStart := II;
    End;
   End;
   If BlockJumping Then Begin
    // psBlockJumping
    If bjStart = 1 Then Begin
     // Insert Leading Item
     List.Insert(I, GetFilt(CurS, 1, '\'));
     Inc(I);
     bjStart := 2;
     S := GetFilt(CurS, 1, '\');
    End
     else
    Begin
     S := '';
     For II := 1 to bjStart-1 do begin
      S := PathToOk(S) + GetFilt(CurS, II, '\');
     End;
    End;
    For II := bjStart to CurLevel - 1 do begin
     S := PathToOk(S) + GetFilt(CurS, II, '\');
     List.Insert(I, S);
     Inc(I);
    End;
   End
    else
   Begin
    S1 := GetFilt(CurS, PreLevel, '\');
    S2 := GetFilt(PreS, PreLevel, '\');
    If S1 = S2 Then Begin
     // pcLeadingBlockMissing
     S := PreS;
     For II := PreLevel + 1 to CurLevel - 1 do begin
      S := PathToOk(S) + GetFilt(CurS, II, '\');
      List.Insert(I, S);
     End;
    End
   End;
  End;
  If CurLevel = PreLevel Then Begin
   BlockJumping := False;
   bjStart := -1;
   For II := 1 to CurLevel do begin
    S1 := GetFilt(CurS, II, '\');
    S2 := GetFilt(PreS, II, '\');
    If (S1 <> S2) and (Not BlockJumping) Then Begin
     BlockJumping := True;
     bjStart := II;
    End;
   End;
   If BlockJumping Then Begin
    // psBlockJumping
    If bjStart = 1 Then Begin
     // Insert Leading Item
     List.Insert(I, GetFilt(CurS, 1, '\'));
     Inc(I);
     bjStart := 2;
     S := GetFilt(CurS, 1, '\');
    End
     else
    Begin
     S := '';
     For II := 1 to bjStart-1 do begin
      S := PathToOk(S) + GetFilt(CurS, II, '\');
     End;
    End;
    For II := bjStart to CurLevel - 1 do begin
     S := PathToOk(S) + GetFilt(CurS, II, '\');
     List.Insert(I, S);
    End;
   End;
  End;
  If PreLevel > CurLevel Then begin
   BlockJumping := False;
   bjStart := -1;
   For II := 1 to CurLevel do begin
    S1 := GetFilt(CurS, II, '\');
    S2 := GetFilt(PreS, II, '\');
    If (S1 <> S2) and (Not BlockJumping) Then Begin
     BlockJumping := True;
     bjStart := II;
    End;
   End;
   If BlockJumping Then Begin
    // psBlockJumping
    If bjStart = 1 Then Begin
     // Insert Leading Item
     List.Insert(I, GetFilt(CurS, 1, '\'));
     Inc(I);
     bjStart := 2;
     S := GetFilt(CurS, 1, '\');
    End
     else
    Begin
     S := '';
     For II := 1 to bjStart-1 do begin
      S := PathToOk(S) + GetFilt(CurS, II, '\');
     End;
    End;
    For II := bjStart to CurLevel - 1 do begin
     S := PathToOk(S) + GetFilt(CurS, II, '\');
     List.Insert(I, S);
    End;
   End;
  End;
  Inc(I);
 Until I = List.Count;
End;

Procedure CompleteList(var List: TStringList);
Var
 I, II: Integer;
 CurLevel, PreLevel: Integer;
 CurS, PreS: String;
 S: String;
 S1, S2: String;
 bjStart: Integer;
 BlockJumping: boolean;
Const
 // PC = Possible Cause
 pcBlockJumping = 0; // Maintains same level but changes content
 pcLeadingBlockMissing = 1; // The preleminary step to this level is missing

Begin
 CurS := '';
 PreS := '';
// Listbox1.Items.Insert(0, 'Backstreet Boys');
 If List.Count = 0 Then Exit;
 S1 := List[0];
 If CountFilt(S1, '\') > 1 Then Begin
  List.Insert(0, GetFilt(S1, 1, '\'));
 End;
 I := 1;
 Repeat
  CurS := List[I];
  PreS := List[I-1];
  CurLevel := CountFilt(CurS, '\');
  PreLevel := CountFilt(PreS, '\');
  If CurLevel > PreLevel + 1 Then Begin
   BlockJumping := False;
   bjStart := -1;
   For II := 1 to CurLevel do begin
    S1 := GetFilt(CurS, II, '\');
    S2 := GetFilt(PreS, II, '\');
    If (S1 <> S2) and (Not BlockJumping) Then Begin
     BlockJumping := True;
     bjStart := II;
    End;
   End;
   If BlockJumping Then Begin
    // psBlockJumping
    If bjStart = 1 Then Begin
     // Insert Leading Item
     List.Insert(I, GetFilt(CurS, 1, '\'));
     Inc(I);
     bjStart := 2;
     S := GetFilt(CurS, 1, '\');
    End
     else
    Begin
     S := '';
     For II := 1 to bjStart-1 do begin
      S := PathToOk(S) + GetFilt(CurS, II, '\');
     End;
    End;
    For II := bjStart to CurLevel - 1 do begin
     S := PathToOk(S) + GetFilt(CurS, II, '\');
     List.Insert(I, S);
     Inc(I);
    End;
   End
    else
   Begin
    S1 := GetFilt(CurS, PreLevel, '\');
    S2 := GetFilt(PreS, PreLevel, '\');
    If S1 = S2 Then Begin
     // pcLeadingBlockMissing
     S := PreS;
     For II := PreLevel + 1 to CurLevel - 1 do begin
      S := PathToOk(S) + GetFilt(CurS, II, '\');
      List.Insert(I, S);
     End;
    End
   End;
  End;
  If CurLevel = PreLevel Then Begin
   BlockJumping := False;
   bjStart := -1;
   For II := 1 to CurLevel do begin
    S1 := GetFilt(CurS, II, '\');
    S2 := GetFilt(PreS, II, '\');
    If (S1 <> S2) and (Not BlockJumping) Then Begin
     BlockJumping := True;
     bjStart := II;
    End;
   End;
   If BlockJumping Then Begin
    // psBlockJumping
    If bjStart = 1 Then Begin
     // Insert Leading Item
     List.Insert(I, GetFilt(CurS, 1, '\'));
     Inc(I);
     bjStart := 2;
     S := GetFilt(CurS, 1, '\');
    End
     else
    Begin
     S := '';
     For II := 1 to bjStart-1 do begin
      S := PathToOk(S) + GetFilt(CurS, II, '\');
     End;
    End;
    For II := bjStart to CurLevel - 1 do begin
     S := PathToOk(S) + GetFilt(CurS, II, '\');
     List.Insert(I, S);
    End;
   End;
  End;
  If PreLevel > CurLevel Then begin
   BlockJumping := False;
   bjStart := -1;
   For II := 1 to CurLevel do begin
    S1 := GetFilt(CurS, II, '\');
    S2 := GetFilt(PreS, II, '\');
    If (S1 <> S2) and (Not BlockJumping) Then Begin
     BlockJumping := True;
     bjStart := II;
    End;
   End;
   If BlockJumping Then Begin
    // psBlockJumping
    If bjStart = 1 Then Begin
     // Insert Leading Item
     List.Insert(I, GetFilt(CurS, 1, '\'));
     Inc(I);
     bjStart := 2;
     S := GetFilt(CurS, 1, '\');
    End
     else
    Begin
     S := '';
     For II := 1 to bjStart-1 do begin
      S := PathToOk(S) + GetFilt(CurS, II, '\');
     End;
    End;
    For II := bjStart to CurLevel - 1 do begin
     S := PathToOk(S) + GetFilt(CurS, II, '\');
     List.Insert(I, S);
    End;
   End;
  End;
  Inc(I);
 Until I = List.Count;
End;

Function RemoveCharZero(Str: String): String;
Var
 I: Integer;
 Res: String;
Begin
 Res := '';
 For I := 1 to length(Str) do
  If Str[I] <> #0 Then Res := Res + Str[I];
 Result := Res;
End;

Procedure ListCleanUp(Var List: TStrings);
Var
 I: Integer;
 S1, S2: String;
Begin
 I := 0;
 Repeat
  S1 := RemoveCharZero(List[I]);
  S2 := RemoveCharZero(list[I+1]);
  If Uppercase(S1) = Uppercase(S2) Then List.Delete(I+1)
   else Inc(I);
 Until I = List.Count-1;
End;

Procedure ListCleanUp(Var List: TStringList);
Var
 I: Integer;
 S1, S2: String;
Begin
 I := 0;
 Repeat
  S1 := RemoveCharZero(List[I]);
  S2 := RemoveCharZero(list[I+1]);
  If Uppercase(S1) = Uppercase(S2) Then List.Delete(I+1)
   else Inc(I);
 Until I = List.Count-1;
End;

Procedure CreateTreeFromList(aTreeview: TTreeview; List: TStrings; Separator: Char = Sep);
Var
 I: Integer;
 aNode: TTreeNode;
 PreLevel, CurLevel: Integer;
 S: String;
begin
 aTreeview.Items.Clear;
 aNode := aTreeview.Items.AddFirst(Nil, GetFilt(List[0], 1, Separator));
 PreLevel := CountFilt(List[0], Separator);
 For I := 1 to List.Count-1 do begin
  S := List[I];
  CurLevel := CountFilt(S, Separator);
  If CurLevel > PreLevel Then Begin
   aNode := aTreeview.Items.AddChild(aNode, GetFilt(S, CountFilt(S, Separator), Separator));
  End;
  If CurLevel = PreLevel Then Begin
   aNode := aTreeview.Items.Add(aNode, GetFilt(S, CountFilt(S, Separator), Separator));
  End;
  If CurLevel < PreLevel Then Begin
   aNode := aTreeview.Items.Add(StepBack(aNode, PreLevel - CurLevel), GetFilt(S, CountFilt(S, Separator), Separator));
  End;
  aNode.ImageIndex := aNode.Level;
  aNode.SelectedIndex := aNode.Level;
  aNode.StateIndex := aNode.Level;
  PreLevel := CurLevel;
 End;
end;

Procedure CreateTreeFromList(aTreeview: TTreeview; List: TStringList; Separator: Char = Sep);
Var
 I: Integer;
 aNode: TTreeNode;
 PreLevel, CurLevel: Integer;
 S: String;
begin
 aTreeview.Items.Clear;
 aNode := aTreeview.Items.AddFirst(Nil, GetFilt(List[0], 1, Separator));
 PreLevel := CountFilt(List[0], Separator);
 For I := 1 to List.Count-1 do begin
  S := List[I];
  CurLevel := CountFilt(S, Separator);
  If CurLevel > PreLevel Then Begin
   aNode := aTreeview.Items.AddChild(aNode, GetFilt(S, CountFilt(S, Separator), Separator));
  End;
  If CurLevel = PreLevel Then Begin
   aNode := aTreeview.Items.Add(aNode, GetFilt(S, CountFilt(S, Separator), Separator));
  End;
  If CurLevel < PreLevel Then Begin
   aNode := aTreeview.Items.Add(StepBack(aNode, PreLevel - CurLevel), GetFilt(S, CountFilt(S, Separator), Separator));
  End;
  aNode.ImageIndex := aNode.Level;
  aNode.SelectedIndex := aNode.Level;
  aNode.StateIndex := aNode.Level;
  PreLevel := CurLevel;
 End;
end;

end.
