Solved

qow 17: (QUICKY) how to fill a treeview with a directorytree?

Posted on 2002-05-02
22
1,151 Views
Last Modified: 2010-04-04
hi experts,

i am starting a new quest: qow = question of the week :-)
each week i will introduce a new simple? question.

now qow 17  (a quicky)

the first working solution will get the points (a graded).

sorry, top 15 experts, you are not allowed to solve this
q, only other can solve this question :-(

well the question is:

an sample is needed
how to fill a treeview with a directorytree
(like explorer)?

let see

meikl ;-)

(the points may reduced to 25 pts by a modarator,
before i do accept)
0
Comment
Question by:kretzschmar
  • 9
  • 4
  • 3
  • +5
22 Comments
 
LVL 8

Expert Comment

by:Cesario
ID: 6986197
warum nur 50 Punkte ;-))))))

// why do spend only 50 Points ?

Cesario
0
 
LVL 4

Expert Comment

by:nestorua
ID: 6986236
HI, meikl,
Would you mind to formulate your qow more explicitly:
1. we already have the directory tree (some sort of outline)
and want simply copy it to treeview.
2. we have a name of some directory and want to fill the treeview with all the subdirectories of this directory?
Sincerely,
Nestorua.
0
 
LVL 3

Accepted Solution

by:
raidos earned 50 total points
ID: 6986249
procedure TForm1.Populate(TreeView: TTreeView; BaseDir: String);

Procedure AddItems(ListItem: TTreeNode; Name: String);
Var
  SR : TSearchRec;
  I : Integer;
  AItem : TTreeNode;
Begin
  If Name[Length(Name)] = '\' Then
    Name := Copy(Name, 1, Length(Name)-1);
  I := FindFirst(Name + '\*.*', faDirectory,SR);
  While I = 0 Do Begin
    If (SR.Name <> '.') And (SR.Name <> '..') And (SR.Attr AND faDirectory = faDirectory) Then Begin
      AItem := TreeView.Items.AddChild(ListItem, SR.Name);
      AddItems(AItem, Name + '\' + SR.Name);
    End;
    I := FindNext(SR);
  End;
  FindClose(SR);
End;

Var
  ListItem : TTreeNode;
begin
  ListItem := TreeView.Items.Add(Nil, BaseDir);
  AddItems(ListItem, BaseDir);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Populate(Treeview1, 'C:\');
end;


Easy to use.. =)

Regards
//raidos
0
Gigs: Get Your Project Delivered by an Expert

Select from freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely and get projects done right.

 
LVL 27

Author Comment

by:kretzschmar
ID: 6986257
cesario,
as NEW top15 member,
you will get no point from this q

well, why i spent so low points?
qows comes periodically each week one,
sometimes (i tend to do this more often)
i provide for each different
solution the same points,
therefore i must care
about my points-account
(sometimes i may have ask a q for myself)

well, why qows?
it was just an idea
- for providing points for none top15 members
- for learning from each other
- for a better community here
- for just for fun
... and more benefits

well,
and don't worry,
i run not out of ?simple questíons :-)))

meikl ;-)



0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6986268
to nestorua,

use the ttreeview and try to populate it with the directory structure of drive c:\ (for example)


to raidos,
looks good

meikl ;-)

(i'm not quick enough) :-))
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6986337
to nestorua,
i will try on the next qow
to be clearer with the question
(i was a bit in hurry by this one)
meikl ;-)
0
 
LVL 9

Expert Comment

by:ginsonic
ID: 6986923
procedure Populate(aTreeView: TTreeView; aRoot: TTreeNode;Path: string; Recurse: boolean);
var
  NewNode: TTreeNode;
  SRec: TSearchRec;
begin
  if FindFirst(Path + '*.*', SysUtils.faAnyFile, SRec) = 0 then
  repeat
    if (sRec.Name = '.') or (sRec.Name = '..') then
      Continue;
    NewNode := aTreeView.Items.AddChild(aRoot, SRec.Name);
    if Recurse and ((srec.Attr and sysutils.faDirectory) <> 0) then
      Populate(aTreeView, NewNode, Path + srec.name + '\', True);
  until
    FindNext(SRec) <> 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Populate(TreeView1, nil, 'c:\', True);
end;
0
 
LVL 9

Expert Comment

by:ITugay
ID: 6987894
Hi meikl,
hi all.

I'm glad that qow problem was succesfully solved. Can I provide my sample for no-points?

----
Igor
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6987909
sure, igor, you can provide your sample

i'm also happy that i can go on

meikl ;-)
0
 
LVL 9

Expert Comment

by:ITugay
ID: 6987940
Ok, then there is my version. It allow to scan drives and place result into TTreeView.


//  An advantage of this technique is that user able to work with directories
//  tree and see which of branches can be expanded while scanning is in progress
//  Once user click on node, and directory still not scanned, priority of
//  according thread increased to allow user see result of scanning ASAP.
//  Scanned and "in progress" directories shown in different colors.

sample application can be found at:
http://i-g-o-r.virtualave.net/zip/drivescan.zip

-----
Igor.

//------------------------------------------------------------------------------
//
//  Basic classes to background scan drive's directory using threads
//
//------------------------------------------------------------------------------
unit DSClasses;

interface

uses
  Classes, SysUtils, ComCtrls;

//------------------------------------------------------------------------------
type
  TScanThread = class(TThread)
  private
    FNode: TTreeNode;      // parent node of TreeView to include directories
    FTreeView: TTreeView;  // TreeView that keeps direcoris tree
    FPath: String;         // current path to scan
    FStrings: TStrings;    // TStringList to show info about running threads
                           // and keep references to allow termination
    FFoundDir: String;     // used as parameter for ScanSubdirectory method
    FExtCounter: ^Integer; // pointer to processed directories count
  protected
    procedure Execute; override;
    procedure ScanSubdirectory;
    procedure RemoveInfoFromListBox;
  public
    // APath - path to scan without backslash
    // ATreeView - control to place result
    // ANode - parent directory node
    // AStrings - keep all currently running threads
    // ACount - point to counter (Integer type) of processed directories
    constructor Create(const APath: String; ATreeView: TTreeView;
      ANode: TTreeNode; AStrings: TStrings; ACount: Pointer);
    destructor Destroy; override;
  end;

//------------------------------------------------------------------------------
implementation

//------------------------------------------------------------------------------
//
//          TScanThread
//
//------------------------------------------------------------------------------
constructor TScanThread.Create(const APath: String; ATreeView: TTreeView;
  ANode: TTreeNode; AStrings: TStrings; ACount: Pointer);
begin
  Inherited Create(True);

  FNode := ANode;

  // mark node as "in progress"
  if FNode <> nil then
    FNode.Data := Self;

  FPath := APath;
  FTreeView := ATreeView;
  FStrings := AStrings;
  FExtCounter := ACount;
  inc(FExtCounter^);

  FreeOnTerminate := True;

  // make it lowest to allow increase it in runtime when user needs
  // to scan directory ASAP (TreeView's node clicked)
  Priority := tpLowest;

  FStrings.AddObject(FPath, Self);

  Resume;
end;

// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
destructor TScanThread.Destroy;
begin
  if (FNode <> nil) then
  begin
    if not Terminated then
    begin
      // mark node as "ready"
      FNode.Data := nil;
      FTreeView.Invalidate;
    end
    else
      // mark node as "terminated"
      FNode.Data := Pointer(-1);
  end;
  Inherited;
end;

// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
procedure TScanThread.Execute;
var
  SR: TSearchRec;
begin
  if FindFirst(FPath+'\*.*', faDirectory, SR) = 0 then
  try
    repeat
      if (SR.Attr and faDirectory <>0) and (Copy(SR.Name, 1, 1) <> '.') then
      begin
        FFoundDir := SR.Name;
        Synchronize(ScanSubdirectory);
      end;
    until (FindNext(SR) <> 0) or Terminated;
  finally
    FindClose(SR)
  end;
  Synchronize(RemoveInfoFromListbox);
end;

// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
procedure TScanThread.ScanSubdirectory;
var
  ST: TScanThread;
begin
  // if thread was terminated, then do not allow to run "child" thread
  if not Terminated then
    ST := TScanThread.Create(FPath + '\' + FFoundDir, FTreeView,
      FTreeView.Items.AddChild(FNode, FFoundDir), FStrings, FExtCounter);
end;

// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
procedure TScanThread.RemoveInfoFromListBox;
begin
  try
    FStrings.Delete(FStrings.IndexOfObject(Self))
  except

  end;
end;

end.

0
 
LVL 17

Expert Comment

by:inthe
ID: 6988022
hi meikl,
"am starting a new quest: qow = question of the week :-)"

actually its 4 mnts old now mmm are you cuting and pasting the header
i see you got your 25 point problem sorted :)


