New TDirectoryTreeview component
lazarus / 5-Lazarus Extra Components

----------------------------------------------------------------------
cyber_python · 2008-04-26 12:21

The last few days I've been trying to create a TDirectoryTreeview
component.
(It's my first Lazarus component  )

Here is a screenshot of a test application using TDirectoryTreeview
under Ubuntu 8.04 :

(http://img108.imageshack.us/img108/9660/screenshot2mi8.th.png)

I have tried (without success) to make it work at design time
(although I can set the properties values, the component does not get
updated) but it works fine at runtime. If someone has a clue on how to
fix this, please send me an e-mail at cyber_python@pathfinder.gr    or
post it here on this thread, so that I can create an .lpk package.

To use it create a TDirectoryTreeview, assign an imagelist to the
Images property, set the folder, selected folder, open folder and
selected open folder image index to their according image indexes.
Finally,  create a TStringList and add to it entries in the following
form :

<Node name>
<Node directory>
<Node Image Index, Node Selected Image Index>

e.g.

Under Linux:
------------------------------------
My Home Folder
/home/cyberpython
2,2
My computer Media
/media
3,3
------------------------------------

Under Windows XP :

-----------------------------------
Desktop
c:\Documents and Settings\User\Desktop
4,4
C:\
c:
2,2
D:\
d:
3,3
---------------------------------


and assign it to the RootDirectories property (RootDirectories :=
<TStringlistName>
Here is the code for the component :


Code: [Select]
{
 /********************************************************************
*******
                         TDirectoryTreeview.pas
                               ----------
          Component For Displaying A Tree Of Directories In A
FileSystem


 *********************************************************************
******/

 *********************************************************************
********
 *
 *                                                                   
      *
 *  See the Lazarus Distribution COPYING.modifiedLGPL,               
      *
 *  for details about the copyright.                                 
      *
 *                                                                   
      *
 *  This code is distributed in the hope that it will be useful,     
      *
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of   
      *
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.             
      *
 *                                                                   
      *
 *********************************************************************
********
}
unit DirectoryTreeview;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, ComCtrls, Dialogs;
 
type

  { TDirectoryTreeview }
 
  TDirectoryTreeview = class(TTreeview)
  private
    { Private declarations }
    FRootDirs: TStrings;
    FShowHidden : Boolean;
    FShowSelf : Boolean;
    FShowParent : Boolean;
    FFolderImageIndex : Integer;
    FFolderOpenImageIndex : Integer;
    FFolderSelectedImageIndex : Integer;
    FFolderOpenSelectedImageIndex : Integer;
    FRootDirectories : TStrings;

    procedure SetRootDirs(Value : TStrings);
    procedure SetFolderImageIndex(const NewIndex: Integer);
    procedure SetFolderOpenImageIndex(const NewIndex: Integer);
    procedure SetFolderSelectedImageIndex(const NewIndex: Integer);
    procedure SetFolderOpenSelectedImageIndex(const NewIndex:
Integer);
   
    function searchForFolders(ParentFolder : String; showHidden,
includeSelf, includeParent : boolean) : TStringList;
    function getNodePath(Node : TTreeNode) : String;
    function getChildNodeByData(NodeParent : TTreeNode; data :
Pointer):TTreeNode;
    procedure populateTreeView(root : TTreeNode; CurrentDepth,
MaxDepth : LongInt);

  protected
    { Protected declarations }
    procedure DoPaintNode(Node: TTreeNode);override;
  public
    { Public declarations }
    constructor Create(AnOwner: TComponent);override;
    destructor Destroy;override;
    function getPath : String;
   
  published
    { Published declarations }
    property RootDirectories: TStrings read FRootDirs write
SetRootDirs;
    property ShowHidden: Boolean read FShowHidden write FShowHidden;
    property ShowSelf: Boolean read FShowSelf write FShowSelf;
    property ShowParent: Boolean read FShowParent write FShowParent;
    property FolderImageIndex : Integer read FFolderImageIndex write
SetFolderImageIndex;
    property FolderOpenImageIndex : Integer read FFolderOpenImageIndex
write SetFolderOpenImageIndex;
    property FolderSelectedImageIndex : Integer read
FFolderSelectedImageIndex write SetFolderSelectedImageIndex;
    property FolderOpenSelectedImageIndex : Integer read
FFolderOpenSelectedImageIndex write SetFolderOpenSelectedImageIndex;

  end;

procedure Register;

implementation


procedure removeBlankLinesFromTheBottom(Strings : TStrings);
var
  i : integer;
  reachedLast: boolean;
begin
  reachedLast := false;
  i:=Strings.Count-1;
  while( (i>=0)AND(not reachedLast) )do
  begin
       if(Strings.Strings[i]='')then
       begin
         Strings.Delete(i);
       end
       else
           reachedLast:=true;
       i:=i-1;
  end;
end;


function TDirectoryTreeview.searchForFolders(ParentFolder : String;
showHidden, includeSelf, includeParent : boolean) : TStringList;
var
 searchResult : TSearchRec;
 res : TStringList;
begin
 res:=TStringList.Create;

 if(directoryExists(ParentFolder))then
 begin
   if FindFirst(ParentFolder+PathDelim+'*', faAnyFile, searchResult) =
0 then
  begin
    repeat
      if (  (searchResult.Attr AND faDirectory) > 0 ) then
      begin

        if ( searchResult.Name = '.') then
        begin
           if(includeSelf)then
               res.Add(searchResult.Name);
        end
        else if (searchResult.Name = '..')then
        begin
           if(includeParent)then
               res.Add(searchResult.Name);
        end
        else
        begin
          if(length(searchResult.Name) > 0)then
          begin
            {$ifdef Win32}
            if ( not showHidden  )then
            begin
                 if ( (searchResult.Attr  AND faHidden) <= 0 )then
                 begin
                           res.Add(searchResult.Name);
                 end;
            end
            else
            begin
              res.Add(searchResult.Name);
            end;
            {$endif}
            {$ifdef Unix}
            if(not showHidden)then
            begin
              if(searchResult.Name[1] <> '.')then
              begin
                   res.Add(searchResult.Name);
              end;
            end
            else
            begin
              res.Add(searchResult.Name);
            end;
            {$endif}
          end;
        end;
      end;
    until FindNext(searchResult) <> 0;
    FindClose(searchResult);
  end;
 end;
 result:=res;
end;










function TDirectoryTreeview.getNodePath(Node : TTreeNode) : String;
var
 rootDir : String;
 n : TTreeNode;
begin
 n:=Node;
 rootDir:= PChar(n.Data);
 while (n.Parent <> nil)do
 begin
   n:=n.Parent;
   if( pChar(n.Data) <> PathDelim)then
       rootDir:=PChar(n.Data)+PathDelim+rootDir
   else
       rootDir:=PChar(n.Data)+rootDir;
 end;
 result:=rootDir;
end;







function TDirectoryTreeview.getChildNodeByData(NodeParent : TTreeNode;
data : Pointer): TTreeNode;
var
 n : TTreeNode;
 found : boolean;
 d : String;
 res : TTreeNode;
begin
 res:=nil;
 n:=NodeParent.GetFirstChild;
 found := false;
 d := PChar(data);

 while( (n <> nil) and (found=false) )do
 begin
   if(PChar(n.Data) = d)then
   begin
       found:=true;
       res:=n;
   end;
   n:=n.GetNextSibling;
 end;
 result:=res;
end;









procedure TDirectoryTreeview.populateTreeView(root : TTreeNode;
CurrentDepth, MaxDepth : LongInt);
var
 i: integer;
 res: TStringList;
 dirname : string;
 n, ch, tmpNode : TTreeNode;
 rootDir : String;
begin
 rootDir := getNodePath(root);
 
 if(directoryExists(rootDir))then
 begin
 
  if(CurrentDepth=0)then
         Items.BeginUpdate;
        
  res :=  searchForFolders(rootDir, FShowHidden, FShowSelf,
FShowParent);
        
 //remove the nodes that represent deleted directories
 //
  tmpNode:=root.GetFirstChild;
  while(tmpNode <> nil)do
  begin
       n:=tmpNode;
       tmpNode:=tmpNode.GetNextSibling;
       if(res.IndexOf(pChar(n.Data)) < 0 )then
       begin
               n.Delete;
       end;
  end;
 //
 
  for i:= 0 to res.Count-1 do
  begin
     dirname:= res.Strings[i];
     if(length(dirname) > 0)then
     begin
                      tmpNode:= getChildNodeByData(root,
PChar(dirname));
                      if( tmpNode = nil )then
                      begin
                           n:=Items.AddChild(root, res.Strings[i]);
                           n.Data:=pChar(res.Strings[i]);
                           n.ImageIndex:=self.FFolderImageIndex;
                         
 n.SelectedIndex:=self.FFolderSelectedImageIndex;
                      end;
     end;
  end;

  if(CurrentDepth < MaxDepth)then
  begin
    if(root.Count>0)then
    begin
        ch:= root.GetFirstChild;
        while(ch <> nil)do
        begin
             populateTreeView(ch, CurrentDepth+1, MaxDepth);
             ch:=ch.GetNextSibling;
        end;
    end;
  end;
  root.AlphaSort;
  if(CurrentDepth=0)then
         Items.EndUpdate;

  res.Free;

 end;

end;












constructor TDirectoryTreeview.Create(AnOwner: TComponent);
begin
  inherited;
  FRootDirs := TStringList.Create;
  FRootDirectories := TStringList.Create;
  ShowHidden := false;
  ShowSelf:=false;
  ShowParent:=false;
  FolderImageIndex := -1;
  FolderOpenImageIndex := -1;
  FolderSelectedImageIndex := -1;
  FolderOpenSelectedImageIndex := -1;
end;






destructor TDirectoryTreeview.Destroy;
begin
  FRootDirectories.Free;
  FRootDirs.Free;
  inherited;
end;









procedure TDirectoryTreeview.SetRootDirs(Value : TStrings);
var
 i : integer;
 n : TTreeNode;
 tmp2 : TStringList;
 imgIndex, SelImgIndex : integer;
begin

 FRootDirs.Assign(Value);
 removeBlankLinesFromTheBottom(FRootDirs);
 FRootDirectories.Clear;

 tmp2:=TStringList.Create;

 tmp2.Delimiter:=',';

 if((FRootDirs.Count mod 3)=0)then
 begin
  Items.Clear;
 
  i:=0;
  while(i< FRootDirs.Count-1) do
  begin

       tmp2.Clear;
       tmp2.DelimitedText:=FRootDirs.Strings[i+2];
      
       n:=Items.Add(nil,FRootDirs.Strings[i]);
      
       FRootDirectories.Add(FRootDirs.Strings[i+1]);
     
 n.Data:=pChar(FRootDirectories.Strings[FRootDirectories.Count-1]);

       if(tmp2.Count = 2)then
       begin
            Try
               imgIndex:=strtoint(tmp2.Strings[0]);
               SelImgIndex:=strtoint(tmp2.Strings[1]);
            except
               on E : Exception do
               begin
                    imgIndex:=self.FFolderImageIndex;
                    SelImgIndex:=self.FFolderSelectedImageIndex;
               end;
            end;
       end
       else
       begin
         imgIndex:=self.FFolderImageIndex;
         SelImgIndex:=self.FFolderSelectedImageIndex;
       end;

       n.ImageIndex:=imgIndex;
       n.SelectedIndex:=SelImgIndex;
      
       populateTreeView(n, 0, 2);
       i:=i+3;
  end;
 
  n:=Items.GetFirstNode;
  if(n <> nil)then
       n.Expand(false);//remove this if you activate the while loop
 
  {while(n <> nil)do
  begin
       n.Expand(false);
       n:= n.GetNextSibling;
  end;}
 end
 else
     showMessage('Invalid root directories!');

  tmp2.Free;
end;











function TDirectoryTreeview.getPath : String;
begin
  if(Selected <> nil)then
                   result:= getNodePath(Selected);
end;










procedure TDirectoryTreeview.SetFolderImageIndex(const NewIndex:
Integer);
begin
  FFolderImageIndex :=  NewIndex;
end;




procedure TDirectoryTreeview.SetFolderOpenImageIndex(const NewIndex:
Integer);
begin
  FFolderOpenImageIndex :=  NewIndex;
end;




procedure TDirectoryTreeview.SetFolderSelectedImageIndex(const
NewIndex: Integer);
begin
  FFolderSelectedImageIndex :=  NewIndex;
end;




procedure TDirectoryTreeview.SetFolderOpenSelectedImageIndex(const
NewIndex: Integer);
begin
  FFolderOpenSelectedImageIndex :=  NewIndex;
end;




procedure TDirectoryTreeview.DoPaintNode(Node: TTreeNode);
begin
  populateTreeView(Node, 0, 2);

  if(Node.Parent<>nil)then
  begin
       if(Node.Expanded)then
       begin
          Node.ImageIndex:=self.FFolderOpenImageIndex;
          Node.SelectedIndex:=self.FFolderOpenSelectedImageIndex;
       end
       else
       begin

          Node.ImageIndex:= self.FFolderImageIndex;
          Node.SelectedIndex:=self.FFolderSelectedImageIndex;
       end;
  end;
 
  inherited;
end;


procedure Register;
begin
  RegisterComponents('Misc', [TDirectoryTreeview]);
end;

end.


Regards, cyber_python.