From internet sources (mostly from
http://bcbjournal.org/articles/vol4/0006/Using_the_shell_context_menu.htm )
I have scraped together a routine to display
the Windows context menu for a given file or directory name (see below).
This works okay but (at least) one issue appears:
On Windows XP, when clicking on the context menu entry "Send to" another submenu
"Send to"
is shown instead of a list of programs to select. When clicking on this second "Send
to" nothing happens.
On Windows 7 everything works ok and the list of programs is displayed!
Also, selecting other entries like "Properties" work ok on both platforms.
Any Windows gurus who know why this is the case (and how to fix it)?
//-------------------------------------------------------------------------------------
procedure FileShowContextMenuOK(Handle : HWND; const Path,Name : UTF8String;
const PosX,PosY : SizeInt);
var DesktopFolder : IShellFolder = nil;
ParentFolder : IShellFolder = nil;
Attr,
Eaten,
Flags : DWord;
B : WinBool;
CM : IContextMenu;
CI : TCMINVOKECOMMANDINFO;
hM : HMENU;
WidePath,
WideName : WideString;
Pidl,
ParentPidl : LPITEMIDLIST;
begin // FileShowContextMenuOK
SHGetDesktopFolder(DesktopFolder);
if not assigned(DesktopFolder) then
Exit;
WidePath := UTF8Decode(Path);
Attr := 0;
if
DesktopFolder.ParseDisplayName(Handle,nil,pwidechar(WidePath),Eaten,ParentPidl,Attr)<>0
then
Exit;
if DesktopFolder.BindToObject(ParentPidl,nil,IID_IShellFolder,ParentFolder)<>0
then
Exit;
WideName := UTF8Decode(Name);
if
ParentFolder.ParseDisplayName(Handle,nil,pwidechar(WideName),Eaten,Pidl,Attr)<>0
then
Exit;
if ParentFolder.GetUIObjectOf(Handle,1,Pidl,IID_IContextMenu,nil,CM)<>0 then
Exit;
hM := CreatePopupMenu;
Flags := CMF_EXTENDEDVERBS; //CMF_EXPLORE; // CMF_NORMAL; //CMF_ASYNCVERBSTATE;
// CMF_EXPLORE;
CM.QueryContextMenu(hM,0,1,$7FFF,Flags);
B := TrackPopupMenu(hM,TPM_LEFTALIGN or TPM_LEFTBUTTON or TPM_RIGHTBUTTON or
TPM_RETURNCMD { or TPM_NONOTIFY or TPM_RETURNCMD},
PosX,PosY,0,Handle,nil);
if not B then
exit;
fillchar(CI,sizeof(CI),0);
with CI do
begin
cbSize := SizeOf(CI);
lpVerb := MAKEINTRESOURCE(Integer(B)-1);
lpParameters := '';
lpDirectory := '';
hwnd := Handle;
nShow := SW_SHOWNORMAL;
end;
CM.InvokeCommand(CI);
CoTaskMemFree(Pidl);
CoTaskMemFree(ParentPidl);
end; // FileShowContextMenuOK
//-------------------------------------------------------------------------------------
--
_______________________________________________
Lazarus mailing list
[email protected]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
