Delphi-PRAXiS
Seite 2 von 2     12   

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   TSearchRec.Findfirst, findnext Alternative (https://www.delphipraxis.net/163005-tsearchrec-findfirst-findnext-alternative.html)

BUG 13. Sep 2011 10:52

AW: TSearchRec.Findfirst, findnext Alternative
 
Zitat:

Zitat von Bjoerk (Beitrag 1123948)
So geht's eigentlich ganz gut, nur bisschen doof, daß dann erst mal nicht angezeigt wird, ob der Ordner Unterordner hat.

Man könnte auch eine Rekursionstiefe weiter runter gehen als angezeigt. Dabei würde es vielleicht sogar reichen, nur das erste Unteritem zu finden, um zu wissen ob ein Plus angezeigt werden soll.

Bjoerk 13. Sep 2011 11:32

AW: TSearchRec.Findfirst, findnext Alternative
 
Ja, das wundert mich auch, hab' die Compilermelung auch erhalten. Könnte man Nil setzen und das abfragen oder GetTreeNodePath verwenden. Das var soll natürlich ein const sein. Ich wollte verhindern, daß Delphi eine Kopie anlegt. Mit const, var, out und ohne habe ich bei Pointern immer noch Schwierigkeiten, (bei dynamischen Arrays ist es nochmal ein wenig anders, hab ich festgestellt) ob wohl du, Handbagger und Sirius das mir schon mehrfach erklärt haben.

DeddyH 13. Sep 2011 12:22

AW: TSearchRec.Findfirst, findnext Alternative
 
Ungetesteter Vorschlag:
Delphi-Quellcode:
procedure IndicateSubDirs(const ADirectory: String; ATree: TTreeView; Node: TTreeNode);
var
  S: TSearchRec;
  N: TTreeNode;
begin
  N := nil;
  if FindFirst(IncludeTrailingPathDelimiter(ADirectory)+'*.*', faDirectory, S) = 0 then
    try
      repeat
        if (S.Attr and faDirectory) = faDirectory then
          if (Rec.Name <> '.') and (Rec.Name <> '..') then
            N := ATree.Items.AddChild(Node, S.Name);        
      until Assigned(N) or (FindNext(S) <> 0);
    finally
      SysUtils.FindClose(S);
    end;
end;

Bjoerk 13. Sep 2011 13:32

AW: TSearchRec.Findfirst, findnext Alternative
 
Das hat nicht funktioniert, zeigt die Dirs doppelt an.

Am Anfang meiner procedure kann man N:= Start setzen, dann ist N nicht mehr undefiniert.

Edit, nein umgekehrt, zeigt nur ein Dir an.

DeddyH 13. Sep 2011 13:52

AW: TSearchRec.Findfirst, findnext Alternative
 
Ja, soll ja auch nur ein Dir anzeigen. Es ging nur darum, zu ermitteln, ob zum Verzeichnis des übergebenen Knotens noch Unterordner existieren. Wenn ja, dann Childknoten anlegen.

Bjoerk 13. Sep 2011 18:43

AW: TSearchRec.Findfirst, findnext Alternative
 
Mann, war das jetzt ein Akt. Knoten, welche man anklickt und dann das Plus verschwindet, mag ich ja gar nicht. So finde ich’s schöner und läuft auch ziemlich flott soweit:

Delphi-Quellcode:
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
    begin
      Delete (Result, I, 1);
      Dec(I);
    end;
    Inc(I);
  end;
end;

function FindSubDir(const ADir: String; var ASubDir: string): boolean;
var
  S: TSearchRec;
  R: integer;
begin
  Result:= false;
  ASubDir:= '';
  R:= FindFirst(IncludeTrailingPathDelimiter(ADir)+'*.*', faDirectory, S);
  while ((R = 0) and (not Result)) do
  begin
    if ((S.Attr and faDirectory) = faDirectory) then
      if ((S.Name <> '.') and (S.Name <> '..')) then
      begin
        Result:= true;
        ASubDir:= S.Name;
      end;
      R:= FindNext(S);
  end;
  FindClose(S);
end;

procedure GetFirstAndSecondLevel(const APath: String; const ATree: TTreeView; const AStartNode: TTreeNode);
var
  S: TSearchRec;
  R: integer;
  N: TTreeNode;
  ASubPath: string;
begin
  R:= FindFirst(APath+'*.*', faDirectory, S);
  while R = 0 do
  begin
    if ((S.Attr and faDirectory) = faDirectory) then
      if ((S.Name <> '.') and (S.Name <> '..')) then
      begin
        N:= ATree.Items.AddChild(AStartNode, S.Name);
        if FindSubDir(APath+S.Name, ASubPath) then ATree.Items.AddChild(N, ASubPath);
      end;
    R:= FindNext(S);
  end;
  FindClose(S);
end;

procedure IndicatePathTreeView(const ATree: TTreeView; APath: String);
begin
  APath:= IncludeTrailingPathDelimiter(APath);
  ATree.Items.Clear;
  ATree.Items.BeginUpDate;
  GetFirstAndSecondLevel(APath, ATree, ATree.Items.AddChild(Nil, APath));
  ATree.Items.EndUpDate;
  ATree.Items.GetFirstNode.Expand(false);
end;

procedure IndicateSelectedNode(const ATree: TTreeView);
var
  ANode: TTreeNode;
begin
  if ATree.Selected <> ATree.Items.GetFirstNode then
  begin
    ATree.Items.BeginUpDate;
    while ATree.Selected.getFirstChild <> Nil do
      ATree.Items.Delete(ATree.Selected.getFirstChild);
    ANode:= ATree.Selected;
    GetFirstAndSecondLevel(GetTreeNodePath(ANode), ATree, ANode);
    ATree.Items.EndUpDate;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  IndicatePathTreeView(TreeView1, 'C:');
end;

procedure TForm1.TreeView1Click(Sender: TObject);
begin
  IndicateSelectedNode(TreeView1);
end;

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


Alle Zeitangaben in WEZ +1. Es ist jetzt 15:49 Uhr.
Seite 2 von 2     12   

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz