Solved

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

Posted on 2002-05-02
1,148 Views
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
Question by:kretzschmar
• 9
• 4
• 3
• +5

LVL 8

Expert Comment

warum nur 50 Punkte ;-))))))

// why do spend only 50 Points ?

Cesario
0

LVL 4

Expert Comment

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

raidos earned 50 total points
procedure TForm1.Populate(TreeView: TTreeView; BaseDir: 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
AddItems(AItem, Name + '\' + SR.Name);
End;
I := FindNext(SR);
End;
FindClose(SR);
End;

Var
ListItem : TTreeNode;
begin
end;

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

Easy to use.. =)

Regards
//raidos
0

LVL 27

Author Comment

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
(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

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

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

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;
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

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

sure, igor, you can provide your sample

i'm also happy that i can go on

meikl ;-)
0

LVL 9

Expert Comment

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
private
FNode: TTreeNode;      // parent node of TreeView to include directories
FTreeView: TTreeView;  // TreeView that keeps direcoris tree
FPath: String;         // current path to scan
// 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

//------------------------------------------------------------------------------
//
//
//------------------------------------------------------------------------------
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;

Resume;
end;

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

// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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;

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

// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
begin
try
FStrings.Delete(FStrings.IndexOfObject(Self))
except

end;
end;

end.

0

LVL 17

Expert Comment

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

>are you cuting and pasting the header
yes, i'm too lazy
0

LVL 9

Expert Comment

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

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;
{---}
var Node: TTreeNode;
begin
with lpFindFileData do
if ((dwFileAttributes=FILE_ATTRIBUTE_DIRECTORY) and
(String(cFileName)<>'.') and (String(cFileName)<>'..'))
then
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
//
HasSibling:=FindNextFile(h, lpFindFileData);
while HasSibling do
begin
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.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

seems i have to provide some extra points :-))
0

LVL 27

Author Comment

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

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

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

OK then . When need my support I will be glad to help you . See you on net .
0

LVL 9

Expert Comment

I agree with no points :-)
0

LVL 27

Author Comment

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

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

### Suggested Solutions

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the inâ€¦
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, thâ€¦
Internet Business Fax to Email Made Easy - With eFax Corporate (http://www.enterprise.efax.com), you'll receive a dedicated online fax number, which is used the same way as a typical analog fax number. You'll receive secure faxes in your email, frâ€¦
This video discusses moving either the default database or any database to a new volume.

#### Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!