Главная » Delphi » Обработчики контекстных меню

0

 позволяют добавлять новые  пункты  в контекст ные меню,  связанные с файловыми объектами оболочки. Пример контекстного меню для исполняемого файла  показан на рис. 16.8.

Рис. 16.8. Контекстное меню исполняемого файлаДействие расширений оболочки, связанных с контекстными меню,  основано на реализации интерфейсов IShellExtInit и IContextMenu. В данном  примере эти интерфейсы реализованы для создания обработчика контекстного меню  для файлов BPL (Borland Package  Library). В контекстное меню для файлов данного типа будет до бавлена  команда, позволяющая получить информацию о содержащемся в файле паке те. Объект обработчика контекстного меню назовем TContextMenu и, подобно обра ботчику  копирования, сделаем  класс TContextMenu производным от класса TComOb- ject.

Интерфейс IShellExtInit

Для инициализации расширения оболочки используется интерфейс IShellEx- tInit, который определен в модуле ShlObj следующим образом:

type

IShellExtInit = interface(IUnknown)

[‘{000214E8-0000-0000-C000-000000000046}’]

function Initialize(pidlFolder: PItemIDList;

lpdobj: IDataObject;

hKeyProgID: HKEY): HResult; stdcall;

end;

В этом интерфейсе использован единственный метод — Initialize() — который и инициализирует обработчик контекстного меню.  Ниже  описаны параметры данно го метода.

Параметр pidlFolder является  указателем на  структуру  PItemIDList (список идентификаторов элементов) для папки, содержащей элемент, к которому относится отображаемое контекстное меню.  Параметр lpdobj содержит объект интерфейса IDataObject, используемый для получения объектов, над которыми выполняется действие. Параметр  hKeyProgID содержит ключ  системного реестра  для  объекта файлового типа или для папки.

Реализация метода  Initialize() приведена ниже.  На  первый взгляд  этот  код кажется довольно сложным, однако  на самом деле все сводится к трем  действиям: вы зову функции lpobj.GetData() для получения данных  из интерфейса IDataObject и двум вызовам функции DragQueryFile() (один —  для получения количества фай лов,  а другой — для получения имени  файла). Имя  файла  сохраняется в поле  FFile- Name объекта lpdobj.

function TContextMenu.Initialize(pidlFolder: PItemIDList;

lpdobj: IDataObject; hKeyProgID: HKEY): HResult;

var

Medium: TStgMedium;

FE: TFormatEtc;

begin

try

// Аварийный выход из функции, если указатель на объект lpdobj

// равен значению nil.

if lpdobj = nil then begin

Result := E_FAIL;

Exit;

end;

with FE do beginend;

cfFormat := CF_HDROP;

ptd := nil;

dwAspect := DVASPECT_CONTENT;

lindex := -1;

tymed := TYMED_HGLOBAL;

end;

// Вернуть данные, на которые ссылается указатель

// типа IDataObject, в формате CF_HDROP

Result := lpdobj.GetData(FE, Medium);

if Failed(Result) then Exit;

try

// Если выбран только один файл, считать его имя и сохранить в

// поле szFile. В противном случае аварийное завершение

// работы функции.

if DragQueryFile(Medium.hGlobal, $FFFFFFFF, nil, 0) = 1 then

begin

DragQueryFile(Medium.hGlobal, 0, FFileName,

SizeOf(FFileName));

Result := NOERROR;

end

else

Result := E_FAIL;

finally

ReleaseStgMedium(medium);

end;

except

Result := E_UNEXPECTED;

end;

Интерфейс IContextMenu

Интерфейс IContextMenu используется для управления контекстным меню,  ассо циированным с данным  типом  файлов в системной оболочке. Этот  интерфейс также определен в модуле ShlObj следующим образом:

type

IContextMenu = interface(IUnknown)

[‘{000214E4-0000-0000-C000-000000000046}’]

function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,

idCmdLast, uFlags: UINT): HResult; stdcall;

function InvokeCommand(var lpici:

TCMInvokeCommandInfo): HResult; stdcall;

function GetCommandString(idCmd, uType: UINT;

pwReserved: PUINT; pszName: LPSTR;

cchMax: UINT): HResult; stdcall;

end;

