Вот, нашел ответ: | Цитата | | Код | unit ShellListView_2;
type
TForm1 = class(TForm)
ShellComboBox1: TShellComboBox;
ShellTreeView1: TShellTreeView;
ShellListView1: TShellListView;
Button1: TButton;
....
implementation
uses ShellListView_2lib;
...
procedure TForm1.Button4Click(Sender: TObject);
var
Path: string;
begin
Path := 'C:\WINNT\system32\DirectX\Dinput\msprw.png';
if otNonFolders in ShellTreeView1.ObjectTypes then
SetPath(Path, ShellTreeView1)
else SetPath(ExtractFilePath(Path), ShellTreeView1);
ShellTreeView1.SetFocus;
end;
end. |
добавь этот юнит к проекту: | Код | unit ShellListView_2lib;
//наследник от TSuctomShellTreeView
interface
uses
Windows, Classes, ComCtrls, ShellCtrls,
ShlObj, ComObj, Consts, ActiveX;
procedure SetPath(const Value: string; Sender: TObject);
implementation
//====================================================================
function NextPIDL(IDList: PItemIDList): PItemIDList;
begin
Result := IDList;
Inc(PChar(Result), IDList^.mkid.cb);
end;
//--------------------------------------------------------------------
function GetPIDLSize(IDList: PItemIDList): Integer;
begin
Result := 0;
if Assigned(IDList) then
begin
Result := SizeOf(IDList^.mkid.cb);
while IDList^.mkid.cb <> 0 do
begin
Result := Result + IDList^.mkid.cb;
IDList := NextPIDL(IDList);
end;
end;
end;
//--------------------------------------------------------------------
function CreatePIDL(Size: Integer): PItemIDList;
var
Malloc: IMalloc; //uses ActiveX - B.T.
begin
OleCheck(SHGetMalloc(Malloc));
Result := Malloc.Alloc(Size);
if Assigned(Result) then
FillChar(Result^, Size, 0);
end;
//--------------------------------------------------------------------
function CopyPIDL(IDList: PItemIDList): PItemIDList;
var
Size: Integer;
begin
Size := GetPIDLSize(IDList);
Result := CreatePIDL(Size);
if Assigned(Result) then
CopyMemory(Result, IDList, Size); //uses Windows - B.T.
end;
//--------------------------------------------------------------------
procedure StripLastID(IDList: PItemIDList);
var
MarkerID: PItemIDList;
begin
MarkerID := IDList;
if Assigned(IDList) then
begin
while IDList.mkid.cb <> 0 do
begin
MarkerID := IDList;
IDList := NextPIDL(IDList);
end;
MarkerID.mkid.cb := 0;
end;
end;
//--------------------------------------------------------------------
function CreatePIDLList(ID: PItemIDList): TList; //TList uses Classes - B.T.
var
TempID: PItemIDList;
begin
Result := TList.Create;
TempID := ID;
while TempID.mkid.cb <> 0 do
begin
TempID := CopyPIDL(TempID);
Result.Insert(0, TempID); //0 = lowest level PIDL.
StripLastID(TempID);
end;
end;
//--------------------------------------------------------------------
procedure DisposePIDL(PIDL: PItemIDList);
var
MAlloc: IMAlloc;
begin
OLECheck(SHGetMAlloc(MAlloc));
MAlloc.Free(PIDL);
end;
//--------------------------------------------------------------------
procedure DestroyPIDLList(List: TList);
var
I: Integer;
begin
If List = nil then Exit;
for I := 0 to List.Count-1 do
DisposePIDL(List[I]);
List.Free;
end;
//--------------------------------------------------------------------
function DesktopShellFolder: IShellFolder; //uses ShlObj -B.T.
begin
OleCheck(SHGetDesktopFolder(Result)); //OleCheck - uses ComObj - B.T.
end;
//--------------------------------------------------------------------
function FolderExists(FindID: PItemIDList; InNode: TTreeNode): TTreeNode; //TTreeNode uses ComCtrls - B.T.
var
ALevel: Integer;
begin
Result := nil;
ALevel := InNode.Level;
repeat
if DesktopShellFolder.CompareIDs(
0,
FindID,
TShellFolder(InNode.Data).AbsoluteID) = 0 then //TShellFolder uses ShellCtrls - B.T.
begin
Result := InNode;
Exit;
end else
InNode := InNode.GetNext;
until (InNode = nil) or (InNode.Level <= ALevel);
end;
//--------------------------------------------------------------------
function SamePIDL(ID1, ID2: PItemIDList): boolean;
begin
Result := DesktopShellFolder.CompareIDs(0, ID1, ID2) = 0;
end;
//--------------------------------------------------------------------
procedure SetPathFromID(ID: PItemIDList; Sender: TObject);
var
I: Integer;
Pidls: TList;
Temp, Node: TTreeNode;
begin
with Sender as TShellTreeView do begin
//those 2 lines are not important - B.T.
// if (csUpdating in ComponentState) then exit;
// if (csLoading in ComponentState) then exit;
if (SelectedFolder <> nil) and SamePIDL(SelectedFolder.AbsoluteID, ID) then Exit;
// FUpdating := True;
Items.BeginUpdate;
try
Pidls := CreatePIDLList(ID);
try
Node := Items[0];
for I := 0 to Pidls.Count-1 do
begin
Temp := FolderExists(Pidls[I], Node);
if Temp <> nil then
begin
Node := Temp;
Node.Expand(False);
end;
end;
Node := FolderExists(ID, Node);
Selected := Node;
{
//not required - B.T.
if Assigned(Node) then
begin
// if Assigned(FListView) then
// FListView.TreeUpdate(TShellFolder(Node.Data).AbsoluteID);
// if Assigned(FComboBox) then
// FComboBox.TreeUpdate(TShellFolder(Node.Data).AbsoluteID);
if Assigned(ShellListView) then ShellListView.Update;
if Assigned(ShellComboBox) then ShellComboBox.Update;
end;
}
finally
DestroyPIDLList(Pidls);
end;
finally
Items.EndUpdate;
// FUpdating := False;
end;
end;//with Form1.ShellTreeView1
end;
//--------------------------------------------------------------------
procedure SetPath(const Value: string; Sender: TObject);
var
P: PWideChar;
NewPIDL: PItemIDList;
Flags, NumChars: LongWord;
begin
NumChars := Length(Value);
Flags := 0;
P := StringToOleStr(Value);
try
OLECheck(DesktopShellFolder.ParseDisplayName(
0,
nil,
P,
NumChars,
NewPIDL,
Flags)
);
// FUpdating := True;
SetPathFromID(NewPIDL, Sender);
except on EOleSysError do
//SErrorSettingPath - uses Consts - B.T.
raise EInvalidPath.CreateFmt(SErrorSettingPath, [Value]);
end;
// FUpdating := False;
end;
//==========================================================
end. |
|
PS: Взято с http://forum.sources.ru |
. Я хочу использовать только стандартные компоненты. Возможно ли в ShellTreeView поменять путь програмно 
? 