delphi 调用系统右键菜单

1 unit PopupMenuShell;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, StrUtils, ComObj, ShlObj, ActiveX;
7
8 function DisplayContextMenu( const Handle: THandle; const FileName: string ; Pos: TPoint): Boolean;
9
10 implementation
11
12 type
13 TUnicodePath = array [ 0 ..MAX_PATH - 1 ] of WideChar;
14
15 const
16 ShenPathSeparator = ' \ ' ;
17
18 Function String2PWideChar( const s: String): PWideChar;
19 begin
20 if s = '' then
21 begin
22 result: = nil ;
23 exit;
24 end ;
25 result: = AllocMem((Length(s) + 1 ) * sizeOf(widechar));
26 StringToWidechar(s, result, Length(s) * sizeOf(widechar) + 1 );
27 end ;
28
29 function PidlFree( var IdList: PItemIdList): Boolean;
30 var
31 Malloc: IMalloc;
32 begin
33 Result : = False;
34 if IdList = nil then
35 Result : = True
36 else
37 begin
38 if Succeeded(SHGetMalloc(Malloc)) and (Malloc.DidAlloc(IdList) > 0 ) then
39 begin
40 Malloc.Free(IdList);
41 IdList : = nil ;
42 Result : = True;
43 end ;
44 end ;
45 end ;
46
47 function MenuCallback(Wnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall ;
48 var
49 ContextMenu2: IContextMenu2;
50 begin
51 case Msg of
52 WM_CREATE:
53 begin
54 ContextMenu2 : = IContextMenu2(PCreateStruct(lParam).lpCreateParams);
55 SetWindowLong(Wnd, GWL_USERDATA, Longint(ContextMenu2));
56 Result : = DefWindowProc(Wnd, Msg, wParam, lParam);
57 end ;
58 WM_INITMENUPOPUP:
59 begin
60 ContextMenu2 : = IContextMenu2(GetWindowLong(Wnd, GWL_USERDATA));
61 ContextMenu2.HandleMenuMsg(Msg, wParam, lParam);
62 Result : = 0 ;
63 end ;
64 WM_DRAWITEM, WM_MEASUREITEM:
65 begin
66 ContextMenu2 : = IContextMenu2(GetWindowLong(Wnd, GWL_USERDATA));
67 ContextMenu2.HandleMenuMsg(Msg, wParam, lParam);
68 Result : = 1 ;
69 end ;
70 else
71 Result : = DefWindowProc(Wnd, Msg, wParam, lParam);
72 end ;
73 end ;
74
75 function CreateMenuCallbackWnd( const ContextMenu: IContextMenu2): HWND;
76 const
77 IcmCallbackWnd = ' ICMCALLBACKWND ' ;
78 var
79 WndClass: TWndClass;
80 begin
81 FillChar(WndClass, SizeOf(WndClass), # 0 );
82 WndClass.lpszClassName : = PChar(IcmCallbackWnd);
83 WndClass.lpfnWndProc : = @MenuCallback;
84 WndClass.hInstance : = HInstance;
85 Windows.RegisterClass(WndClass);
86 Result : = CreateWindow(IcmCallbackWnd, IcmCallbackWnd, WS_POPUPWINDOW, 0 , 0 , 0 , 0 , 0 , 0 , HInstance, Pointer(ContextMenu));
87 end ;
88
89 function DisplayContextMenuPidl( const Handle: HWND; const Folder: IShellFolder; Item: PItemIdList; Pos: TPoint): Boolean;
90 var
91 Cmd: Cardinal;
92 ContextMenu: IContextMenu;
93 ContextMenu2: IContextMenu2;
94 Menu: HMENU;
95 CommandInfo: TCMInvokeCommandInfo;
96 CallbackWindow: HWND;
97 begin
98 Result : = False;
99 if (Item = nil ) or (Folder = nil ) then
100 Exit;
101 Folder.GetUIObjectOf(Handle, 1 , Item, IID_IContextMenu, nil , Pointer(ContextMenu));
102
103 if ContextMenu <> nil then
104 begin
105 Menu : = CreatePopupMenu;
106 if Menu <> 0 then
107 begin
108 if Succeeded(ContextMenu.QueryContextMenu(Menu, 0 , 1 , $7FFF, CMF_EXPLORE)) then
109 begin
110 CallbackWindow : = 0 ;
111
112 if Succeeded(ContextMenu.QueryInterface(IContextMenu2, ContextMenu2)) then
113 CallbackWindow : = CreateMenuCallbackWnd(ContextMenu2);
114
115 ClientToScreen(Handle, Pos);
116 Cmd : = Cardinal(TrackPopupMenu(Menu, TPM_LEFTALIGN or TPM_LEFTBUTTON or
117 TPM_RIGHTBUTTON or TPM_RETURNCMD, Pos.X, Pos.Y, 0 , CallbackWindow,
118 nil ));
119
120 if Cmd <> 0 then
121 begin
122 FillChar(CommandInfo, SizeOf(CommandInfo), # 0 );
123 CommandInfo.cbSize : = SizeOf(TCMInvokeCommandInfo);
124 CommandInfo.hwnd : = Handle;
125 CommandInfo.lpVerb : = MakeIntResource(Cmd - 1 );
126 CommandInfo.nShow : = SW_SHOWNORMAL;
127 Result : = Succeeded(ContextMenu.InvokeCommand(CommandInfo));
128 end ;
129
130 if CallbackWindow <> 0 then
131 DestroyWindow(CallbackWindow);
132 end ;
133
134 DestroyMenu(Menu);
135 end ;
136 end ;
137 end ;
138
139 function PathAddSeparator( const Path: string ): string ;
140 begin
141 Result : = Path;
142 if (Length(Path) = 0 ) or (AnsiLastChar(Path) <> ShenPathSeparator) then
143 Result : = Path + ShenPathSeparator;
144 end ;
145
146 function DriveToPidlBind( const DriveName: string ; out Folder: IShellFolder):
147 PItemIdList;
148 var
149 Attr: ULONG;
150 Eaten: ULONG;
151 DesktopFolder: IShellFolder;
152 Drives: PItemIdList;
153 Path: TUnicodePath;
154 begin
155 Result : = nil ;
156 if Succeeded(SHGetDesktopFolder(DesktopFolder)) then
157 begin
158 if Succeeded(SHGetSpecialFolderLocation( 0 , CSIDL_DRIVES, Drives)) then
159 begin
160 if Succeeded(DesktopFolder.BindToObject(Drives, nil , IID_IShellFolder, Pointer(Folder))) then
161 begin
162 MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PChar(PathAddSeparator(DriveName)), - 1 , Path, MAX_PATH);
163
164 if Failed(Folder.ParseDisplayName( 0 , nil , Path, Eaten, Result, Attr)) then
165 Folder : = nil ;
166 end ;
167 end ;
168 PidlFree(Drives);
169 end ;
170 end ;
171
172 function PathToPidlBind( const FileName: string ; out Folder: IShellFolder): PItemIdList;
173 var
174 Attr, Eaten: ULONG;
175 PathIdList: PItemIdList;
176 DesktopFolder: IShellFolder;
177 Path, ItemName: pwidechar;
178 s1,s2: string ;
179 begin
180 Result : = nil ;
181
182 s1: = ExtractFilePath(FileName);
183 s2: = ExtractFileName(FileName);
184 Path: = String2PWideChar(s1);
185 ItemName: = String2PWideChar(s2);
186
187 if Succeeded(SHGetDesktopFolder(DesktopFolder)) then
188 begin
189 if Succeeded(DesktopFolder.ParseDisplayName( 0 , nil , Path, Eaten, PathIdList, Attr)) then
190 begin
191 if Succeeded(DesktopFolder.BindToObject(PathIdList, nil , IID_IShellFolder, Pointer(Folder))) then
192 begin
193 if Failed(Folder.ParseDisplayName( 0 , nil , ItemName, Eaten, Result, Attr)) then
194 begin
195 Folder : = nil ;
196 Result : = DriveToPidlBind(FileName, Folder);
197 end ;
198 end ;
199 PidlFree(PathIdList);
200 end
201 else
202 Result : = DriveToPidlBind(FileName, Folder);
203 end ;
204
205 FreeMem(Path);
206 FreeMem(ItemName);
207 end ;
208
209 function DisplayContextMenu( const Handle: Thandle; const FileName: string ; Pos: TPoint): Boolean;
210 var
211 ItemIdList: PItemIdList;
212 Folder: IShellFolder;
213 begin
214 Result : = False;
215 ItemIdList : = PathToPidlBind(FileName, Folder);
216
217 if ItemIdList <> nil then
218 begin
219 Result : = DisplayContextMenuPidl(Handle, Folder, ItemIdList, Pos);
220 PidlFree(ItemIdList);
221 end ;
222 end ;
223
224 end .

转载于:https://www.cnblogs.com/Lucky2011/archive/2011/04/08/2009486.html