ADD: Show context menu for multiple objects from different path

src/platform/win/ushellcontextmenu.pas

@@ -79,7 +79,8 @@ uses
   graphtype, intfgraphics, Graphics, uPixMapManager, Dialogs, uLng, uMyWindows,
   uShellExecute, fMain, uDCUtils, uFormCommands, DCOSUtils, uOSUtils, uShowMsg,
   uExts, uFileSystemFileSource, DCConvertEncoding, LazUTF8, uOSForms, uGraphics,
-  Forms, DCWindows, DCStrUtils, Clipbrd, uFileSystemWatcher;
+  Forms, DCWindows, DCStrUtils, Clipbrd, uFileSystemWatcher, uShellFolder,
+  uOleDragDrop;
 
 const
   USER_CMD_ID = $1000;
@@ -127,18 +128,20 @@ begin
 end;
 
 function GetForegroundContextMenu(Handle: HWND; Files: TFiles): IContextMenu;
-type
-  PPIDLArray = ^PItemIDList;
-
 var
-  Folder, DesktopFolder: IShellFolder;
-  PathPIDL: PItemIDList = nil;
-  tmpPIDL: PItemIDList = nil;
-  S: WideString;
-  List: PPIDLArray = nil;
-  I: integer;
+  I: Integer;
   pchEaten: ULONG;
+  S: UnicodeString;
+  APath: UnicodeString;
+  AFolder: TShellFolder;
+  AMenu: TDefContextMenu;
   dwAttributes: ULONG = 0;
+  List: PPItemIDList = nil;
+  ASamePath: Boolean = True;
+  tmpPIDL: PItemIDList = nil;
+  PathPIDL: PItemIDList = nil;
+  ADataObject: THDropDataObject;
+  Folder, DesktopFolder: IShellFolder;
 begin
   Result := nil;
 
@@ -146,6 +149,7 @@ begin
   try
     List := CoTaskMemAlloc(SizeOf(PItemIDList) * Files.Count);
     ZeroMemory(List, SizeOf(PItemIDList) * Files.Count);
+    APath:= CeUtf8ToUtf16(Files[0].Path);
 
     for I := 0 to Files.Count - 1 do
     begin
@@ -154,6 +158,11 @@ begin
       else
         S := CeUtf8ToUtf16(Files[I].Path);
 
+      if ASamePath then
+      begin
+        ASamePath:= UnicodeSameText(S, APath);
+      end;
+
       OleCheckUTF8(DeskTopFolder.ParseDisplayName(Handle, nil, PWideChar(S), pchEaten, PathPIDL, dwAttributes));
       try
         OleCheckUTF8(DeskTopFolder.BindToObject(PathPIDL, nil, IID_IShellFolder, Folder));
@@ -170,8 +179,24 @@ begin
       (List + i)^ := tmpPIDL;
     end;
 
-    Folder.GetUIObjectOf(Handle, Files.Count, PItemIDList(List^), IID_IContextMenu, nil, Result);
+    if (Win32MajorVersion < 6) or (ASamePath) then
+      Folder.GetUIObjectOf(Handle, Files.Count, PItemIDList(List^), IID_IContextMenu, nil, Result)
+    else begin
+      AMenu:= Default(TDefContextMenu);
+      AMenu.hwnd:= Handle;
+      ADataObject:= THDropDataObject.Create(DROPEFFECT_NONE);
+      AFolder:= TShellFolder.Create(DeskTopFolder, ADataObject);
+
+      for I := 0 to Files.Count - 1 do
+      begin
+        ADataObject.Add(Files[I].FullPath);
+      end;
+      AMenu.psf:= AFolder;
+      AMenu.cidl:= Files.Count;
+      AMenu.apidl:= PPItemIDList(List);
 
+      OleCheckUTF8(CreateDefaultContextMenu(AMenu, IID_IContextMenu, Result));
+    end;
   finally
     if Assigned(List) then
     begin

src/platform/win/ushellfolder.pas

@@ -5,7 +5,7 @@ unit uShellFolder;
 interface
 
 uses
-  Classes, SysUtils, Windows, ShlObj, ActiveX, ComObj, uShlObjAdditional;
+  Classes, SysUtils, Windows, ShlObj, ActiveX, ComObj, ShlWapi, uShlObjAdditional;
 
 const
   FOLDERID_AccountPictures: TGUID = '{008ca0b1-55b4-4c56-b8a8-4de4b299d3be}';
@@ -55,16 +55,67 @@ const
   FOLDERID_UserProgramFiles: TGUID = '{5CD7AEE2-2219-4A67-B85D-6C9CE15660CB}';
   FOLDERID_UserProgramFilesCommon: TGUID = '{BCBD3057-CA5C-4622-B42D-BC56DB0AE516}';
 
