Developing.ru

Код: Выделить всё

uses ShlObj, ActiveX;
...
procedure ShowContextMenu(HWND: hWnd; Path: String; x, y: Integer);
var
  FullPath: PWideChar;
  Folder, DesktopFolder: IShellFolder;
  ContextMenu: IContextMenu2;
  Malloc: IMalloc;
  hPopupMenu: HMENU;
  pLastId, pidl: PItemIDList;
  pchEaten, dwAttributes: ULONG;
  temp: SHORT;
  offset: Word;
  nCmd: LongBool;
  p: PChar;
  ici: CMINVOKECOMMANDINFO;
begin
  GetMem(FullPath, 1024);
  StringToWideChar(Path, FullPath, MAX_PATH);
  SHGetDesktopFolder(DesktopFolder);
  DesktopFolder.ParseDisplayName(HWND, nil, FullPath, pchEaten, pidl, dwAttributes);
  if pidl <> nil then
  begin
    pLastId := pidl;
    while True do
    begin
      offset := pLastId.mkid.cb;
      p := Pointer(pLastId);
      p := @p[offset];
      temp := word(p^);
      if temp = 0 then Break;
      pLastId := PItemIDList(p);
    end;
    temp := pLastId.mkid.cb;
    pLastId.mkid.cb := 0;
    DesktopFolder.BindToObject(pidl, nil, IID_IShellFolder, Folder);
    pLastId.mkid.cb := temp;
    Folder.GetUIObjectOf(HWND, 1, pLastId, IID_IContextMenu, nil, ContextMenu);
    hPopupMenu := CreatePopupMenu;
    ContextMenu.QueryContextMenu(hPopupMenu, 0, 1, $07FFF, 0);
    nCmd := TrackPopupMenu(hPopupMenu,
     TPM_LEFTALIGN or TPM_LEFTBUTTON or TPM_RIGHTBUTTON or TPM_RETURNCMD,
     x, y, 0, hWnd, nil);
    if nCmd then
    begin
      ZeroMemory(@ici, sizeof(CMINVOKECOMMANDINFO));
      ici.cbSize := sizeof(CMINVOKECOMMANDINFO);
      ici.hwnd := hWnd;
      ici.lpVerb := MAKEINTRESOURCE(Word(nCmd)-1);
      ici.nShow := SW_SHOWNORMAL;
      ContextMenu.InvokeCommand(ici);
    end;
    SHGetMalloc(Malloc);
    Malloc.Free(pidl);
  end;
  FreeMem(FullPath);
end;