doublecmd/src/platform/win/ushellcontextmenu.pas
Alexander Koblov 547c314dad FIX: Context menu parent (fixes #208)
(cherry picked from commit f79147d9a9)
2021-10-29 18:25:27 +03:00

834 lines
30 KiB
ObjectPascal

{
Double Commander
-------------------------------------------------------------------------
Shell context menu implementation.
Copyright (C) 2006-2021 Alexander Koblov (alexx2000@mail.ru)
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
}
unit uShellContextMenu;
{$mode delphi}{$H+}
{$IF (FPC_VERSION > 2) or ((FPC_VERSION = 2) and (FPC_RELEASE >= 5))}
{$POINTERMATH ON}
{$ENDIF}
interface
uses
Classes, SysUtils, Controls, uFile, Windows, ComObj, ShlObj, ActiveX,
JwaShlGuid, uGlobs, uShlObjAdditional;
const
sCmdVerbOpen = 'open';
sCmdVerbRename = 'rename';
sCmdVerbDelete = 'delete';
sCmdVerbCut = 'cut';
sCmdVerbCopy = 'copy';
sCmdVerbPaste = 'paste';
sCmdVerbLink = 'link';
sCmdVerbProperties = 'properties';
sCmdVerbNewFolder = 'NewFolder';
sCmdVerbCopyPath = 'copyaspath';
type
{ EContextMenuException }
EContextMenuException = class(Exception);
{ TShellContextMenu }
TShellContextMenu = class
private
FOnClose: TNotifyEvent;
FParent: HWND;
FFiles: TFiles;
FBackground: boolean;
FShellMenu1: IContextMenu;
FShellMenu: HMENU;
FUserWishForContextMenu: TUserWishForContextMenu;
protected
procedure Execute(Data: PtrInt);
public
constructor Create(Parent: TWinControl; var Files: TFiles; Background: boolean; UserWishForContextMenu: TUserWishForContextMenu = uwcmComplete); reintroduce;
destructor Destroy; override;
procedure PopUp(X, Y: integer);
property OnClose: TNotifyEvent read FOnClose write FOnClose;
end;
procedure PasteFromClipboard(Parent: HWND; const Path: String);
function GetShellContextMenu(Handle: HWND; Files: TFiles; Background: boolean): IContextMenu;
implementation
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;
const
USER_CMD_ID = $1000;
var
OldWProc: WNDPROC = nil;
ShellMenu2: IContextMenu2 = nil;
ShellMenu3: IContextMenu3 = nil;
ContextMenuDCIcon: Graphics.TBitmap = nil;
ContextMenucm_FileAssoc: Graphics.TBitmap = nil;
ContextMenucm_RunTerm: Graphics.TBitmap = nil;
function MyWndProc(hWnd: HWND; uiMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
case uiMsg of
WM_MENUSELECT:
Result := DefWindowProc(hWnd, uiMsg, wParam, lParam);
(* For working with submenu of context menu *)
WM_INITMENUPOPUP,
WM_DRAWITEM,
WM_MENUCHAR,
WM_MEASUREITEM:
if Assigned(ShellMenu3) then
ShellMenu3.HandleMenuMsg2(uiMsg, wParam, lParam, @Result)
else if Assigned(ShellMenu2) then
begin
ShellMenu2.HandleMenuMsg(uiMsg, wParam, lParam);
Result := 0;
end
else
Result := CallWindowProc(OldWProc, hWnd, uiMsg, wParam, lParam);
else
Result := CallWindowProc(OldWProc, hWnd, uiMsg, wParam, lParam);
end; // case
end;
function GetRecycleBinContextMenu(Handle: HWND): IContextMenu;
var
PathPIDL: PItemIDList = nil;
DesktopFolder: IShellFolder;
begin
OleCheckUTF8(SHGetDesktopFolder(DesktopFolder));
OleCheckUTF8(SHGetFolderLocation(Handle, CSIDL_BITBUCKET, 0, 0, PathPIDL));
DesktopFolder.GetUIObjectOf(Handle, 1, PathPIDL, IID_IContextMenu, nil, Result);
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;
pchEaten: ULONG;
dwAttributes: ULONG = 0;
begin
Result := nil;
OleCheckUTF8(SHGetDesktopFolder(DesktopFolder));
try
List := CoTaskMemAlloc(SizeOf(PItemIDList) * Files.Count);
ZeroMemory(List, SizeOf(PItemIDList) * Files.Count);
for I := 0 to Files.Count - 1 do
begin
if Files[I].Name = EmptyStr then
S := EmptyWideStr
else
S := UTF8Decode(Files[I].Path);
OleCheckUTF8(DeskTopFolder.ParseDisplayName(Handle, nil, PWideChar(S), pchEaten, PathPIDL, dwAttributes));
try
OleCheckUTF8(DeskTopFolder.BindToObject(PathPIDL, nil, IID_IShellFolder, Folder));
finally
CoTaskMemFree(PathPIDL);
end;
if Files[I].Name = EmptyStr then
S := UTF8Decode(Files[I].Path)
else
S := UTF8Decode(Files[I].Name);
OleCheckUTF8(Folder.ParseDisplayName(Handle, nil, PWideChar(S), pchEaten, tmpPIDL, dwAttributes));
(List + i)^ := tmpPIDL;
end;
Folder.GetUIObjectOf(Handle, Files.Count, PItemIDList(List^), IID_IContextMenu, nil, Result);
finally
if Assigned(List) then
begin
for I := 0 to Files.Count - 1 do
if Assigned((List + i)^) then
CoTaskMemFree((List + i)^);
CoTaskMemFree(List);
end;
Folder := nil;
DesktopFolder := nil;
end;
end;
function GetBackgroundContextMenu(Handle: HWND; Files: TFiles): IContextMenu;
var
DesktopFolder, Folder: IShellFolder;
wsFileName: WideString;
PathPIDL: PItemIDList = nil;
pchEaten: ULONG;
dwAttributes: ULONG = 0;
begin
Result := nil;
if Files.Count > 0 then
begin
wsFileName := UTF8Decode(Files[0].FullPath);
OleCheckUTF8(SHGetDesktopFolder(DesktopFolder));
try
OleCheckUTF8(DesktopFolder.ParseDisplayName(Handle, nil, PWideChar(wsFileName), pchEaten, PathPIDL, dwAttributes));
try
OleCheckUTF8(DesktopFolder.BindToObject(PathPIDL, nil, IID_IShellFolder, Folder));
finally
CoTaskMemFree(PathPIDL);
end;
OleCheckUTF8(Folder.CreateViewObject(Handle, IID_IContextMenu, Result));
finally
Folder := nil;
DesktopFolder := nil;
end;
end;
end;
function GetShellContextMenu(Handle: HWND; Files: TFiles; Background: boolean): IContextMenu; inline;
begin
if Files = nil then
Result := GetRecycleBinContextMenu(Handle)
else if Background then
Result := GetBackgroundContextMenu(Handle, Files)
else
Result := GetForegroundContextMenu(Handle, Files);
end;
type
{ TShellThread }
TShellThread = class(TThread)
private
FParent: HWND;
FVerb: ansistring;
FShellMenu: IContextMenu;
protected
procedure Execute; override;
public
constructor Create(Parent: HWND; ShellMenu: IContextMenu; Verb: ansistring); reintroduce;
destructor Destroy; override;
end;
{ TShellThread }
procedure TShellThread.Execute;
var
Result: HRESULT;
cmici: TCMINVOKECOMMANDINFO;
begin
CoInitializeEx(nil, COINIT_APARTMENTTHREADED);
try
FillByte(cmici, SizeOf(cmici), 0);
with cmici do
begin
cbSize := SizeOf(cmici);
hwnd := FParent;
lpVerb := PAnsiChar(FVerb);
nShow := SW_NORMAL;
end;
Result := FShellMenu.InvokeCommand(cmici);
if not (Succeeded(Result) or (Result = COPYENGINE_E_USER_CANCELLED) or (Result = HRESULT_ERROR_CANCELLED)) then
msgError(Self, mbSysErrorMessage(Result));
finally
CoUninitialize;
end;
end;
constructor TShellThread.Create(Parent: HWND; ShellMenu: IContextMenu; Verb: ansistring);
begin
inherited Create(True);
FVerb := Verb;
FParent := Parent;
FShellMenu := ShellMenu;
FreeOnTerminate := True;
end;
destructor TShellThread.Destroy;
begin
FShellMenu := nil;
inherited Destroy;
end;
procedure CreateActionSubMenu(MenuWhereToAdd: HMenu; paramExtActionList: TExtActionList; aFile: TFile; bIncludeViewEdit: boolean);
const
Always_Legacy_Action_Count = 2;
var
I, iDummy: integer;
sAct: String;
iMenuPositionInsertion: integer = 0;
Always_Expanded_Action_Count: integer = 0;
bSeparatorAlreadyInserted: boolean;
function GetMeTheBitmapForThis(ImageRequiredIndex: PtrInt): TBitmap;
begin
Result := Graphics.TBitmap.Create;
Result.SetSize(gIconsSize, gIconsSize);
Result.Transparent := True;
Result.Canvas.Brush.Color := clMenu;
Result.Canvas.Brush.Style := bsSolid;
Result.Canvas.FillRect(0, 0, gIconsSize, gIconsSize);
PixMapManager.DrawBitmap(ImageRequiredIndex, Result.Canvas, 0, 0);
if Result.PixelFormat <> pf32bit then BitmapConvert(Result);
end;
procedure LocalInsertMenuSeparator;
begin
InsertMenuItemEx(MenuWhereToAdd, 0, nil, iMenuPositionInsertion, 0, MFT_SEPARATOR);
Inc(iMenuPositionInsertion);
end;
procedure LocalInsertMenuItemExternal(MenuDispatcher: integer; BitmapProvided: TBitmap = nil);
begin
if BitmapProvided = nil then
InsertMenuItemEx(MenuWhereToAdd, 0, PWChar(UTF8Decode(paramExtActionList.ExtActionCommand[MenuDispatcher].ActionName)), iMenuPositionInsertion, MenuDispatcher + USER_CMD_ID, MFT_STRING, paramExtActionList.ExtActionCommand[MenuDispatcher].IconBitmap)
else
InsertMenuItemEx(MenuWhereToAdd, 0, PWChar(UTF8Decode(paramExtActionList.ExtActionCommand[MenuDispatcher].ActionName)), iMenuPositionInsertion, MenuDispatcher + USER_CMD_ID, MFT_STRING, BitmapProvided);
Inc(iMenuPositionInsertion);
end;
begin
// Read actions from "extassoc.xml"
if not gExtendedContextMenu then
gExts.GetExtActions(aFile, paramExtActionList, @iDummy, False)
else
gExts.GetExtActions(aFile, paramExtActionList, @iDummy, True);
if not gExtendedContextMenu then
begin
// In non expanded context menu (legacy), the order of items is:
// 1o) View (always)
// 2o) Edit (always)
// 3o) Custom action different then Open, View or Edit (if any, add also a separator just before)
I := paramExtActionList.Add(TExtActionCommand.Create(rsMnuView, '{!VIEWER}', QuoteStr(aFile.FullPath), ''));
LocalInsertMenuItemExternal(I);
I := paramExtActionList.Add(TExtActionCommand.Create(rsMnuEdit, '{!EDITOR}', QuoteStr(aFile.FullPath), ''));
LocalInsertMenuItemExternal(I);
if paramExtActionList.Count > Always_Legacy_Action_Count then
begin
bSeparatorAlreadyInserted := false;
for I := 0 to (pred(paramExtActionList.Count) - Always_Legacy_Action_Count) do
begin
sAct := paramExtActionList.ExtActionCommand[I].ActionName;
if (CompareText('OPEN', sAct) <> 0) and (CompareText('VIEW', sAct) <> 0) and (CompareText('EDIT', sAct) <> 0) then
begin
if not bSeparatorAlreadyInserted then
begin
LocalInsertMenuSeparator;
bSeparatorAlreadyInserted := true;
end;
LocalInsertMenuItemExternal(I);
end;
end;
end;
end
else
begin
// In expanded context menu, the order of items is:
// 1o) View (always, and if "external" is used, shows also the "internal" if user wants it.
// 2o) Edit (always, and if "external" is used, shows also the "internal" if user wants it.
// 3o) Custom actions, no matter is open, view or edit (if any, add also a separator just before).
// These will be shown in the same order as what they are configured in File Association.
// The routine "GetExtActions" has already placed them in the wanted order.
// Also, the routine "GetExtActions" has already included the menu separator ('-') between different "TExtAction".
// 4o) We add the Execute via shell if user requested it.
// 5o) We add the Execute via terminal if user requested it (close and then stay open).
// 6o) Still if user requested it, the shortcut run file association configuration, if user wanted it.
// A separator also prior that last action.
// Let's prepare our icon for extended menu if not already prepaed during the session.
if ContextMenuDCIcon = nil then
ContextMenuDCIcon := GetMeTheBitmapForThis(gFiOwnDCIcon);
if ContextMenucm_FileAssoc = nil then
ContextMenucm_FileAssoc := GetMeTheBitmapForThis(PixMapManager.GetIconByName('cm_fileassoc'));
if ContextMenucm_RunTerm = nil then
ContextMenucm_RunTerm := GetMeTheBitmapForThis(PixMapManager.GetIconByName('cm_runterm'));
// If the external generic viewer is configured, offer it.
if gExternalTools[etViewer].Enabled then
begin
I := paramExtActionList.Add(TExtActionCommand.Create(rsMnuView + ' (' + rsViewWithExternalViewer + ')', '{!VIEWER}', QuoteStr(aFile.FullPath), ''));
LocalInsertMenuItemExternal(I);
Inc(Always_Expanded_Action_Count);
end;
// Make sure we always shows our internal viewer
I := paramExtActionList.Add(TExtActionCommand.Create(rsMnuView + ' (' + rsViewWithInternalViewer + ')', '{!DC-VIEWER}', QuoteStr(aFile.FullPath), ''));
LocalInsertMenuItemExternal(I, ContextMenuDCIcon);
Inc(Always_Expanded_Action_Count);
// If the external generic editor is configured, offer it.
if gExternalTools[etEditor].Enabled then
begin
I := paramExtActionList.Add(TExtActionCommand.Create(rsMnuEdit + ' (' + rsEditWithExternalEditor + ')', '{!EDITOR}', QuoteStr(aFile.FullPath), ''));
LocalInsertMenuItemExternal(I);
Inc(Always_Expanded_Action_Count);
end;
// Make sure we always shows our internal editor
I := paramExtActionList.Add(TExtActionCommand.Create(rsMnuEdit + ' (' + rsEditWithInternalEditor + ')', '{!DC-EDITOR}', QuoteStr(aFile.FullPath), ''));
LocalInsertMenuItemExternal(I, ContextMenuDCIcon);
Inc(Always_Expanded_Action_Count);
// Now let's add the action button
if paramExtActionList.Count > Always_Expanded_Action_Count then
begin
LocalInsertMenuSeparator;
for I := 0 to (pred(paramExtActionList.Count) - Always_Expanded_Action_Count) do
begin
if paramExtActionList.ExtActionCommand[I].ActionName <> '-' then
begin
sAct := paramExtActionList.ExtActionCommand[I].ActionName;
if (CompareText('OPEN', sAct) = 0) or (CompareText('VIEW', sAct) = 0) or (CompareText('EDIT', sAct) = 0) then
sAct := sAct + ' (' + ExtractFilename(paramExtActionList.ExtActionCommand[I].CommandName) + ')';
if paramExtActionList.ExtActionCommand[I].IconIndex <> -1 then
begin
paramExtActionList.ExtActionCommand[I].IconBitmap := Graphics.TBitmap.Create;
paramExtActionList.ExtActionCommand[I].IconBitmap.SetSize(gIconsSize, gIconsSize);
paramExtActionList.ExtActionCommand[I].IconBitmap.Transparent := True;
paramExtActionList.ExtActionCommand[I].IconBitmap.Canvas.Brush.Color := clMenu;
paramExtActionList.ExtActionCommand[I].IconBitmap.Canvas.Brush.Style := bsSolid;
paramExtActionList.ExtActionCommand[I].IconBitmap.Canvas.FillRect(0, 0, gIconsSize, gIconsSize);
PixMapManager.DrawBitmap(paramExtActionList.ExtActionCommand[I].IconIndex, paramExtActionList.ExtActionCommand[I].IconBitmap.Canvas, 0, 0);
if paramExtActionList.ExtActionCommand[I].IconBitmap.PixelFormat <> pf32bit then
begin
BitmapConvert(paramExtActionList.ExtActionCommand[I].IconBitmap);
end;
end;
LocalInsertMenuItemExternal(I);
end
else
begin
LocalInsertMenuSeparator;
end;
end;
end;
if gOpenExecuteViaShell or gExecuteViaTerminalClose or gExecuteViaTerminalStayOpen then
LocalInsertMenuSeparator;
// now add various SHELL item
if gOpenExecuteViaShell then
begin
I := paramExtActionList.Add(TExtActionCommand.Create(rsMnuOpen + ' (' + rsExecuteViaShell + ')', '{!SHELL}', QuoteStr(aFile.FullPath), ''));
LocalInsertMenuItemExternal(I);
end;
if gExecuteViaTerminalClose then
begin
I := paramExtActionList.Add(TExtActionCommand.Create(rsExecuteViaTerminalClose, '{!TERMANDCLOSE}', QuoteStr(aFile.FullPath), ''));
LocalInsertMenuItemExternal(I, ContextMenucm_RunTerm);
end;
if gExecuteViaTerminalStayOpen then
begin
I := paramExtActionList.Add(TExtActionCommand.Create(rsExecuteViaTerminalStayOpen, '{!TERMSTAYOPEN}', QuoteStr(aFile.FullPath), ''));
LocalInsertMenuItemExternal(I, ContextMenucm_RunTerm);
end;
// Add shortcut to launch file association configuration screen
if gIncludeFileAssociation then
begin
LocalInsertMenuSeparator;
I := paramExtActionList.Add(TExtActionCommand.Create(rsConfigurationFileAssociation, 'cm_FileAssoc', '', ''));
LocalInsertMenuItemExternal(I, ContextMenucm_FileAssoc);
end;
end;
end;
{ TShellContextMenu }
procedure TShellContextMenu.Execute(Data: PtrInt);
var
UserSelectedCommand: TExtActionCommand absolute Data;
begin
try
with frmMain.ActiveFrame do
begin
try
//For the %-Variable replacement that follows it might sounds incorrect to do it with "nil" instead of "aFile",
//but original code was like that. It is useful, at least, when more than one file is selected so because of that,
//it's pertinent and should be kept!
ProcessExtCommandFork(UserSelectedCommand.CommandName, UserSelectedCommand.Params, UserSelectedCommand.StartPath, nil);
except
on e: EInvalidCommandLine do
MessageDlg(rsMsgErrorInContextMenuCommand, rsMsgInvalidCommandLine + ': ' + e.Message, mtError, [mbOK], 0);
end;
end;
finally
FreeAndNil(UserSelectedCommand);
end;
end;
{ TShellContextMenu.Create }
constructor TShellContextMenu.Create(Parent: TWinControl; var Files: TFiles; Background: boolean; UserWishForContextMenu: TUserWishForContextMenu);
var
UFlags: UINT = CMF_EXPLORE;
begin
FParent:= GetControlHandle(Parent);
// Replace window procedure
{$PUSH}{$HINTS OFF}
OldWProc := WNDPROC(SetWindowLongPtr(FParent, GWL_WNDPROC, LONG_PTR(@MyWndProc)));
{$POP}
FFiles := Files;
FBackground := Background;
FShellMenu := 0;
FUserWishForContextMenu := UserWishForContextMenu;
if Assigned(Files) then begin
UFlags := UFlags or CMF_CANRENAME;
end;
// Add extended verbs if shift key is down
if (ssShift in GetKeyShiftState) then begin
UFlags := UFlags or CMF_EXTENDEDVERBS;
end;
try
try
FShellMenu1 := GetShellContextMenu(FParent, Files, Background);
if Assigned(FShellMenu1) then
begin
FShellMenu := CreatePopupMenu;
if FUserWishForContextMenu = uwcmComplete then
OleCheckUTF8(FShellMenu1.QueryContextMenu(FShellMenu, 0, 1, USER_CMD_ID - 1, UFlags));
FShellMenu1.QueryInterface(IID_IContextMenu2, ShellMenu2); // to handle submenus.
FShellMenu1.QueryInterface(IID_IContextMenu3, ShellMenu3); // to handle submenus.
end;
except
on e: EOleError do
raise EContextMenuException.Create(e.Message);
end;
finally
Files := nil;
end;
end;
destructor TShellContextMenu.Destroy;
begin
// Restore window procedure
{$PUSH}{$HINTS OFF}
SetWindowLongPtr(FParent, GWL_WNDPROC, LONG_PTR(@OldWProc));
{$POP}
// Free global variables
ShellMenu2 := nil;
ShellMenu3 := nil;
// Free internal objects
FShellMenu1 := nil;
FreeAndNil(FFiles);
if FShellMenu <> 0 then
DestroyMenu(FShellMenu);
inherited Destroy;
end;
procedure TShellContextMenu.PopUp(X, Y: integer);
var
aFile: TFile = nil;
i: integer;
hActionsSubMenu: HMENU = 0;
cmd: UINT = 0;
iCmd: integer;
cmici: TCMInvokeCommandInfoEx;
lpici: TCMINVOKECOMMANDINFO absolute cmici;
bHandled: boolean = False;
ZVerb: array[0..255] of AnsiChar;
sVerb: string;
Result: HRESULT;
FormCommands: IFormCommands;
InnerExtActionList: TExtActionList = nil;
UserSelectedCommand: TExtActionCommand = nil;
sVolumeLabel: string;
begin
try
try
if Assigned(FShellMenu1) then
try
FormCommands := frmMain as IFormCommands;
if Assigned(FFiles) then
begin
aFile := FFiles[0];
if FBackground then // Add "Background" context menu specific items
begin
InnerExtActionList := TExtActionList.Create;
// Add commands to root of context menu
I := InnerExtActionList.Add(TExtActionCommand.Create(FormCommands.GetCommandCaption('cm_Refresh'), 'cm_Refresh', '', ''));
InsertMenuItemEx(FShellMenu, 0, PWideChar(UTF8Decode(InnerExtActionList.ExtActionCommand[I].ActionName)), 0, I + USER_CMD_ID, MFT_STRING);
// Add "Sort by" submenu
hActionsSubMenu := CreatePopupMenu;
I := InnerExtActionList.Add(TExtActionCommand.Create(FormCommands.GetCommandCaption('cm_ReverseOrder'), 'cm_ReverseOrder', '', ''));
InsertMenuItemEx(hActionsSubMenu, 0, PWideChar(UTF8Decode(InnerExtActionList.ExtActionCommand[I].ActionName)), 0, I + USER_CMD_ID, MFT_STRING);
// Add separator
InsertMenuItemEx(hActionsSubMenu, 0, nil, 0, 0, MFT_SEPARATOR);
// Add "Sort by" items
I := InnerExtActionList.Add(TExtActionCommand.Create(FormCommands.GetCommandCaption('cm_SortByAttr'), 'cm_SortByAttr', '', ''));
InsertMenuItemEx(hActionsSubMenu, 0, PWideChar(UTF8Decode(InnerExtActionList.ExtActionCommand[I].ActionName)), 0, I + USER_CMD_ID, MFT_STRING);
I := InnerExtActionList.Add(TExtActionCommand.Create(FormCommands.GetCommandCaption('cm_SortByDate'), 'cm_SortByDate', '', ''));
InsertMenuItemEx(hActionsSubMenu, 0, PWideChar(UTF8Decode(InnerExtActionList.ExtActionCommand[I].ActionName)), 0, I + USER_CMD_ID, MFT_STRING);
I := InnerExtActionList.Add(TExtActionCommand.Create(FormCommands.GetCommandCaption('cm_SortBySize'), 'cm_SortBySize', '', ''));
InsertMenuItemEx(hActionsSubMenu, 0, PWideChar(UTF8Decode(InnerExtActionList.ExtActionCommand[I].ActionName)), 0, I + USER_CMD_ID, MFT_STRING);
I := InnerExtActionList.Add(TExtActionCommand.Create(FormCommands.GetCommandCaption('cm_SortByExt'), 'cm_SortByExt', '', ''));
InsertMenuItemEx(hActionsSubMenu, 0, PWideChar(UTF8Decode(InnerExtActionList.ExtActionCommand[I].ActionName)), 0, I + USER_CMD_ID, MFT_STRING);
I := InnerExtActionList.Add(TExtActionCommand.Create(FormCommands.GetCommandCaption('cm_SortByName'), 'cm_SortByName', '', ''));
InsertMenuItemEx(hActionsSubMenu, 0, PWideChar(UTF8Decode(InnerExtActionList.ExtActionCommand[I].ActionName)), 0, I + USER_CMD_ID, MFT_STRING);
// Add submenu to context menu
InsertMenuItemEx(FShellMenu, hActionsSubMenu, PWideChar(UTF8Decode(rsMnuSortBy)), 1, 333, MFT_STRING);
// Add menu separator
InsertMenuItemEx(FShellMenu, 0, nil, 2, 0, MFT_SEPARATOR);
// Add commands to root of context menu
I := InnerExtActionList.Add(TExtActionCommand.Create(FormCommands.GetCommandCaption('cm_PasteFromClipboard'), 'cm_PasteFromClipboard', '', ''));
InsertMenuItemEx(FShellMenu, 0, PWideChar(UTF8Decode(InnerExtActionList.ExtActionCommand[I].ActionName)), 3, I + USER_CMD_ID, MFT_STRING);
// Add menu separator
InsertMenuItemEx(FShellMenu, 0, nil, 4, 0, MFT_SEPARATOR);
end
else // Add "Actions" submenu
begin
InnerExtActionList := TExtActionList.Create;
if FUserWishForContextMenu = uwcmComplete then
begin
hActionsSubMenu := CreatePopupMenu;
CreateActionSubMenu(hActionsSubMenu, InnerExtActionList, aFile, ((FFiles.Count = 1) and not (aFile.IsDirectory or aFile.IsLinkToDirectory)));
end
else
begin
CreateActionSubMenu(FShellMenu, InnerExtActionList, aFile, ((FFiles.Count = 1) and not (aFile.IsDirectory or aFile.IsLinkToDirectory)));
end;
// Add Actions submenu (Will never be empty, we always have View and Edit...)
iCmd := GetMenuItemCount(FShellMenu) - 1;
for I := 0 to iCmd do
begin
if GetMenuItemType(FShellMenu, I, True) = MFT_SEPARATOR then
Break;
end;
if FUserWishForContextMenu = uwcmComplete then
InsertMenuItemEx(FShellMenu, hActionsSubMenu, PWideChar(UTF8Decode(rsMnuActions)), I, 333, MFT_STRING);
end;
{ /Actions submenu }
end;
//------------------------------------------------------------------------------
cmd := UINT(TrackPopupMenu(FShellMenu, TPM_LEFTALIGN or TPM_LEFTBUTTON or TPM_RIGHTBUTTON or TPM_RETURNCMD, X, Y, 0, FParent, nil));
finally
if hActionsSubMenu <> 0 then
DestroyMenu(hActionsSubMenu);
end;
if (cmd > 0) and (cmd < USER_CMD_ID) then
begin
iCmd := longint(Cmd) - 1;
if Succeeded(FShellMenu1.GetCommandString(iCmd, GCS_VERBA, nil, ZVerb, SizeOf(ZVerb))) then
begin
sVerb := StrPas(ZVerb);
if SameText(sVerb, sCmdVerbRename) then
begin
if FFiles.Count = 1 then
with FFiles[0] do
begin
if not SameText(FullPath, ExtractFileDrive(FullPath) + PathDelim) then
frmMain.actRenameOnly.Execute
else // change drive label
begin
sVolumeLabel := mbGetVolumeLabel(FullPath, True);
if InputQuery(rsMsgSetVolumeLabel, rsMsgVolumeLabel, sVolumeLabel) then
mbSetVolumeLabel(FullPath, sVolumeLabel);
end;
end
else
frmMain.actRename.Execute;
bHandled := True;
end
else if SameText(sVerb, sCmdVerbCut) then
begin
frmMain.actCutToClipboard.Execute;
bHandled := True;
end
else if SameText(sVerb, sCmdVerbCopy) then
begin
frmMain.actCopyToClipboard.Execute;
bHandled := True;
end
else if SameText(sVerb, sCmdVerbNewFolder) then
begin
frmMain.actMakeDir.Execute;
bHandled := True;
end
else if SameText(sVerb, sCmdVerbPaste) or SameText(sVerb, sCmdVerbDelete) then
begin
TShellThread.Create(FParent, FShellMenu1, sVerb).Start;
bHandled := True;
end
else if SameText(sVerb, sCmdVerbCopyPath) then
begin
with TStringList.Create do
begin
for i:= 0 to FFiles.Count - 1 do
begin
sVolumeLabel:= FFiles[i].FullPath;
if UTF8Length(sVolumeLabel) >= MAX_PATH then
Add(QuoteStr(UTF16ToUTF8(UTF16LongName(sVolumeLabel))))
else begin
Add(QuoteStr(sVolumeLabel));
end;
end;
Clipboard.AsText:= TrimRightLineEnding(Text, TextLineBreakStyle);
Free;
end;
bHandled := True;
end;
end;
if not bHandled then
begin
if Assigned(FFiles) then
begin
if FBackground then
sVolumeLabel := FFiles[0].FullPath
else begin
sVolumeLabel := ExcludeTrailingBackslash(FFiles[0].Path);
end;
end;
ZeroMemory(@cmici, SizeOf(cmici));
with cmici do
begin
cbSize := SizeOf(cmici);
hwnd := FParent;
fMask := CMIC_MASK_UNICODE;
{$PUSH}{$HINTS OFF}
lpVerb := PAnsiChar(PtrUInt(cmd - 1));
{$POP}
nShow := SW_NORMAL;
if Assigned(FFiles) and (FFiles[0].Path <> FFiles[0].FullPath) then
begin
lpDirectory := PAnsiChar(CeUtf8ToSys(sVolumeLabel));
lpDirectoryW := PWideChar(UTF8ToUTF16(sVolumeLabel));
end;
end;
Result := FShellMenu1.InvokeCommand(lpici);
if not (Succeeded(Result) or (Result = COPYENGINE_E_USER_CANCELLED)) then
OleErrorUTF8(Result);
// Reload after possible changes on the filesystem.
if SameText(sVerb, sCmdVerbLink) or SameText(sVerb, sCmdVerbDelete) then
frmMain.ActiveFrame.FileSource.Reload(frmMain.ActiveFrame.CurrentPath);
// "New" submenu
if FBackground and (StrBegins(sVerb, ExtensionSeparator)) then
begin
sVolumeLabel:= frmMain.ActiveFrame.CurrentPath;
if not (TFileSystemWatcher.CanWatch([sVolumeLabel]) and frmMain.ActiveFrame.WatcherActive) then
frmMain.ActiveFrame.FileSource.Reload(sVolumeLabel);
end;
end;
end // if cmd > 0
else if (cmd >= USER_CMD_ID) then // actions sub menu
begin
if (cmd - USER_CMD_ID) < InnerExtActionList.Count then
UserSelectedCommand := InnerExtActionList.ExtActionCommand[cmd - USER_CMD_ID].CloneExtAction;
if FBackground then
begin
if SameText(UserSelectedCommand.CommandName, 'cm_PasteFromClipboard') then
TShellThread.Create(FParent, FShellMenu1, sCmdVerbPaste).Start
else
FormCommands.ExecuteCommand(UserSelectedCommand.CommandName, []);
bHandled := True;
end
else
begin
Application.QueueAsyncCall(Execute, PtrInt(UserSelectedCommand));
UserSelectedCommand := nil;
bHandled := True;
end;
end;
finally
FreeAndNil(InnerExtActionList);
FreeAndNil(UserSelectedCommand);
FreeAndNil(ContextMenuDCIcon);
end;
except
on e: EOleError do
raise EContextMenuException.Create(e.Message);
end;
if Assigned(FOnClose) then
FOnClose(Self);
end;
procedure PasteFromClipboard(Parent: HWND; const Path: String);
var
AFile: TFile;
Files: TFiles;
ShellMenu: IContextMenu;
begin
Files:= TFiles.Create(EmptyStr);
try
AFile := TFileSystemFileSource.CreateFile(EmptyStr);
AFile.FullPath := Path;
AFile.Attributes := faFolder;
Files.Add(AFile);
ShellMenu:= GetShellContextMenu(Parent, Files, True);
if Assigned(ShellMenu) then begin
TShellThread.Create(Parent, ShellMenu, sCmdVerbPaste).Start;
end;
except
on E: Exception do
MessageDlg(E.Message, mtError, [mbOK], 0);
end;
FreeAndNil(Files);
end;
end.