// hier ist mein problem-kind
procedure TMain.InvokeContextMenu(
const Owner: TWinControl;
const Path:
String;
const X, Y: Integer);
var
// Item: Integer;
DeskFolder, Folder: IShellFolder;
Eaten, Attributes: ULONG;
PIDL, FolderpIdl: PItemIDList;
Menu: HMENU;
Pos: TPoint;
Cmd: DWORD;
CommandInfo: TCMInvokeCommandInfo;
ContextMenu: IContextMenu;
ContextMenu2: IContextMenu2;
ContextMenu3: IContextMenu3;
APath:
String;
aFileName:
String;
aDrive:
String;
aContextMenu: Boolean;
begin
ContextMenu2 :=
nil;
ContextMenu3 :=
nil;
aContextMenu := False;
aDrive := ExtractFileDrive(Path);
APath := ExtractFilePath(Path);
if (APath = aDrive)
then
APath := IncludeTrailingPathDelimiter(APath);
aFileName := ExtractFileName(Path);
// IShellFolder for Desktop folder (root)
if Succeeded(SHGetDesktopFolder(DeskFolder))
then
begin
// Item ID List for the folder that the file or folder is in
Attributes := 0;
if Succeeded(DeskFolder.ParseDisplayName(INVALID_HANDLE_VALUE,
nil,
PWideChar(WideString(APath)), Eaten, FolderpIdl, Attributes))
then
begin
// IShellFolder for the folder the file is in
Attributes := 0;
if Succeeded(DeskFolder.BindToObject(FolderpIdl,
nil, IShellFolder,
Folder))
then
if (Length(aFileName) > 0)
then
// Item ID List for the file or folder, relative to the folder it is in
if Succeeded(Folder.ParseDisplayName(INVALID_HANDLE_VALUE,
nil,
PWideChar(WideString(aFileName)), Eaten, PIDL, Attributes))
then
begin
// connect IContextMenu with local PIDL ContextMenu
aContextMenu := Succeeded(Folder.GetUIObjectOf(INVALID_HANDLE_VALUE,
1, PIDL, IContextMenu,
nil, ContextMenu));
CoTaskMemFree(PIDL);
end;
// try to fallback to system context menu
// an dieser stelle hüpft der code wenn man "Eigenschaften" von Laufwerken auswählt.
if (
not aContextMenu)
then
// connect IContextMenu with local FolderPIDL ContextMenu
aContextMenu := Succeeded(DeskFolder.GetUIObjectOf(INVALID_HANDLE_VALUE,
1, FolderpIdl, IContextMenu,
nil, ContextMenu));
CoTaskMemFree(FolderpIdl);
end;
end;
if (
not aContextMenu)
then
Exit;
Menu := CreatePopupMenu;
try
// Populate our menu with shortcut items
if (Cardinal(ContextMenu.QueryContextMenu(Menu, 0, 1, $7FFF, CMF_EXPLORE))
and $80000000) = 0
then
begin
// ContextMenu2 used in WndProc
if (ContextMenu.QueryInterface(IContextMenu2, ContextMenu2) = NO_ERROR)
or
(ContextMenu.QueryInterface(IContextMenu3, ContextMenu3) = NO_ERROR)
then
try
Pos.X := X;
Pos.Y := Y;
Winapi.Windows.ClientToScreen(Owner.Handle, Pos);
// launch the menu
Bool(Cmd) := TrackPopupMenu(Menu, TPM_LEFTBUTTON
or TPM_RIGHTBUTTON
or
TPM_RETURNCMD, Pos.X, Pos.Y, 0,
Handle,
nil);
finally
// clear so that we don't intervene every owner drawn menu item message in
// WndProc
ContextMenu2 :=
nil;
ContextMenu3 :=
nil;
end;
// Invoke command if we have one
if Bool(Cmd)
then
begin
FillChar(CommandInfo, SizeOf(CommandInfo), 0);
CommandInfo.cbSize := SizeOf(CommandInfo);
CommandInfo.HWnd :=
Handle;
CommandInfo.lpVerb := PAnsiChar(MakeIntResource(Cmd - 1));
CommandInfo.fMask := CMIC_MASK_ICON
or CMIC_MASK_UNICODE
or
CMIC_MASK_ASYNCOK
or CMIC_MASK_NOZONECHECKS;
CommandInfo.nShow := SW_SHOWNORMAL;
OleCheck(ContextMenu.InvokeCommand(CommandInfo));
end;
end;
finally
DestroyMenu(Menu);
end;
end;
// das menu wird hiermit eingeleitet.
// es wird immer der komplette pfad übermittelt.
// für laufwerke wird der slash abgeschnitten.
procedure TMain.LeftViewMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
S:
String;
begin
if Button = mbRight
then
if LeftView.Selected <>
nil then
begin
S := LeftShellItem(LeftView.Selected.
Index).FullPath;
if S[Length(S)] = '
\'
then
S := Copy(S, 1, Length(S) - 1);
InvokeContextMenu(Self, S, X, Y);
end;
end;