Пример использования IContextMenu и IContextMenu2

Операционная система: Windows XP

Текст файла Project1.dpr

program Project1;

uses
Forms,
Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

Текст файла Unit1.pas

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);
    procedure Edit1Change(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
protected
    procedure WndProc(var Msg: TMessage); override;
private
public
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

uses ShlObj, ActiveX;

var
ICM2: IContextMenu2;
DesktopFolder: IShellFolder;
Malloc: IMalloc;

procedure TForm1.FormCreate(Sender: TObject);
begin
OleInitialize(nil);
SHGetDesktopFolder(DesktopFolder);
SHGetMalloc(Malloc)
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
OleUninitialize
end;

procedure TForm1.WndProc(var Msg: TMessage);
begin
with Msg do
if ((Msg=WM_INITMENUPOPUP) or (Msg=WM_DRAWITEM) or (Msg=WM_MENUCHAR)
or (Msg=WM_MEASUREITEM)) and Assigned(ICM2) then
begin
    ICM2.HandleMenuMsg(Msg,wParam,lParam);
    Result:=0
end;
inherited
end;

procedure ShowICM(Handle: hWnd; X,Y: integer; FileName: string);
var
Command: LongBool;
ICmd: integer;
P: TPoint;
pchEaten,dwAttributes: cardinal;
ItemIDList: PItemIDList;
ShellFolder: IShellFolder;
Menu: HMenu;
ICM: IContextMenu;
ICI: TCMInvokeCommandInfo;
begin
DesktopFolder.ParseDisplayName(Handle,nil,
StringToOleStr(ExtractFileDir(FileName)),pchEaten,ItemIDList,dwAttributes);
DesktopFolder.BindToObject(ItemIDList,nil,IID_IShellFolder,ShellFolder);
if ShellFolder=nil then ShellFolder:=DesktopFolder;
ShellFolder.ParseDisplayName(Handle,nil,
StringToOleStr(ExtractFileName(FileName)),pchEaten,ItemIDList,dwAttributes);
if ItemIDList=nil then
ShellFolder.ParseDisplayName(Handle,nil,
StringToOleStr(FileName),pchEaten,ItemIDList,dwAttributes);
if ItemIDList=nil then ShellFolder.CreateViewObject(Handle,IID_IContextMenu,ICM)
else ShellFolder.GetUIObjectOf(Handle,1,ItemIDList,IID_IContextMenu,nil,ICM);
if ItemIDList<>nil then Malloc.Free(ItemIDList);
if ICM=nil then Exit;
P.X:=X; P.Y:=Y;
Windows.ClientToScreen(Handle,P);
Menu:=CreatePopupMenu;
try
    ICM.QueryContextMenu(Menu,0,1,$7FFF,CMF_EXPLORE);
    ICM.QueryInterface(IID_IContextMenu2,ICM2);
    try
      Command:=TrackPopupMenu(Menu,TPM_LEFTALIGN or TPM_LEFTBUTTON or TPM_RIGHTBUTTON or TPM_RETURNCMD,P.X,P.Y,0,Handle,nil);
    finally
      ICM2:=nil
    end;
    if Command then
    begin
      ICmd:=Longint(Command)-1;
      FillChar(ICI,SizeOf(ICI),#0);
      with ICI do
      begin
        ICI.cbSize:=SizeOf(ICI);
        ICI.hwnd:=Handle;
        ICI.lpVerb:=MakeIntResource(ICmd);
        ICI.nShow:=SW_SHOWNORMAL
      end;
      ICM.InvokeCommand(ICI)
    end
finally
    DestroyMenu(Menu)
end
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then Edit1.Text:=OpenDialog1.FileName
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button2.Enabled then ShowICM(Handle,X,Y,Edit1.Text)
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
Button2.Enabled:=FileExists(Edit1.Text) or DirectoryExists(Edit1.Text)
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
ShowICM(Handle,Edit1.Top,Edit1.Left,Edit1.Text)
end;

end.

Текст файла Uni1.dfm

object Form1: TForm1
Left = 191
Top = 114
Width = 640
Height = 91
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
OnDestroy = FormDestroy
OnMouseUp = FormMouseUp
PixelsPerInch = 96
TextHeight = 13
object Edit1: TEdit
    Left = 4
    Top = 4
    Width = 625
    Height = 21
    TabOrder = 0
    OnChange = Edit1Change
end
object Button1: TButton
    Left = 4
    Top = 28
    Width = 75
    Height = 25
    Caption = #1060#1072#1081#1083
    TabOrder = 1
    OnClick = Button1Click
end
object Button2: TButton
    Left = 80
    Top = 28
    Width = 75
    Height = 25
    Caption = #1052#1077#1085#1102
    Enabled = False
    TabOrder = 2
    OnClick = Button2Click
end
object OpenDialog1: TOpenDialog
    Left = 600
    Top = 28
end
end

загрузка файла: icm_icm2.exe, icm_icm2.exe (SFX-архив)

размер: 50 КБ