Solved

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

Posted on 2002-05-02
22
1,148 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
Comment Utility
warum nur 50 Punkte ;-))))))

// why do spend only 50 Points ?

Cesario
0
 
LVL 4

Expert Comment

by:nestorua
Comment Utility
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
Comment Utility
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
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
sure, igor, you can provide your sample

i'm also happy that i can go on

meikl ;-)
0
 
LVL 9

Expert Comment

by:ITugay
Comment Utility
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
Comment Utility
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
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 27

Author Comment

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

Expert Comment

by:ITugay
Comment Utility
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
Comment Utility
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
Comment Utility
seems i have to provide some extra points :-))
0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
OK then . When need my support I will be glad to help you . See you on net .
0
 
LVL 9

Expert Comment

by:ITugay
Comment Utility
I agree with no points :-)
0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
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
Comment Utility
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

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

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.

744 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

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now