VPF::ShellTreeView и Path - Форум программистов

offline

Дата 17.8.2005, 22:59 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 474
Регистрация: 7.2.2005

Репутация: нет
Всего: 7

Подскажите, что я не то делаю. Я в ShellTreeView хочу програмно поменять путь. Я присваиваю Path новый путь, а ShellTreeView на это не реагирует smile

. Я хочу использовать только стандартные компоненты. Возможно ли в ShellTreeView поменять путь програмно smile

Girder

Дата 17.8.2005, 23:34 (ссылка)

(нет голосов)

Загрузка ...

Лентяй 2

Профиль
Группа: Участник Клуба
Сообщений: 1993
Регистрация: 12.5.2004

Репутация: 31
Всего: 155

Код

procedure TForm1.Button1Click(Sender: TObject);
begin
 ShellTreeView1.Root:='C:\';
 ShellTreeView1.SetFocus;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 ShellTreeView1.Path:='C:\';
 ShellTreeView1.SetFocus;
end;

--------------------

Как слышим, так и пишим.
Истина где-то там...

offline

Дата 18.8.2005, 01:00 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 474
Регистрация: 7.2.2005

Репутация: нет
Всего: 7

Странно, заработало, а до этого не хотело? Может зто из-за того, что я только что установил патч d7_ent_upd1_1.exe?

~FoX~

Дата 18.8.2005, 08:08 (ссылка)

(нет голосов)

Загрузка ...

НЕ рыжий!!!

Профиль
Группа: Участник Клуба
Сообщений: 2819
Регистрация: 8.10.2003
Где: Зеленоград

Репутация: 13
Всего: 68

kirilllius
Врятли, у меня и без пача работало..

--------------------

…множественность никогда не следует полагать без необходимости…

Dufe

Дата 6.9.2005, 12:37 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 34
Регистрация: 23.3.2005

Репутация: нет
Всего: нет

У меня 6-я Delphi, и НЕ РАБОТАЕТ! Root после апдейта срабатывает, но это меня не устраивает. Нужно видеть полностью дерево. А меняю Path безрезультатно. Что делать?

offline

Дата 6.9.2005, 14:36 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 474
Регистрация: 7.2.2005

Репутация: нет
Всего: 7

Перейти на D7

Romero

Дата 16.9.2005, 17:57 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 129
Регистрация: 17.6.2005

Репутация: нет
Всего: 1

Что-нибудь дельное кроме "Перейти на D7" посоветовать в этой ситуации может кто-нить?

offline

Дата 16.9.2005, 18:39 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 474
Регистрация: 7.2.2005

Репутация: нет
Всего: 7

Нет, я когда на D6 сидел, не мог с этим поспорить. Мне педлагали использовать другие компоненты не стандартные т.к. в D6 это наверное баг smile

Albinos_x

Дата 16.9.2005, 19:30 (ссылка)

(нет голосов)

Загрузка ...

Evil Skynet

Профиль
Группа: Комодератор
Сообщений: 3288
Регистрация: 28.5.2004
Где: X-6120400 Y-1 4624650

Репутация: 26
Всего: 108

может стоит опробовать что-нибудь, типа refrech

--------------------

"Кто владеет информацией, тот владеет миром"
Уинстон Черчилль

Romero

Дата 17.9.2005, 11:12 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 129
Регистрация: 17.6.2005

Репутация: нет
Всего: 1

Refresh не сканает. Так же, как и SetFocus.
Нужн другое решение. Очень обидное недоразумение!!!

Это сообщение отредактировал(а) Romero - 17.9.2005, 11:12

Romero

Дата 17.9.2005, 12:41 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 129
Регистрация: 17.6.2005

Репутация: нет
Всего: 1

Вот, нашел ответ:

Цитата

Код

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

Это сообщение отредактировал(а) Girder - 2.10.2005, 11:33

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »