Перейдем теперь к процедуре ComboBoxlCloseUp, срабатывающей после выбора пользователем строки из списка ComboBoxl. В этот список во время проектирования занесены строки:

Корзина

Панель управления Рабочий стол Мой компьютер Шрифты

Сетевые файлы Сетевое окружение Мои документы Принтеры

Программы из главного меню Недавние документы Переслать (Send to) Пуск

Автозапуск Шаблоны

В начале процедуры ComboBoxlCloseUp анализируется индекс списка и формируется переменная nFolder, передаваемая в качестве второго аргумента в описанную ранее функцию SHGetSpecialFolderLocation, возвращающую в переменную pidl указатель PIDL выбранной пользователем системной папки. Этот PIDL относится к корневой папке. Поэтому именно для этой папки (т.е. для AFolder[0]) вызывается рассмотренный в предыдущей процедуре метод BindToObject. Он возвращает в переменную ISF1 интерфейс затребованной папки. А затем все той же процедурой ListOfFolder отображается в окне Memol список элементов папки. Только при этом задается LListBox = false, чтобы не испортить списки, хранящиеся в ListBoxl и в Apidl.

Последняя процедура приведенного кода ApplicationEventslShowHint является вспомогательной и обеспечивает отображение во всплывающем ярлычке длинного текста выделенной строки списка ListBoxl, который может быть не виден целиком в окне списка. Описание подобных процедур см. в разд. 5.1, в гл. 5.

Приведенный пример показывает, как можно исследовать содержимое обычных и виртуальных папок.

Рассмотренный код относился к приложению VCL Win32. Ниже приведен аналогичный код для VCL .NET.

unit UIShellFolder; interface

uses ...ShlObj, System.Runtime.InteropServices;

type

TForml = class(TForm) private

function NameOfFolder(ShellFolder: IShellFolder;
pidl: IntPtr): string;
procedure ListOfFolder(ShellFolder: IShellFolder;
Flags: Cardinal = SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN);
end;

var

Forml: TForml; implementation {$R *.dfm}

var Apidl: array of IntPtr; // массив PIDL текущей папки

AFolder: array of IShellFolder;
// массив иерархии папок LListBox: boolean = true;
function TForml.NameOfFolder(ShellFolder: IShellFolder;
pidl: IntPtr): string;
var lpName: TStrRet;
grfFlags: DWORD;
ItemID: TSHItemID;
A: string;

begin

case RadioGroupl.Itemlndex of

0: grfFlags := SHGDN_NORMAL;
1: grfFlags := SHGDN_INFOLDER;
2: grfFlags := SHGDN_FORPARSING;
end;

ShellFolder.GetDisplayNameOf(pidl,grfFlags,lpName); case lpName.uType of STRRET_WSTR: Result := Marshal.PtrToStringAuto(lpName.pOleStr); STRRET__OFFSET: begin

