delphi实现调用Windows系统右键菜单
使用Delphi做网盘的时候，有一个需求就是网盘文件的右键菜单要调用系统资源管理器的右键菜单，之前见过几款桌面图标管理软件实现了这个功能，这里把网上收集到的解决方法分享出来，原文连接：
http://www.cnblogs.com/Lucky2011/archive/2011/04/08/2009486.html
关键代码如下：
unit PopupMenuShell;
interface
uses
Windows, Messages, SysUtils, StrUtils, ComObj, ShlObj, ActiveX;
function DisplayContextMenu(const Handle: THandle; const FileName: string; Pos: TPoint): Boolean;
implementation
type
TUnicodePath = array [0 .. MAX_PATH - 1] of WideChar;
const
ShenPathSeparator = '\';
Function String2PWideChar(const s: String): PWideChar;
begin
if s = '' then
begin
result := nil;
exit;
end;
result := AllocMem((Length(s) + 1) * sizeOf(WideChar));
StringToWidechar(s, result, Length(s) * sizeOf(WideChar) + 1);
end;
function PidlFree(var IdList: PItemIdList): Boolean;
var
Malloc: IMalloc;
begin
result := False;
if IdList = nil then
result := True
else
begin
if Succeeded(SHGetMalloc(Malloc)) and (Malloc.DidAlloc(IdList) > 0) then
begin
Malloc.Free(IdList);
IdList := nil;
result := True;
end;
end;
end;
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;
function DisplayContextMenuPidl(const Handle: HWND; const Folder: IShellFolder; Item: PItemIdList; Pos: TPoint)
: Boolean;
var
Cmd: Cardinal;
ContextMenu: IContextMenu;
ContextMenu2: IContextMenu2;
Menu: HMENU;
CommandInfo: TCMInvokeCommandInfo;
CallbackWindow: HWND;
begin
result := False;
if (Item = nil) or (Folder = nil) then
exit;
Folder.GetUIObjectOf(Handle, 1, Item, IID_IContextMenu, nil, Pointer(ContextMenu));
if ContextMenu <> nil then
begin
Menu := CreatePopupMenu;
if Menu <> 0 then
begin
if Succeeded(ContextMenu.QueryContextMenu(Menu, 0, 1, $7FFF, CMF_EXPLORE)) then
begin
CallbackWindow := 0;
if Succeeded(ContextMenu.QueryInterface(IContextMenu2, ContextMenu2)) then
CallbackWindow := CreateMenuCallbackWnd(ContextMenu2);
Cmd := Cardinal(TrackPopupMenu(Menu, TPM_LEFTALIGN or TPM_LEFTBUTTON or TPM_RIGHTBUTTON or TPM_RETURNCMD, Pos.X,
Pos.Y, 0, CallbackWindow, nil));
if Cmd <> 0 then
begin
FillChar(CommandInfo, sizeOf(CommandInfo), #0);
CommandInfo.cbSize := sizeOf(TCMInvokeCommandInfo);
CommandInfo.HWND := Handle;
CommandInfo.lpVerb := MakeIntResourceA(Cmd - 1);
CommandInfo.nShow := SW_SHOWNORMAL;
result := Succeeded(ContextMenu.InvokeCommand(CommandInfo));
end;
if CallbackWindow <> 0 then
DestroyWindow(CallbackWindow);
end;
DestroyMenu(Menu);
end;
end;
end;
function PathAddSeparator(const Path: string): string;
begin
result := Path;
if (Length(Path) = 0) or (AnsiLastChar(Path) <> ShenPathSeparator) then
result := Path + ShenPathSeparator;
end;
function DriveToPidlBind(const DriveName: string; out Folder: IShellFolder): PItemIdList;
var
Attr: ULONG;
Eaten: ULONG;
DesktopFolder: IShellFolder;
Drives: PItemIdList;
Path: TUnicodePath;
begin
result := nil;
if Succeeded(SHGetDesktopFolder(DesktopFolder)) then
begin
if Succeeded(SHGetSpecialFolderLocation(0, CSIDL_DRIVES, Drives)) then
begin
if Succeeded(DesktopFolder.BindToObject(Drives, nil, IID_IShellFolder, Pointer(Folder))) then
begin
MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PAnsiChar(AnsiString(PathAddSeparator(DriveName))), -1, Path,
MAX_PATH);
if Failed(Folder.ParseDisplayName(0, nil, Path, Eaten, result, Attr)) then
Folder := nil;
end;
end;
PidlFree(Drives);
end;
end;
function PathToPidlBind(const FileName: string; out Folder: IShellFolder): PItemIdList;
var
Attr, Eaten: ULONG;
PathIdList: PItemIdList;
DesktopFolder: IShellFolder;
Path, ItemName: PWideChar;
s1, s2: string;
begin
result := nil;
s1 := ExtractFilePath(FileName);
s2 := ExtractFileName(FileName);
Path := String2PWideChar(s1);
ItemName := String2PWideChar(s2);
if Succeeded(SHGetDesktopFolder(DesktopFolder)) then
begin
if Succeeded(DesktopFolder.ParseDisplayName(0, nil, Path, Eaten, PathIdList, Attr)) then
begin
if Succeeded(DesktopFolder.BindToObject(PathIdList, nil, IID_IShellFolder, Pointer(Folder))) then
begin
if Failed(Folder.ParseDisplayName(0, nil, ItemName, Eaten, result, Attr)) then
begin
Folder := nil;
result := DriveToPidlBind(FileName, Folder);
end;
end;
PidlFree(PathIdList);
end
else
result := DriveToPidlBind(FileName, Folder);
end;
FreeMem(Path);
FreeMem(ItemName);
end;
function DisplayContextMenu(const Handle: THandle; const FileName: string; Pos: TPoint): Boolean;
var
ItemIdList: PItemIdList;
Folder: IShellFolder;
begin
result := False;
ItemIdList := PathToPidlBind(FileName, Folder);
if ItemIdList <> nil then
begin
result := DisplayContextMenuPidl(Handle, Folder, ItemIdList, Pos);
PidlFree(ItemIdList);
end;
end;
end.
调用方法：
Pascal
var
Pos: TPoint;
begin
Winapi.Windows.GetCursorPos(Pos);
DisplayContextMenu(Handle, 'C:\Users\MyTest\Documents\简明Python教程.pdf', Pos);
end;
开发环境Delphi10.2，运行截图：
推荐分享
图文皆来源于网络，内容仅做公益性分享，版权归原作者所有，如有侵权请告知删除！
Copyright © 2014 DelphiW.com 开发 源码 文档 技巧 All Rights Reserved
晋ICP备14006235号-8 晋公网安备 14108102000087号
执行时间: 0.13848781585693 seconds