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.