ViewFD
На главную   Почта

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

Компилятор: Borland Delphi 7

Операционная система: 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 КБ

  Вверх