Mega Code Archive
TTreeView extention to have left Explorer folder window
<![CDATA[
Title: TTreeView extention to have left Explorer folder window
Question: How is it possible to show in a TreeView all folders like the left Explorer window it do. Including all Network and own drives. Working quickley and with low memory.
Answer:
Only a sample, how to use IShellFolder, but hope usefully. In this article are some steps of other no named Delphi3000 articles.
The unit you should add to your project:.....
=============================================
unit uPathExplorer;
interface
uses
Windows, SysUtils, Classes, Controls, Forms, ComCtrls, ShellApi, CommCtrl,
ActiveX, ShlObj;
type
PNodeInfo = ^TNodeInfo;
TNodeInfo = record
RelativeIDL: PItemIdList;
AbsoluteIDL: PItemIdList;
ShellFolder: IShellFolder;
TreeNode : TTreeNode;
Expanded : Boolean;
end;
TPathExplorer = class(TTreeView)
private
procedure TreeExpanding(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
procedure TreeDeletion(Sender: TObject; Node: TTreeNode);
public
SysImageList: HImageList;
Desktop: IShellFolder;
Folder:String;
constructor Create(AOwner: TComponent); override;
procedure EnumFolder(Node: TTreeNode);
procedure AddSubfolderToNode(Node: TTreeNode; ItemIdList: PItemIdList);
procedure Change(Node: TTreeNode); override;
end;
implementation
var
Allocator: IMalloc;
function MakeAbsoluteIDL(ParentNode: TTreeNode; Child: PItemIdList): PItemIdList;
function GetPathLen(Path: PItemIdList): Integer;
begin
Result:=0;
if not Assigned(Path) then exit;
{$R-}
while Path^.mkId.cb0 do begin
inc(Result, Path^.mkId.cb);
Path:=PItemIdList(@Path^.mkId.abID[Path^.mkId.cb-2]);
end;
{$R+}
end;
var
PathLen: integer;
ParentFolder: IShellFolder;
ParentPath: PItemIdList;
begin
ParentFolder:=nil;
ParentPath:=nil;
if Assigned(ParentNode) then begin
ParentFolder:=PNodeInfo(ParentNode.Data)^.ShellFolder;
ParentPath:=PNodeInfo(ParentNode.Data)^.AbsoluteIDL;
end;
PathLen:=0;
if Assigned(ParentFolder) then PathLen:=GetPathLen(ParentPath);
{$R-}
Result:=Allocator.Alloc(PathLen+Child^.mkId.cb+2);
if PathLen0 then begin
system.move(ParentPath^, Result^, PathLen);
system.move(Child^, Result^.mkId.abID[PathLen-2], Child^.mkId.cb);
end else
system.move(Child^, Result^, Child^.mkId.cb);
Result^.mkId.abID[PathLen+Child^.mkId.cb-2]:=0;
Result^.mkId.abID[PathLen+Child^.mkId.cb-2+1]:=0;
{$R+}
end;
function MakeNodeInfo(ParentNode: TTreeNode;
ShellFolder: IShellFolder;
ItemOfNode: PItemIdList): PNodeInfo;
begin
Result:=new(PNodeInfo);
FillChar(Result^, sizeof(Result^), 0);
Result^.ShellFolder:=ShellFolder;
Result^.RelativeIDL:=ItemOfNode;
Result^.AbsoluteIDL:=MakeAbsoluteIDL(ParentNode, ItemOfNode);
Result^.Expanded:=False;
end;
function GetShellItemName(Folder: IShellFolder; ItemIdList: PItemIdList): string;
var
StrResult: TStrRet;
begin
Folder.GetDisplayNameOf(ItemIdList, 0, StrResult);
case StrResult.uType of
0: begin
Result := WideCharToString(StrResult.pOleStr);
Allocator.Free(StrResult.pOleStr);
end;
1: Result := PChar(ItemIdList)+StrResult.uOffset;
2: Result := StrResult.cStr;
end;
end;
function HasSubfolders(Folder: IShellFolder; ItemIdList: PItemIdList): Boolean;
var
Attrib: UINT;
begin
Attrib:=SFGAO_HasSubFolder;
Folder.GetAttributesOf(1, ItemIdList, Attrib);
Result:=Attrib=(Attrib or SFGAO_HasSubFolder);
end;
function IsShellItemFromFileSystem(Folder: IShellFolder; ItemIdList: PItemIdList): Boolean;
var
Attrib: UINT;
begin
Attrib:=SFGAO_FileSystem;
Folder.GetAttributesOf(1, ItemIdList, Attrib);
Result:=Attrib=(Attrib or SFGAO_FileSystem);
end;
procedure TPathExplorer.AddSubfolderToNode(Node: TTreeNode; ItemIdList: PItemIdList);
var
ShellFolder: IShellFolder;
DisplayName: string;
TreeNode: TTreeNode;
NodeInfo: PNodeInfo;
FileInfo: TSHFileInfo;
begin
ShellFolder:=PNodeInfo(Node.Data)^.ShellFolder;
NodeInfo:=MakeNodeInfo(Node, nil, ItemIdList);
DisplayName:=GetShellItemName(ShellFolder, ItemIdList);
TreeNode:=Node.Owner.AddChildObject(Node, DisplayName, NodeInfo);
TreeNode.HasChildren:=HasSubfolders(ShellFolder, ItemIdList);
ShellFolder.BindToObject(ItemIdList, nil, IID_ISHELLFOLDER,
pointer(NodeInfo.ShellFolder));
SHGetFileInfo(PChar(NodeInfo^.AbsoluteIDL), 0, FileInfo, sizeof(FileInfo),
SHGFI_PIDL or SHGFI_SYSICONINDEX);
TreeNode.ImageIndex:=FileInfo.iIcon;
SHGetFileInfo(PChar(NodeInfo^.AbsoluteIDL), 0, FileInfo, sizeof(FileInfo),
SHGFI_PIDL or SHGFI_SYSICONINDEX or SHGFI_OPENICON);
TreeNode.SelectedIndex:=FileInfo.iIcon;
end;
procedure TPathExplorer.EnumFolder(Node: TTreeNode);
var
ShellFolder: IShellFolder;
Objects: IEnumIdList;
ItemIdList: PItemIdList;
DummyResult: ULONG;
Count: integer;
begin
Count:=0;
ShellFolder:=PNodeInfo(Node.Data)^.ShellFolder;
if Succeeded(ShellFolder.EnumObjects(Handle, SHCONTF_FOLDERS, Objects)) then begin
while Objects.Next(1, ItemIdList, DummyResult)=NOERROR do begin
AddSubfolderToNode(Node, ItemIdList);
inc(Count);
end;
if Count=0 then Node.HasChildren:=False;
end;
end;
constructor TPathExplorer.Create(AOwner: TComponent);
var
FileInfo: TSHFileInfo;
DesktopItemIdList: PItemIdList;
begin
inherited Create(AOwner);
parent:=TWinControl(AOwner);
if Succeeded(SHGetMalloc(Allocator)) and Succeeded(SHGetDesktopFolder(Desktop)) then begin
OnExpanding:=TreeExpanding;
OnDeletion:=TreeDeletion;
ReadOnly:=true;
SHGetSpecialFolderLocation(Handle, CSIDL_DESKTOP, DesktopItemIdList);
SysImageList:=SHGetFileInfo(PChar(DesktopItemIdList), 0, FileInfo, sizeof(FileInfo),
SHGFI_PIDL or SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
TreeView_SetImageList(self.Handle, SysImageList, TVSIL_NORMAL);
self.Items.Add(nil,GetShellItemName(Desktop,DesktopItemIdList));
self.Items[0].ImageIndex:=FileInfo.iIcon;
self.Items[0].SelectedIndex:=FileInfo.iIcon;
self.Items[0].Data:=MakeNodeInfo(nil, Desktop, DesktopItemIdList);
self.Items[0].HasChildren:=True;
end;
end;
procedure TPathExplorer.Change(Node: TTreeNode);
var
Path: array[0..MAX_PATH] of char;
NodeInfo: PNodeInfo;
begin
NodeInfo:=PNodeInfo(Node.Data);
if Assigned(NodeInfo) then
if Assigned(NodeInfo.ShellFolder) then begin
SHGetPathFromIdList(NodeInfo^.AbsoluteIDL, Path);
Folder:=StrPas(Path);
end else
Path:='...';
inherited Change(Node);
end;
procedure TPathExplorer.TreeExpanding(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
var
NodeInfo: PNodeInfo;
begin
Screen.Cursor:=crHourGlass;
NodeInfo:=PNodeInfo(Node.Data);
if Assigned(NodeInfo) and not NodeInfo.Expanded then begin
EnumFolder(Node);
NodeInfo.Expanded:=True;
end;
Screen.Cursor:=crDefault;
end;
procedure TPathExplorer.TreeDeletion(Sender: TObject; Node: TTreeNode);
var
NodeInfo: PNodeInfo;
begin
NodeInfo:=PNodeInfo(Node.Data);
if Assigned(NodeInfo) then begin
if (Assigned(NodeInfo.RelativeIDL)) then Allocator.Free(NodeInfo.RelativeIDL);
if (Assigned(NodeInfo.AbsoluteIDL)) then Allocator.Free(NodeInfo.AbsoluteIDL);
Dispose(NodeInfo);
end;
end;
end.
The sample how to use this unit:.........
==========================================
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
uPathExplorer, ExtCtrls, comctrls;
type
TForm1 = class(TForm)
Panel1: TPanel;
procedure FormCreate(Sender: TObject);
private
procedure ExplorerChange(Sender: TObject; Node: TTreeNode);
public
PathExplorer:TPathExplorer;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
PathExplorer:=TPathExplorer.Create(self);
PathExplorer.Align:=alClient;
PathExplorer.OnChange:=ExplorerChange;
end;
procedure TForm1.ExplorerChange(Sender: TObject; Node: TTreeNode);
begin
Panel1.Caption:=PathExplorer.Folder;
end;
end.
]]>