+type
+
+  PPItemIDList = ^PItemIDList;
+
+  TDefContextMenu = record
+    hwnd                  : HWND;
+    pcmcb                 : IUnknown;
+    pidlFolder            : PCIDLIST_ABSOLUTE;
+    psf                   : IShellFolder;
+    cidl                  : UINT;
+    apidl                 : PPItemIDList;
+    punkAssociationInfo   : IUnknown;
+    cKeys                 : UINT;
+    aKeys                 : PHKEY;
+  end;
+
+  { TShellFolder }
+
+  TShellFolder = class(TInterfacedObject, IShellFolder)
+  private
+    FFolder: IShellFolder;
+    FDataObject: IDataObject;
+  protected
+    function QueryInterface(constref iid : tguid; out obj) : longint; stdcall;
+  public
+    constructor Create(AFolder: IShellFolder; DataObject: IDataObject);
+  public
+    function ParseDisplayName(hwndOwner: HWND; pbcReserved: Pointer; lpszDisplayName: POLESTR; out pchEaten: ULONG; out ppidl: PItemIDList; var dwAttributes: ULONG): HRESULT; stdcall;
+    function EnumObjects(hwndOwner: HWND; grfFlags: DWORD; out EnumIDList: IEnumIDList): HRESULT; stdcall;
+    function BindToObject(pidl: PItemIDList; pbcReserved: Pointer; const riid: TIID; out ppvOut): HRESULT; stdcall;
+    function BindToStorage(pidl: PItemIDList; pbcReserved: Pointer; const riid: TIID; out ppvObj): HRESULT; stdcall;
+    function CompareIDs(lParam: LPARAM; pidl1, pidl2: PItemIDList): HRESULT; stdcall;
+    function CreateViewObject(hwndOwner: HWND; const riid: TIID; out ppvOut): HRESULT; stdcall;
+    function GetAttributesOf(cidl: UINT; var apidl: PItemIDList; var rgfInOut: UINT): HRESULT; stdcall;
+    function GetUIObjectOf(hwndOwner: HWND; cidl: UINT; var apidl: PItemIDList; const riid: TIID; prgfInOut: Pointer; out ppvOut): HRESULT; stdcall;
+    function GetDisplayNameOf(pidl: PItemIDList; uFlags: DWORD; var lpName: TStrRet): HRESULT; stdcall;
+    function SetNameOf(hwndOwner: HWND; pidl: PItemIDList; lpszName: POLEStr; uFlags: DWORD; var ppidlOut: PItemIDList): HRESULT; stdcall;
+  end;
+
 function GetKnownFolderPath(const rfid: TGUID; out APath: String): Boolean;
 
+function MultiFileProperties(pdtobj: IDataObject; dwFlags: DWORD): HRESULT;
+
 function GetDisplayName(AFolder: IShellFolder; PIDL: PItemIDList; Flags: DWORD): String;
 function GetDetails(AFolder: IShellFolder2; PIDL: PItemIDList; const pscid: SHCOLUMNID): OleVariant;
 
+function CreateDefaultContextMenu(constref pdcm: TDefContextMenu; const riid: REFIID; out ppv): HRESULT;
+
 implementation
 
 uses
   ShellApi, LazUTF8, DCConvertEncoding;
 
+const
+  KF_FLAG_DEFAULT = $00000000;
+
+var
+  SHMultiFileProperties: function(pdtobj: IDataObject; dwFlags: DWORD): HRESULT; stdcall;
+  SHCreateDefaultContextMenu: function(constref pdcm: TDefContextMenu; const riid: REFIID; out ppv): HRESULT; stdcall;
+  SHGetKnownFolderPath: function(const rfid: TGUID; dwFlags: DWORD; hToken: HANDLE; out ppszPath: LPCWSTR): HRESULT; stdcall;
+
 function StrRetToString(PIDL: PItemIDList; StrRet: TStrRet): String;
 var
   S: array[0..MAX_PATH] of WideChar;
@@ -75,6 +126,11 @@ begin
     Result:= CeUtf16ToUtf8(UnicodeString(S));
 end;
 
+function MultiFileProperties(pdtobj: IDataObject; dwFlags: DWORD): HRESULT;
+begin
+  Result:= SHMultiFileProperties(pdtobj, dwFlags);
+end;
+
 function GetDisplayName(AFolder: IShellFolder; PIDL: PItemIDList;
                         Flags: DWORD): String;
 var
@@ -98,11 +154,11 @@ begin
    Result:= Unassigned;
 end;
 
-const
-  KF_FLAG_DEFAULT = $00000000;
-
-var
-  SHGetKnownFolderPath: function(const rfid: TGUID; dwFlags: DWORD; hToken: HANDLE; out ppszPath: LPCWSTR): HRESULT; stdcall;
+function CreateDefaultContextMenu(constref pdcm: TDefContextMenu;
+  const riid: REFIID; out ppv): HRESULT;
+begin
+  Result:= SHCreateDefaultContextMenu(pdcm, riid, ppv);
+end;
 
 function GetKnownFolderPath(const rfid: TGUID; out APath: String): Boolean;
 var
