I have posted the following on the forum, but just in case someone does not visit the forum and has an answer :
The last few days I've been trying to create a TDirectoryTreeview component. (I don't really know if what I have made has the intended functionality f a TDirectoryTreeview + it depends on the findFirst / Next functions that fail to identify symlinks and hidden files under linux/*nix so I've used $IFDEFs.)
Here is a screenshot of a test application using TDirectoryTreeview under Ubuntu 8.04 :
http://img108.imageshack.us/my.php?image=screenshot2mi8.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 someone has a clue on how to fix this,
please send me an e-mail at or send it on
this mailing list or this
thread :http://www.lazarus.freepascal.org/index.php?name=PNphpBB2&file=viewtopic&t=5281, 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>Wink
Here is the code for the component :
{
/**************************************************************************** TDirectoryTreeview.pas
----------
Component For Displaying A Tree Of Directories In A FileSystem ----------
created by George "cyber_python" Migdos
***************************************************************************/
***************************************************************************** *
*
*
* 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.Parentnil)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.