この発言に対し以下のコメントが寄せられています

#01165　Atelier Macchan さん　RE:ContextMenuの表示

#01166　Atelier Macchan さん　RE:ContextMenuの表示(コンポーネント編)






エクスプローラの右クリックで開くコンテキストメニューを
アプリケーションから開くようにする手続きです。
(Delphi4とDelphi5で動作します。)

これはインターネットでサンプルを探して自分なりに組んだものでして
一応動作はしますが、私自身Shellについてはまだまだ理解不足なので
不備があれば、ご指摘頂ければ幸いです。

パラメータは以下の通りです。
Handle   : メニューを開くコントロールのWindowハンドル
AFileName: ファイル名（フルパス）の配列
　　　　　 空文字(''）のみでマイコンピュータのメニューを開きます。

例１）Delphiの「deploy.txt」のメニューを開く
  PopupContextMenu(Handle, ['C:\Program Files\Borland\Delphi5\deploy.txt']);

例２）FileListBoxで複数選択されたファイルのメニューを開く
procedure TForm1.FileListBox1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  i, j: Integer;
  S: String;
  Files: array of String;
begin
  if (Button <> mbRight) or (FileListBox1.SelCount = 0) then Exit;
  SetLength(Files, FileListBox1.SelCount);
  j := 0;
  for i := 0 to FileListBox1.Items.Count - 1 do
    if FileListBox1.Selected[i] then
     begin
      S := FileListBox1.Directory;
      if not IsPathDelimiter(S, Length(S)) then
        S := S + '\';
      Files[j] := S + FileListBox1.Items[i];
      Inc(j);
     end;
  PopupContextMenu(FileListBox1.Handle, Files);
end;

--------------------------------------------------------------------------
uses節に「ShlObj」「ActiveX」を追加します。

implementation
var
  ctm2: IContextMenu2;
  OldWinProc: TFarProc;

//  送るメニューのお約束
function SendToProc(Wnd: HWND; Msg: UINT; WParam, LParam: Integer)
  : LRESULT; stdcall;
begin
  case Msg of
    WM_INITMENUPOPUP, WM_DRAWITEM, WM_MEASUREITEM:
     begin
      ctm2.HandleMenuMsg(Msg, wParam, lParam);
      Result := 0;
     end;
    else
      Result := CallWindowProc(OldWinProc, Wnd, Msg, WParam, LParam);
  end;
end;

//  コンテキストメニューを開く
procedure PopupContextMenu(const Handle: THandle; const AFileName:
    array of String);
var
  ctm: IContextMenu;
  pidls: array of PItemIDList;
  sfDesktop,
  sfFolder: IShellFolder;
  ici: TCMInvokeCommandInfo;
  i: Integer;
  Menu: HMENU;
  pt: TPoint;
  Count,
  Attr: Cardinal;
  FileCount: Integer;
  Command: BOOL;
  Ret: HRESULT;
  WFileName: WideString;
  FDirName,
  FFileName: String;
begin
  FileCount := Length(AFileName);
  if FAILED(SHGetDesktopFolder(sfDesktop)) then Exit;
  //  各ファイルのPItemIDListを取得
  SetLength(pidls, FileCount);
  WFileName := '';
  for i := 0 to FileCount - 1 do
   begin
    FDirName  := ExtractFileDir (AFileName[i]);
    FFileName := ExtractFileName(AFileName[i]);
    if FFileName = '' then  //  ドライブ
     begin
      if FAILED(SHGetSpecialFolderLocation(0, CSIDL_DRIVES, pidls[i])) then
        Exit;
      FFileName := FDirName;
     end
    else
     begin
      WFileName := FDirName;
      if FAILED(sfDesktop.ParseDisplayName(Handle, nil, PWideChar(WFileName),
                                           Count, pidls[i], Attr)) then Exit;
     end;
    if FDirName = '' then   //  マイ コンピュータ
      if FAILED(SHGetDesktopFolder(sfFolder)) then
        Exit
      else
    else
     begin
      Ret := sfDesktop.BindToObject(pidls[i], nil, IID_IShellFolder,
                                    Pointer(sfFolder));
      if FAILED(Ret) then Exit;
      WFileName := FFileName;
      if FAILED(sfFolder.ParseDisplayName(Handle, nil, PWideChar(WFileName),
                                          Count, pidls[i], Attr)) then Exit;
     end;
   end;
  //  コンテキストメニューの取得
  Ret := sfFolder.GetUIObjectOf(Handle, FileCount, pidls[0], IID_IContextMenu,
                                nil, Pointer(ctm));
  if FAILED(Ret) then Exit;
  //  送るメニューの取得
  if FAILED(ctm.QueryInterface(IID_IContextMenu2, ctm2)) then Exit;
  OldWinProc := Pointer(SetWindowLong(Handle, GWL_WNDPROC,
                                      Integer(@SendToProc)));
  try
    Menu := CreatePopupMenu;
    try
      //  コンテキストメニューをポップアップメニューへ設定
      if FAILED(ctm.QueryContextMenu(Menu, 0, 1, $7FFF, CMF_EXPLORE)) then
        Exit;
      //  コンテキストメニューを開く
      GetCursorPos(pt);
      Command := TrackPopupMenu(Menu, TPM_LEFTALIGN   or TPM_LEFTBUTTON or
                                      TPM_RIGHTBUTTON or TPM_RETURNCMD,
                                pt.x, pt.y, 0, Handle, nil);
      if Command then
       begin
        //  選択されたコマンドを実行
        FillChar(ici, sizeof(TCMInvokeCommandInfo), 0);
        ici.cbSize       := SizeOf(TCMInvokeCommandInfo);
        ici.hwnd         := Handle;
        ici.lpVerb       := MAKEINTRESOURCE(Integer(Command) - 1);
        ici.nShow        := SW_SHOWNORMAL;
        ctm.InvokeCommand(ici);
       end;
    finally
      DestroyMenu(Menu);
    end;
  finally
    if Assigned(OldWinProc) then
      SetWindowLong(Handle, GWL_WNDPROC, Integer(OldWinProc));
    ctm2 := nil;
  end;
end;

initialization
  OleInitialize(nil);

finalization
  OleUninitialize;

end.

                          JBC01362 アトリエ まっちゃん
                                 「うたた寝子」
                                   http://www.people.or.jp/~macchan/
 


- FDELPHI  MES(16):玉石混淆みんなで作るSample蔵【見本蓄積】 00/09/24 -

Original document by Atelier Macchan 氏 ID:(JBC01362)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。