Registriert seit: 28. Feb 2011
Ort: Mannheim
1.384 Beiträge
Delphi 10.4 Sydney
|
AW: TSearchRec.Findfirst, findnext Alternative
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;
|
|
Zitat
|