PC Plus SuperCD (UK) 2000 March/pcp161b.iso/handson/archive/Issue152/delphi/copydelp.exe/TreeDir3/TreeD3.pas

Pascal/Delphi Source File | 1997-06-05 | 7.1 KB | 227 lines

unit TreeD3;
   { PC Plus sample Delphi 3.0 file manager.
   Illustrates a way of creating a TreeView Explorer-like directory browser.

   Author: Huw Collingbourne

   Remarks: This is a fairly simple application which displays files
   and executes a file when double-clicked. You may want to develop this
   by adding additional file management routines, multiple disk display
   and appropriate exception handling. }

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ExtCtrls, ShellAPI;

type
  TForm1 = class(TForm)
    TreeView1: TTreeView;
    StatusBar1: TStatusBar;
    ImageList1: TImageList;
    Splitter1: TSplitter;
    ListView1: TListView;
    procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode;
      var AllowExpansion: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure TreeView1Click(Sender: TObject);
    procedure ListView1Click(Sender: TObject);
    procedure ListView1DblClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function isDirectory( sr : TSearchRec ) : boolean;
    function excludeFromListView( sr : TSearchRec ) : boolean;
    function hasSubDirectories( d : string ) : boolean;
    function fullPath( Node : TTreeNode ) : string;
    procedure addSubDirs( rootDir : string;  Node   : TTreeNode );
    procedure upDatePanels;
    procedure upDateListView;
    function  RunFile(const FileName, Params, DefaultDir: string;
                 ShowCmd: Integer): THandle;
  end;

const    // specify directory to appear as the root in TreeView
  rootDir = 'C:';

var
  Form1: TForm1;

implementation

{$R *.DFM}
function TForm1.RunFile(const FileName, Params, DefaultDir: string;
  ShowCmd: Integer): THandle;
// executes the specified file (if possible)
var
  zFileName, zParams, zDir: array[0..79] of Char;
begin
  Result := ShellExecute(Application.MainForm.Handle, nil,
    StrPCopy(zFileName, FileName), StrPCopy(zParams, Params),
    StrPCopy(zDir, DefaultDir), ShowCmd);
end;

procedure TForm1.upDateListView;
// displays file names in current directory
var
   NewItem : TListItem;
   d : string;
   Result : integer;
   SearchRec: TSearchRec;
begin
    d := fullPath(TreeView1.Selected);
    ListView1.Items.Clear;
    Result := FindFirst(d+'*.*', faAnyFile, SearchRec);
    while Result = 0 do
    begin // filter any unwanted files from display
      if not excludeFromListView( SearchRec ) then
      begin
         NewItem := ListView1.Items.Add;    // add a file name
         NewItem.Caption := SearchRec.Name;
         if isDirectory(SearchRec) then
            NewItem.ImageIndex := 0        // show icon before file or dir
         else
            NewItem.ImageIndex := 2;
      end;
      Result := FindNext(SearchRec);
    end;
    FindClose(SearchRec);
end;

procedure TForm1.upDatePanels;
// display path and number of sub directories in the Statusbar panels
var
  p0text : string;
begin
  p0text := fullPath(TreeView1.Selected);
  if TreeView1.Selected.Expanded then p0text := p0text +
        ' [ ' + IntToStr( TreeView1.Selected.Count ) + ' subdirectories ]';
  StatusBar1.Panels.Items[0].Text := p0text;
end;

function TForm1.excludeFromListView( sr : TSearchRec ) : boolean;
// don't display these files in the file list
begin
    if isDirectory( sr ) then
       excludeFromListView := true
    else if ((sr.Name = '.') or (sr.Name = '..')) then
     excludeFromListView := true
  else excludeFromListView := false;
end;

function TForm1.isDirectory( sr : TSearchRec ) : boolean;
// test if current file is a directory
begin
   isDirectory := ((sr.Attr and faDirectory > 0)
                  and
                  (sr.Name <> '.') and (sr.Name <> '..'));
end;

function TForm1.fullPath( Node : TTreeNode ) : string;
// return a string showing path - e.g. C:\GP\Parent\NodeDir\
var
  ANode, FirstNode : TTreeNode;
  path : string;
begin
  ANode := Node;
  path := ANode.Text + '\';
  FirstNode := TreeView1.Items.GetFirstNode;
  while ANode <> FirstNode do
  begin
     ANode := ANode.Parent;
     path := ANode.Text + '\' + path;
  end;
  fullPath := path;
end;

function TForm1.hasSubDirectories( d : string ) : boolean;
// test in the directory indicated by the string 'd' contains
// subdirectories. If so, return true.
var
  SearchRec: TSearchRec;
  SResult : integer;
  noSubDirFound : boolean;
begin    // find first file, Result is 0 if successful
    noSubDirFound := true;
    SResult := FindFirst(d + '\*.*', faDirectory, SearchRec);
    while ((SResult = 0) and (noSubDirFound)) do
    begin
      if isDirectory(SearchRec) then noSubDirFound := false;
      SResult := FindNext(SearchRec);
    end;
    FindClose(SearchRec);
    hasSubDirectories := (noSubDirFound = false);
end;

procedure TForm1.addSubDirs( rootDir : string;  Node : TTreeNode );
{ add directory names as branches of the TreeView . If a directory contains
  any subdirectories, a '+' is placed alongside the directory name in
  the TreeView }
var
  SearchRec: TSearchRec;
  Result : integer;
  NewNode : TTreeNode;
begin    // find first file, Result is 0 if successful
    Result := FindFirst(rootDir + '*.*', faDirectory, SearchRec);
    while Result = 0 do
    begin
      if isDirectory(SearchRec) then
      begin  // if directory is found add it as a child of prev node in TreeView
         NewNode := TreeView1.Items.AddChild(Node, SearchRec.Name);
         NewNode.SelectedIndex := 1;
         if (hasSubDirectories( rootDir + SearchRec.Name ) ) then
            // making HasChildren true adds a '+' to the directory node
            // even if that node hasn't really got any child nodes
            NewNode.HasChildren := true;
      end; // then continue searching }
      Result := FindNext(SearchRec);
    end;
    FindClose(SearchRec);
    Node.AlphaSort;
end;

procedure TForm1.TreeView1Expanding(Sender: TObject; Node: TTreeNode;
  var AllowExpansion: Boolean);
begin
    if Node.GetFirstChild = nil then
       addSubDirs(fullPath(Node) , Node );
  Node.Selected := true; { if expanding the node, select it }
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Node   : TTreeNode;
begin
  Node := TreeView1.Items.Add(TreeView1.Selected, rootDir);
  Node.SelectedIndex := 1;
  Node.Selected := true;
  addSubDirs(rootDir+'\', Node);
  TreeView1.AlphaSort;
            // Expand(false) means - don't recurse to expand all child items
            // Expand(true) would havethe effect of logging (and expanding)
            // all subdirectories beneath the root!
  TreeView1.Items[0].Expand(false);
  updateListView;
  updatePanels;
end;

procedure TForm1.TreeView1Click(Sender: TObject);
begin
    upDateListView;
    updatePanels;
end;

procedure TForm1.ListView1Click(Sender: TObject);
begin
  StatusBar1.Panels.Items[1].Text := ListView1.Selected.Caption;
end;

procedure TForm1.ListView1DblClick(Sender: TObject);
begin
  RunFile(ListView1.Selected.Caption, '', fullPath(TreeView1.Selected), SW_SHOW);
end;

end.