Как показать контекстное меню для конкретного файла?

Previous  Top  Next

    
 

 

 

Code:

////////////////////////////////////////////////////////////////////////////////

//

//  ****************************************************************************

//  * Unit Name : Unit1

//  * Purpose   : Демо отображения системного контекстного меню эксплорера

//  * Author    : Александр (Rouse_) Багель

//  * Version   : 1.00

//  ****************************************************************************

//

 

unit Unit1;

 

interface

 

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls,

// Чтоб все заработало - подключаем вот эти 2 юнита

ShlObj,

ActiveX;

 

type

TForm1 = class(TForm)

   Button1: TButton;

   procedure Button1Click(Sender: TObject);

end;

 

var

Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

// Это для работы самого меню, как оконного элемента

function MenuCallback(Wnd: HWND; Msg: UINT; WParam: WPARAM;

LParam: LPARAM): LRESULT; stdcall;

var

ContextMenu2: IContextMenu2;

begin

case Msg of

   WM_CREATE:

   begin

     ContextMenu2 := IContextMenu2(PCreateStruct(lParam).lpCreateParams);

     SetWindowLong(Wnd, GWL_USERDATA, Longint(ContextMenu2));

     Result := DefWindowProc(Wnd, Msg, wParam, lParam);

   end;

   WM_INITMENUPOPUP:

   begin

     ContextMenu2 := IContextMenu2(GetWindowLong(Wnd, GWL_USERDATA));

     ContextMenu2.HandleMenuMsg(Msg, wParam, lParam);

     Result := 0;

   end;

   WM_DRAWITEM, WM_MEASUREITEM:

   begin

     ContextMenu2 := IContextMenu2(GetWindowLong(Wnd, GWL_USERDATA));

     ContextMenu2.HandleMenuMsg(Msg, wParam, lParam);

     Result := 1;

   end;

else

   Result := DefWindowProc(Wnd, Msg, wParam, lParam);

end;

end;

 

// Это для создания самого меню, как оконного элемента

function CreateMenuCallbackWnd(const ContextMenu: IContextMenu2): HWND;

const

IcmCallbackWnd = 'ICMCALLBACKWND';

var

WndClass: TWndClass;

begin