igor,
your screensaver from last time was quite impressive,just like the real thing.messing with the maths had some interesting effects ,like a laser show from top left corner etc :-)

0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6988029
>are you cuting and pasting the header
yes, i'm too lazy
0
 
LVL 9

Expert Comment

by:ITugay
ID: 6988062
yep Barry, something like laser....
I'v got enexpected results making samples for qow, may be it is one of reason why I like this quest :-)
0
 
LVL 4

Expert Comment

by:nestorua
ID: 6988626
HI, meikl,
Here is my solution.

unit frmMain;
{---------------------------------------------}
INTERFACE
{---------------------------------------------}
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, ImgList, ToolWin;

type
  TFormMain = class(TForm)
    tvAllDirs: TTreeView;
    CoolBar1: TCoolBar;
    tbMain: TToolBar;
    ToolButton1: TToolButton;
    tbFillTreeView: TToolButton;
    ToolButton3: TToolButton;
    tbEXIT: TToolButton;
    ToolButton5: TToolButton;
    ImageList1: TImageList;
    procedure tvAllDirsExpanded(Sender: TObject; Node: TTreeNode);
    procedure tbEXITClick(Sender: TObject);
    procedure tbFillTreeViewClick(Sender: TObject);
  private
    function GetOneLevelNode(ParentNode: TTreeNode; tv: TTreeView): boolean;
    procedure FillTreeViewWithDriveNames(tv: TTreeView);
    function GetPathFromNode(Node: TTreeNode): string;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;

{--------------------------------------------------}
IMPLEMENTATION
{--------------------------------------------------}