После  инициализации обработчика, через интерфейс IShellExtInit, вызывает ся метод IContextMenu.QueryContextMenu(). В список  параметров, передаваемых методу, входит  обработчик меню,  индекс, соответствующий первому  пункту меню, минимальное и  максимальное значения  идентификаторов  пунктов   меню,   а  также флаги атрибутов меню. Ниже  приведена реализация метода в объекте TContextMenu.Этот  метод  используется для добавления пункта  меню  Package info в обработчик ме ню, передаваемый с помощью параметра Menu (заметьте, что значение, возвращаемое функцией QueryContextMenu(), на единицу  больше  индекса  пункта,  который был введен последним).

function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult;

begin

FMenuIdx := indexMenu;

// Добавить в контекстное меню один пункт.

InsertMenu (Menu, FMenuIdx, MF_STRING or MF_BYPOSITION,

idCmdFirst, ‘Package Info…’);

// Вернуть индекс последнего добавленного элемента + 1

Result := FMenuIdx + 1;

end;

Следующий  вызываемый оболочкой метод  (GetCommandString()) предназначен для получения независимой от языка  командной строки или  справочной строки для конкретного пункта меню. В список  параметров, передаваемых методу, входит  номер пункта меню,  флаги, указывающие на тип получаемой информации, зарезервирован ный  параметр, строковый буфер  и его размер. Приведенная ниже  реализация этого метода  в объекте TContextMenu отображает справочную строку  для данного пункта меню.

function TContextMenu.GetCommandString(idCmd, uType: UINT;

pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HRESULT;

begin

Result := S_OK;

try

// Удостовериться, что индекс меню правильный и оболочка

// запросила строку подсказки

if (idCmd = FMenuIdx) and ((uType and GCS_HELPTEXT) <> 0) then

// Возвратить строку подсказки для данного пункта меню

StrLCopy(pszName,

‘Get information for the selected package.’,

cchMax)

else

Result := E_INVALIDARG;

except

Result := E_UNEXPECTED;

end;

end;

Метод  InvokeCommand() вызывается каждый  раз  при  щелчке  на  новом  пункте меню.  В  качестве параметра этому  методу  передается  запись   TCMInvokeCommand Info, которая определена в модуле ShlObj следующим образом:

type

PCMInvokeCommandInfo = ^TCMInvokeCommandInfo;

TCMInvokeCommandInfo = packed record

{ Должно иметь значение SizeOf(TCMInvokeCommandInfo). }

cbSize: DWORD;

{ Любая комбинация CMIC_MASK_* }fMask: DWORD;

{ При отсутствии окна-владельца принимает значение NULL. }

hwnd: HWND;

{ Любая строка AKEINTRESOURCE(idOffset). }

lpVerb: LPCSTR;

{ При отсутствии параметра принимает значение NULL }

lpParameters: LPCSTR;

{ При отсутствии заданной папки принимает значение NULL. }

lpDirectory: LPCSTR;

{ Одно из значений SW_ функции API ShowWindow(). }

nShow: Integer;

dwHotKey: DWORD;

hIcon: THandle;

end;

Младшее слово (два байта) поля lpVerb будет содержать индекс выбранного пунк

та меню. Ниже  приведена реализация этого метода.

function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;

begin

Result := S_OK;

try

// Удостовериться, что вызов осуществляется не приложением

if HiWord(Integer(lpici.lpVerb)) <> 0 then begin

Result := E_FAIL;

Exit;

end;

// Выполнить команду, определенную в lpici.lpVerb. Если

// передан недопустимый номер аргумента, то возвратить

// статус E_INVALIDARG.

if LoWord(lpici.lpVerb) = FMenuIdx then

ExecutePackInfoApp(FFileName, lpici.hwnd)

else

Result := E_INVALIDARG;

except

MessageBox(lpici.hwnd, ‘Error obtaining package information.’,

‘Error’, MB_OK or MB_ICONERROR);

Result := E_FAIL;

end;

end;

Если все проходит успешно,  то с помощью функции ExecutePackInfoApp() вы зывается приложение PackInfo.exe, отображающее разного рода  информацию о пакете. Здесь  данное  приложение не рассматривается, но информация по этой  теме приведена в главе  13, “

Регистрация

В системном реестре обработчики контекстного меню должны  регистрироваться в следующей ветви:

HKEY_CLASSES_ROOT\<тип файла>\shellex\ContextMenuHandlers

Как и в случае  обработчика копирования, возможность регистрации DLL контек стного  меню  реализована с помощью потомка объекта TComObject. Код модуля,  со держащего объект TContextMenu, приведен в листинге 16.10. На  рис. 16.9 показано контекстное меню для файла  .bpl с новым  пунктом,  а на рис. 16.10 представлен вид окна программы PackInfo.exe, вызываемой обработчиком контекстного меню.

Рис. 16.9. Обработчик контекстного меню в действии

Рис. 16.10. Получение инфор мации о пакете с помощью об работчика контекстного меню

Листинг 16.10. ContMain.pas — главный модуль реализации обработчика контекстного меню

unit ContMain;

interface

uses Windows, ComObj, ShlObj, ActiveX;

type

TContextMenu = class(TComObject, IContextMenu, IShellExtInit)

private

FFileName: array[0..MAX_PATH] of char;

FMenuIdx: UINT;

protected

// Методы интерфейса IContextMenu

function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,

idCmdLast, uFlags: UINT): HResult; stdcall;