FillChar(WndClass, SizeOf(WndClass), #0);

WndClass.lpszClassName := PChar(IcmCallbackWnd);

WndClass.lpfnWndProc := @MenuCallback;

WndClass.hInstance := HInstance;

Windows.RegisterClass(WndClass);

Result := CreateWindow(IcmCallbackWnd, IcmCallbackWnd, WS_POPUPWINDOW, 0,

   0, 0, 0, 0, 0, HInstance, Pointer(ContextMenu));

end;

 

procedure GetProperties(Path: String; MousePoint: TPoint; WC: TWinControl);

var

CoInit, AResult: HRESULT;

CommonDir, FileName: String;

Desktop, ShellFolder: IShellFolder;

pchEaten, Attr: Cardinal;

PathPIDL: PItemIDList;

FilePIDL: array [0..1] of PItemIDList;

ShellContextMenu: HMenu;

ICMenu: IContextMenu;

ICMenu2: IContextMenu2;

PopupMenuResult: BOOL;

CMD: TCMInvokeCommandInfo;

M: IMAlloc;

ICmd: Integer;

CallbackWindow: HWND;

begin

// Первичная инициализация

ShellContextMenu := 0;

Attr := 0;

PathPIDL := nil;

CallbackWindow := 0;

CoInit := CoInitializeEx(nil, COINIT_MULTITHREADED);

try

   // Получаем пути и имя фала

   CommonDir := ExtractFilePath(Path);

   FileName := ExtractFileName(Path);

   // Получаем указатель на интерфейс рабочего стола

   if SHGetDesktopFolder(Desktop) <> S_OK then

     RaiseLastOSError;

   // Если работаем с папкой

   if FileName = '' then

   begin

     // Получаем указатель на папку "Мой компьютер"

     if (SHGetSpecialFolderLocation(0, CSIDL_DRIVES, PathPIDL) <> S_OK) or

       (Desktop.BindToObject(PathPIDL,  nil,  IID_IShellFolder,

         Pointer(ShellFolder)) <> S_OK) then RaiseLastOSError;

     // Получаем указатель на директорию

     ShellFolder.ParseDisplayName(WC.Handle, nil, StringToOleStr(CommonDir),

       pchEaten, FilePIDL[0], Attr);

     // Получаем указатель на контектсное меню папки

     AResult := ShellFolder.GetUIObjectOf(WC.Handle, 1, FilePIDL[0],

       IID_IContextMenu, nil, Pointer(ICMenu));

   end

   else

   begin

     // Получаем указатель на папку "Мой компьютер"

     if (Desktop.ParseDisplayName(WC.Handle, nil, StringToOleStr(CommonDir),

       pchEaten, PathPIDL, Attr) <> S_OK) or

       (Desktop.BindToObject(PathPIDL, nil, IID_IShellFolder,

         Pointer(ShellFolder)) <> S_OK) then RaiseLastOSError;

     // Получаем указатель на файл

     ShellFolder.ParseDisplayName(WC.Handle, nil, StringToOleStr(FileName),

       pchEaten, FilePIDL[0], Attr);

     // Получаем указатель на контектсное меню файла

     AResult := ShellFolder.GetUIObjectOf(WC.Handle, 1, FilePIDL[0],

       IID_IContextMenu, nil, Pointer(ICMenu));

   end;

 

   // Если указатель на конт. меню есть, делаем так:

   if Succeeded(AResult) then

   begin

     ICMenu2 := nil;

     // Создаем меню

     ShellContextMenu := CreatePopupMenu;

     // Производим его наполнение

     if Succeeded(ICMenu.QueryContextMenu(ShellContextMenu, 0,

       1, $7FFF, CMF_EXPLORE)) and

       Succeeded(ICMenu.QueryInterface(IContextMenu2, ICMenu2)) then

         CallbackWindow := CreateMenuCallbackWnd(ICMenu2);

     try

       // Показываем меню

       PopupMenuResult := TrackPopupMenu(ShellContextMenu, TPM_LEFTALIGN or TPM_LEFTBUTTON

         or TPM_RIGHTBUTTON or TPM_RETURNCMD,

         MousePoint.X, MousePoint.Y, 0, CallbackWindow, nil);

     finally

       ICMenu2 := nil;

     end;

     // Если был выбран какой либо пункт меню:

     if PopupMenuResult then

     begin

       // Индекс этого пункта будет лежать в ICmd

       ICmd := LongInt(PopupMenuResult) - 1;

       // Заполняем структуру TCMInvokeCommandInfo

       FillChar(CMD, SizeOf(CMD), #0);

       with CMD do

       begin

         cbSize := SizeOf(CMD);

         hWND := WC.Handle;

         lpVerb := MakeIntResource(ICmd);

         nShow := SW_SHOWNORMAL;

       end;

       // Выполняем InvokeCommand с заполненной структурой

       AResult := ICMenu.InvokeCommand(CMD);

       if AResult <> S_OK then RaiseLastOSError;

      end;

   end;

finally

   // Освобождаем занятые ресурсы чтобы небыло утечки памяти

   if FilePIDL[0] <> nil then

   begin

     // Для освобождения использем IMalloc

     SHGetMAlloc(M);

     if M <> nil then

       M.Free(FilePIDL[0]);

     M:=nil;

   end;

   if PathPIDL <> nil then

   begin

     SHGetMAlloc(M);

     if M <> nil then

       M.Free(PathPIDL);

     M:=nil;

   end;

   if ShellContextMenu <>0 then

     DestroyMenu(ShellContextMenu);

   if CallbackWindow <> 0 then

     DestroyWindow(CallbackWindow);

   ICMenu := nil;

   ShellFolder := nil;

   Desktop := nil;

   if CoInit = S_OK then CoUninitialize;

end;

end;

 

// Пример использования

procedure TForm1.Button1Click(Sender: TObject);

var

pt: TPoint;

begin

GetCursorPos(pt);

GetProperties('E:\Guardant\INSTDRV.INI', pt, Self);

end;

 

end.

 

Взято из http://forum.sources.ru

Автор: Rouse_

 

©Drkb::03146