{$R *.dfm}
{---------------------------------------------------}
function TFormMain.GetOneLevelNode(ParentNode: TTreeNode; tv: TTreeView): boolean;
var lpFileName: PChar;
    lpFindFileData: TWIN32FindData;
    h: THandle;
    HasSibling: boolean;
{---}
procedure AddChildNode;
var Node: TTreeNode;
begin
  with lpFindFileData do
   if ((dwFileAttributes=FILE_ATTRIBUTE_DIRECTORY) and
       (String(cFileName)<>'.') and (String(cFileName)<>'..'))
    then
     with tv.Items.AddChild(ParentNode, String(cFileName)+'\') do
       begin
        ImageIndex:=2;
        SelectedIndex:=3;
       end;
end;
{---}
begin
   Result:=False;
//
   lpFileName:=PChar(GetPathFromNode(ParentNode)+'*.*');
   h:=FindFirstFile(lpFileName, lpFindFileData);
//
   if h=INVALID_HANDLE_VALUE
    then EXIT
    else AddChildNode;
//
   HasSibling:=FindNextFile(h, lpFindFileData);
   while HasSibling do
    begin
      AddChildNode;
      HasSibling:=FindNextFile(h, lpFindFileData);
    end;
//
   ParentNode.AlphaSort;
//
   Result:=ParentNode.HasChildren;
end;
{------------------------------------------------------}
procedure TFormMain.FillTreeViewWithDriveNames(tv: TTreeView);
var nLength,
    nBufferLength: integer;
    lpBuffer,
    lpDriveName: PAnsiChar;
    Node: TTreeNode;
begin
  nBufferLength:=254;
  GetMem(lpBuffer, nBufferLength+1);
  nLength:=GetLogicalDriveStrings(nBufferLength, lpBuffer);
//
  lpDriveName:=lpBuffer;
//
  while nLength>0 do
   begin
     Node:=tv.Items.Add(NIL, lpDriveName);
     Node.ImageIndex:=2;
     Node.SelectedIndex:=3;

     if GetDriveType(lpDriveName)=DRIVE_FIXED
      then GetOneLevelNode(Node, tv);
//
    nLength:=nLength-Length(lpDriveName)-1;
    lpDriveName:=lpDriveName+Length(lpDriveName)+1;
   end;
//
  FreeMem(lpBuffer);
end;
{---------------------------------------------------}
procedure TFormMain.tvAllDirsExpanded(Sender: TObject; Node: TTreeNode);
var ChildNode: TTreeNode;
begin
  ChildNode:=Node.getFirstChild;
  while ChildNode<>NIL do
   begin
     GetOneLevelNode(ChildNode, tvAllDirs);
     ChildNode:=Node.GetNextChild(ChildNode);
   end;
end;
{-------------------------------------------------}
function TFormMain.GetPathFromNode(Node: TTreeNode): string;
begin
  Result:='';
//
  if Node=NIL
   then EXIT;
//
  Result:=GetPathFromNode(Node.Parent)+Node.Text;
end;
{--------------------------------------------------}
procedure TFormMain.tbEXITClick(Sender: TObject);
begin
  Close;
end;
{--------------------------------------------------}
procedure TFormMain.tbFillTreeViewClick(Sender: TObject);
begin
  tvAllDirs.Items.Clear;
  FillTreeViewWithDriveNames(tvAllDirs);
end;
{-------------------------------------------------}
END.
Sincerely,
Nestorua.
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6991057
seems i have to provide some extra points :-))
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6993717
well, if all agree, i will grade as follows

raidos - 50 pts - this q raised to 50 pts
ginsonic - 25 pts - extra question
nestorua - 25 pts - extra question
igor - nothing :-)

may this ok?

meikl ;-)
0
 
LVL 9

Expert Comment

by:ginsonic
ID: 6993781
You can keep my points for futhers qow ( I know that you need these ;-) ). I put my comment just to test me .

Regards,
NIck

P.S. About points sponsor problem . I think that if we contact Moondancer , she/he can move couple points from my account to your's .
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6993797
well, no pints for ginsonic :-)

>I think that if we contact Moondancer , she/he can move
>couple points

could be, that SHE could help, but
i will wait to do this,
until the last moment

even as i'm kpro member my points should
be raised until 500 each month, and if i for myself has no q, it should be enough for the qows (i hope)
(thats are 20 gradings á 25 pts.)

another point would be to raise the points for a qow to 50 pts, then i will have a problem, but the qows would be still more attractive

but at the moment i leave as it is

meikl ;-)
0
 
LVL 9

Expert Comment

by:ginsonic
ID: 6994565
OK then . When need my support I will be glad to help you . See you on net .
0
 
LVL 9

Expert Comment

by:ITugay
ID: 6995656
I agree with no points :-)
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 7005755
well raidos,

points increased to 50

nestu... (name not in mind)
an additional question will be posted for you

thanks for participating

next qow next monday,
because i was/am absent until then

meikl ;-)
0
 

Expert Comment

by:lordsidius
ID: 7702431
well I want to populat a treeview with just a list of the directorys and I want to be able to populat a listview withe the coorisponding files...how do i do that
0

Featured Post

Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Windows 10 is mostly good. However the one thing that annoys me is how many clicks you have to do to dial a VPN connection. You have to go to settings from the start menu, (2 clicks), Network and Internet (1 click), Click VPN (another click) then fi…
The Email Laundry PDF encryption service allows companies to send confidential encrypted  emails to anybody. The PDF document can also contain attachments that are embedded in the encrypted PDF. The password is randomly generated by The Email Laundr…

786 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question