Marshal.PtrToStructure(pidl, ItemID);
A := Marshal.PtrToStringAuto(ItemID.abID);
Result := A[lpName.uOffset - sizeof(ItemID.cb)];
end;
STRRET_CSTR: Result := Marshal.PtrToStringAuto(lpName.cStr);
end;
end;
procedure TForml.ListOfFolder(ShellFolder: IShellFolder;
Flags: Cardinal = SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN);
var pidl: array[0..0] of IntPtr;
Num: Cardinal;
Enum: IEnumlDList;
begin if LListBox then begin SetLength(Apidl,0);
ListBoxl.Clear;
ListBoxl.Items.Add('Назад1);
end;
Memol.Clear;
ShellFolder.EnumObjects(Application.Handle, Flags, Enum);

while Enum.Next(1,pidl,Num) = S_OK do

begin

Memol.Lines.Add(NameOfFolder(ShellFolder, pidl[0]));

if LListBox then begin

SetLength(Apidl, High(Apidl) + 2);
Apidl[High(Apidl)] := pidl[0];
ListBoxl.Items.Add(NameOfFolder(ShellFolder, pidl[0]));
end;
end;
end;

procedure TForml.FormCreate(Sender: TObject); begin

SetLength(AFolder, 1);
if(SHGetDesktopFolder(AFolder[0]) NOERROR) then ShowMessage(1 Корневая папка недоступна') else ListOfFolder(AFolder[0]);
end;
procedure TForml.ListBoxlDblClick(Sender: TObject);
var pidl: IntPtr;

Flags: UINT; begin

if ListBoxl.Itemlndex > 0 then begin

pidl := Apidl[ListBoxl.Itemlndex - 1] ;
Flags := SFGAO_FOLDER or SFGAO_FILESYSANCESTOR;
AFolder[High(AFolder)] .GetAttributesOf (1, pidl, Flags);

if ((SFGAO_FOLDER and Flags) 0) and

((SFGAO_FILESYSANCESTOR and Flags) 0)

then begin

Label2.Caption := Label2.Caption + f\f +

NameOfFolder(AFolder[High(AFolder)], pidl); SetLength(AFolder, High(AFolder) +2); AFolder[High(AFolder) - 1].BindToObject(

pidl, nil, TGuid.Create(IID__IShellFolder), AFolder[High(AFolder)]); ListOfFolder(AFolder[High(AFolder)]); end

else ShowMessage('"' + NameOfFolder(AFolder[High (AFolder)], pidl) + '"не папка');

end

// если выбрана строка "Назад" else if High(AFolder) > 0 then begin

SetLength(AFolder, High(AFolder));
Label2.Caption := Copy(Label2.Caption, 1, LastDelimiter('\', Label2.Caption) - 1);

ListOfFolder(AFolder[High(AFolder)]); end

else ListOfFolder(AFolder[0]);
end;
procedure TForml.ComboBoxlCloseUp(Sender: TObject);
var nFolder: Integer;
pidl: IntPtr;

ISF1: IShellFolder; begin

case ComboBoxl.Itemlndex of

0: nFolder := CSIDL_BITBUCKET;
1: nFolder := CSIDL_CONTROLS;
2: nFolder := CSIDL_DESKTOPDIRECTORY;
3: nFolder := CSIDL_DRIVES;
4: nFolder := CSIDL_FONTS;
5: nFolder := CSIDL_NETHOOD;
6: nFolder := CSIDL_NETWORK;
7: nFolder := CSIDL_PERSONAL;
8: nFolder := CSIDL_PRINTERS;
9: nFolder := CSIDL_PROGRAMS;
10: nFolder := CSIDL_RECENT;
11: nFolder := CSIDL_SENDTO;
12: nFolder := CSIDL_STARTMENU;
13: nFolder := CSIDL_STARTUP;
14: nFolder := CSIDL_TEMPLATES;
end;
SHGetSpecialFolderLocation(Handle, nFolder, pidl);
AFolder[0].BindToObject(pidl, nil, TGuid.Create(IID_IShellFolder), ISF1);
LListBox := false;
ListOfFolder(ISF1);
LListBox := true;
end;
procedure TForml.ApplicationEventslShowHint(var HintStr: String;

var CanShow: Boolean; var Hintlnfo: THintlnfo); begin

if (Hintlnfo.HintControl = ListBoxl) and (ListBoxl.Itemlndex >= 0) then if (Labell.Canvas.TextWidth(ListBoxl.Items[ListBoxl.Itemlndex])

>

ListBoxl.ClientWidth) then begin

HintStr:=ListBoxl.Items[ListBoxl.Itemlndex];
ApplicationEventsl.CancelDispatch;
end;
end;

Жирным шрифтом в коде выделены строки, отличные от рассмотренных ранее. Основные из этих изменений были рассмотрены ранее, так что вряд ли требуются дополнительные пояснения.

10.1 Информация о дисках || Оглавление || 10.3 Преобразование PIDL в путь


⇐ Предыдущая страница|

Приемы программирования в Delphi на основе VCL



Новости за месяц

  • Сентябрь
    2020
  • Пн
  • Вт
  • Ср
  • Чт
  • Пт
  • Сб
  • Вс