function InvokeCommand(var lpici:

TCMInvokeCommandInfo): HResult; stdcall;

function GetCommandString(idCmd, uType: UINT;

pwReserved: PUINT; pszName: LPSTR;

cchMax: UINT): HResult; stdcall;

// Методы интерфейса IShellExtInit

function Initialize(pidlFolder: PItemIDList;

lpdobj: IDataObject; hKeyProgID: HKEY): HResult;

reintroduce; stdcall;

end;

TContextMenuFactory = class(TComObjectFactory)

protected

function GetProgID: string; override;

procedure ApproveShellExtension(Register: Boolean;

const ClsID: string); virtual;

public

procedure UpdateRegistry(Register: Boolean); override;

end;

implementation

uses ComServ, SysUtils, ShellAPI, Registry, Math;

procedure ExecutePackInfoApp(const FileName: string; ParentWnd: HWND);

const

SPackInfoApp = ‘%sPackInfo.exe';

SCmdLine = ‘"%s" %s';

SErrorStr = ‘Failed to execute PackInfo:’#13#10#13#10;

var

PI: TProcessInformation;

SI: TStartupInfo;

ExeName, ExeCmdLine: string;Buffer: array[0..MAX_PATH] of char;

begin

// Получить папку данной DLL. Предполагаем, что исполняемый

// файл (EXE) находится в этой же папке.

GetModuleFileName(HInstance, Buffer, SizeOf(Buffer));

ExeName := Format(SPackInfoApp, [ExtractFilePath(Buffer)]);

ExeCmdLine := Format(SCmdLine, [ExeName, FileName]);

FillChar(SI, SizeOf(SI), 0);

SI.cb := SizeOf(SI);

if not CreateProcess(PChar(ExeName), PChar(ExeCmdLine), nil,

nil, False, 0, nil, nil, SI, PI) then

MessageBox(ParentWnd, PChar(SErrorStr +

SysErrorMessage(GetLastError)), ‘Error’,

MB_OK or MB_ICONERROR);

end;

{ TContextMenu }

{ TContextMenu.IContextMenu }

function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult;

begin

FMenuIdx := indexMenu;

// Добавить в контекстное меню один пункт.

InsertMenu (Menu, FMenuIdx, MF_STRING or MF_BYPOSITION,

idCmdFirst, ‘Package Info…’);

// Вернуть индекс последнего добавленного элемента + 1

Result := FMenuIdx + 1;

end;

function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;

begin

Result := S_OK;

try

// Удостовериться, что вызов осуществляется не приложением

if HiWord(Integer(lpici.lpVerb)) <> 0 then begin

Result := E_FAIL;

Exit;

end;

// Выполнить команду, определенную в lpici.lpVerb. Если

// передан недопустимый номер аргумента, то возвратить

// статус E_INVALIDARG.

if LoWord(lpici.lpVerb) = FMenuIdx then

ExecutePackInfoApp(FFileName, lpici.hwnd)

else

Result := E_INVALIDARG;

except

MessageBox(lpici.hwnd, ‘Error obtaining package information.’,

‘Error’, MB_OK or MB_ICONERROR);

Result := E_FAIL;

end;end;

function TContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HRESULT;

const

SCmdStrA: String = ‘Get information for the selected package.';

SCmdStrW: WideString =

‘Get information for the selected package.';

begin

Result := S_OK;

try

// Удостовериться, что индекс меню правильный, и оболочка

