Einzelnen Beitrag anzeigen

Bjoerk

Registriert seit: 28. Feb 2011
Ort: Mannheim
1.384 Beiträge
 
Delphi 10.4 Sydney
 
#9

AW: TSearchRec.Findfirst, findnext Alternative

  Alt 13. Sep 2011, 11:30
So geht's eigentlich ganz gut, nur bisschen doof, daß dann erst mal nicht angezeigt wird, ob der Ordner Unterordner hat.

Delphi-Quellcode:
procedure GetNextLevelNodeDirs(const ADirectory: String; var ATree: TTreeView; const Start: TTreeNode);
var
  S: TSearchRec;
  R: integer;
  N: TTreeNode;
begin
  R:= FindFirst(IncludeTrailingPathDelimiter(ADirectory)+'*.*', faDirectory, S);
  while R = 0 do
  begin
    if ((S.Attr and faDirectory) <> 0) then
      if ((S.Name <> '.') and (S.Name <> '..')) then
        if not N.HasChildren then
          N:= ATree.Items.AddChild(Start, S.Name);
    R:= FindNext(S);
  end;
  Findclose(S);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Path: string;
begin
  Path:= 'C:\';
  TreeView1.Items.BeginUpDate;
  GetNextLevelNodeDirs(Path, TreeView1, TreeView1.Items.AddChild(Nil, Path));
  TreeView1.Items.EndUpDate;
  TreeView1.Items[0].Expand(false);
end;

function GetTreeNodePath(const ANode: TTreeNode): string;
var
  I: integer;
begin
  if Assigned(ANode) then
    if Assigned(ANode.Parent) then
      GetTreeNodePath:= GetTreeNodePath(ANode.Parent)+'\'+ANode.Text
    else
      Result:= ANode.Text
  else
    Result:= '';
  if Result <> 'then Result:= Result+'\';
  I:= 1;
  while I < Length(Result) do
  begin
    if (Result[I] = '\') and (Result[I+1] = '\') then Delete (Result, I, 1);
    Inc(I);
  end;
end;

procedure TForm1.TreeView1Click(Sender: TObject);
var
  ANode: TTreeNode;
begin
  ANode:= TreeView1.Selected;
  TreeView1.Items.BeginUpDate;
  GetNextLevelNodeDirs(GetTreeNodePath(ANode), TreeView1, ANode);
  TreeView1.Items.EndUpDate;
end;

procedure TForm1.TreeView1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  TreeView1Click(Sender);
end;
  Mit Zitat antworten Zitat