@@ -113,7 +169,100 @@ begin
   CoTaskMemFree(ppszPath);
 end;
 
+{ TShellFolder }
+
+function TShellFolder.QueryInterface(constref iid: tguid; out obj): longint;
+  stdcall;
+begin
+  Result:= FFolder.QueryInterface(iid, obj);
+end;
+
+constructor TShellFolder.Create(AFolder: IShellFolder; DataObject: IDataObject);
+begin
+  FFolder:= AFolder;
+  FDataObject:= DataObject;
+end;
+
+function TShellFolder.ParseDisplayName(hwndOwner: HWND; pbcReserved: Pointer;
+  lpszDisplayName: POLESTR; out pchEaten: ULONG; out ppidl: PItemIDList;
+  var dwAttributes: ULONG): HRESULT; stdcall;
+begin
+  Result:= FFolder.ParseDisplayName(hwndOwner, pbcReserved, lpszDisplayName, pchEaten, ppidl, dwAttributes);
+end;
+
+function TShellFolder.EnumObjects(hwndOwner: HWND; grfFlags: DWORD; out
+  EnumIDList: IEnumIDList): HRESULT; stdcall;
+begin
+  Result:= EnumObjects(hwndOwner, grfFlags, EnumIDList);
+end;
+
+function TShellFolder.BindToObject(pidl: PItemIDList; pbcReserved: Pointer;
+  const riid: TIID; out ppvOut): HRESULT; stdcall;
+begin
+  Result:= FFolder.BindToObject(pidl, pbcReserved, riid, ppvOut);
+end;
+
+function TShellFolder.BindToStorage(pidl: PItemIDList; pbcReserved: Pointer;
+  const riid: TIID; out ppvObj): HRESULT; stdcall;
+begin
+  Result:= FFolder.BindToStorage(pidl, pbcReserved, riid, ppvObj);
+end;
+
+function TShellFolder.CompareIDs(lParam: LPARAM; pidl1, pidl2: PItemIDList): HRESULT; stdcall;
+begin
+  Result:= FFolder.CompareIDs(lParam, pidl1, pidl2);
+end;
+
+function TShellFolder.CreateViewObject(hwndOwner: HWND; const riid: TIID; out
+  ppvOut): HRESULT; stdcall;
+begin
+  Result:= FFolder.CreateViewObject(hwndOwner, riid, ppvOut);
+end;
+
+function TShellFolder.GetAttributesOf(cidl: UINT; var apidl: PItemIDList;
+  var rgfInOut: UINT): HRESULT; stdcall;
+begin
+  Result:= FFolder.GetAttributesOf(cidl, apidl, rgfInOut);
+end;
+
+function TShellFolder.GetUIObjectOf(hwndOwner: HWND; cidl: UINT;
+  var apidl: PItemIDList; const riid: TIID; prgfInOut: Pointer; out ppvOut
+  ): HRESULT; stdcall;
+begin
+  if (IsEqualGUID(riid, IID_IDataObject)) then
+    Result:= FDataObject.QueryInterface(riid, ppvOut)
+  else begin
+    Result:= FFolder.GetUIObjectOf(hwndOwner, cidl, apidl, riid, prgfInOut, ppvOut);
+  end;
+end;
+
+function TShellFolder.GetDisplayNameOf(pidl: PItemIDList; uFlags: DWORD;
+  var lpName: TStrRet): HRESULT; stdcall;
+begin
+  Result:= FFolder.GetDisplayNameOf(pidl, uFlags, lpName);
+end;
+
+function TShellFolder.SetNameOf(hwndOwner: HWND; pidl: PItemIDList;
+  lpszName: POLEStr; uFlags: DWORD; var ppidlOut: PItemIDList): HRESULT;
+  stdcall;
+begin
+  Result:= FFolder.SetNameOf(hwndOwner, pidl, lpszName, uFlags, ppidlOut);
+end;
+
+var
+  AModule: HMODULE;
+
 initialization
-  if Win32MajorVersion > 5 then @SHGetKnownFolderPath:= GetProcAddress(GetModuleHandleW(shell32), 'SHGetKnownFolderPath');
+  if CheckWin32Version(5, 1) then
+  begin
+    AModule:= GetModuleHandleW(shell32);
+    @SHMultiFileProperties:= GetProcAddress(AModule, 'SHMultiFileProperties');
+
+    if Win32MajorVersion > 5 then
+    begin
+      @SHGetKnownFolderPath:= GetProcAddress(AModule, 'SHGetKnownFolderPath');
+      @SHCreateDefaultContextMenu:= GetProcAddress(AModule, 'SHCreateDefaultContextMenu');
+    end;
+  end;
 end.