// запросила строку подсказки

if (idCmd = FMenuIdx) and ((uType and GCS_HELPTEXT) <> 0) then

begin         // Возвратить строку подсказки для данного пункта меню

if Win32MajorVersion >= 5 then

// Обработать как unicode для Win2k или выше

Move(SCmdStrW[1], pszName^,

Min(cchMax, Length(SCmdStrW) + 1) * SizeOf(WideChar))

else                             // В противном случае как ANSI

StrLCopy(pszName, PChar(SCmdStrA), Min(cchMax,

Length(SCmdStrA) + 1));

end else

Result := E_INVALIDARG;

except

Result := E_UNEXPECTED;

end;

end;

{ TContextMenu.IShellExtInit }

function TContextMenu.Initialize(pidlFolder: PItemIDList;

lpdobj: IDataObject; hKeyProgID: HKEY): HResult;

var

Medium: TStgMedium;

FE: TFormatEtc;

begin

try

// Аварийный выход из функции, если указатель на объект lpdobj

// равен значению nil.

if lpdobj = nil then begin

Result := E_FAIL;

Exit;

end;

with FE do begin

cfFormat := CF_HDROP;

ptd := nil;

dwAspect := DVASPECT_CONTENT;

lindex := -1;

tymed := TYMED_HGLOBAL;

end;// Вернуть данные, на которые ссылается указатель

// типа IDataObject, в формате CF_HDROP.

Result := lpdobj.GetData(FE, Medium);

if Failed(Result) then Exit;

try

// Если выбран только один файл, считать его имя и сохранить в

// поле szFile. В противном случае аварийное завершение

// работы функции.

if DragQueryFile(Medium.hGlobal, $FFFFFFFF, nil, 0) = 1 then

begin

DragQueryFile(Medium.hGlobal, 0, FFileName,

SizeOf(FFileName));

Result := NOERROR;

end

else

Result := E_FAIL;

finally

ReleaseStgMedium(medium);

end;

except

Result := E_UNEXPECTED;

end;

end;

{ TContextMenuFactory }

function TContextMenuFactory.GetProgID: string;

begin

// Для расширения оболочки, управляющего работой контекстного

// меню, идентификатор программы ProgID не нужен.

Result := ”;

end;

procedure TContextMenuFactory.UpdateRegistry(Register: Boolean);

var

ClsID: string;

begin

ClsID := GUIDToString(ClassID);

inherited UpdateRegistry(Register);

ApproveShellExtension(Register, ClsID);

if Register then begin

// Необходимо зарегистрировать тип файла .bpl

CreateRegKey(‘.bpl’, ”, ‘BorlandPackageLibrary’);

// Регистрация данной DLL в качестве обработчика контекстного

// меню для файлов .bpl.

CreateRegKey(

‘BorlandPackageLibrary\shellex\ContextMenuHandlers\’ +

ClassName, ”, ClsID);

end

else begin

DeleteRegKey(‘.bpl’);

DeleteRegKey(

‘BorlandPackageLibrary\shellex\ContextMenuHandlers\’ +

end;

end;

ClassName);procedure TContextMenuFactory.ApproveShellExtension( Register: Boolean; const ClsID: string);

// Этот элемент системного реестра необходим для корректной работы

// расширения под управлением Windows NT.

const

SApproveKey = ‘SOFTWARE\Microsoft\Windows\CurrentVersion\

?Shell Extensions\Approved';

begin

with TRegistry.Create do

try

RootKey := HKEY_LOCAL_MACHINE;

if not OpenKey(SApproveKey, True) then Exit;

if Register then WriteString(ClsID, Description)

else DeleteValue(ClsID);

finally

Free;

end;

end;

const

CLSID_CopyHook: TGUID ='{7C5E74A0-D5E0-11D0-A9BF-E886A83B9BE5}';

initialization

TContextMenuFactory.Create(ComServer, TContextMenu,

CLSID_CopyHook, ‘DDG_ContextMenu’,

‘DDG Context Menu Shell Extension Example’,

ciMultiInstance, tmApartment);

end.

Источник: Тейксейра, Стив, Пачеко, Ксавье.   Borland Delphi 6. Руководство разработчика. : Пер.  с англ. — М. : Издательский дом “Вильямс”, 2002. —  1120 с. : ил. — Парал. тит. англ.

По теме:

  • Комментарии