この発言は
#01162　Atelier Macchan さんのContextMenuの表示
に対するコメントです





コンテキストメニューを「TPopupMenu」から継承したコンポーネントに
しました。これによって各コントロールの「PopupMenu」プロパティに
セットするだけで使えますので、より便利かと思います。(^-^)
（コンポーネントパレットの「Samples」タブに追加されます。）

またTPopupMenuが元なので、当然「Items」プロパティで独自のメニューを
作れますが、その場合はコンテキストメニューの後ろに独自メニューが
表示されます。(^-^)

このコンポーネント独自のプロパティは以下の２つです。
#1162の手続きと違ってディレクトリとファイル名を別々に設定します。

Directory: String;     // フォルダのパス
Files    : TStrings;   // ファイル名(サブフォルダを含んでも良い)
（Directory,Filesに何も設定しないとマイコンピュータと解釈します。）

例）DelphiのDemosフォルダの２つのプロジェクトファイルのメニューを開く

フォームにContextMenuを置いてフォームの「PopupMenu」プロパティに
「ContextMenu1」を設定し、「OnPopup」イベントでフォルダとファイル名の
プロパティを設定します。
procedure TForm1.ContextMenu1Popup(Sender: TObject);
begin
  ContextMenu1.Directory := 'C:\Program Files\Borland\Delphi5\Demos';
  ContextMenu1.Files.Clear;
  ContextMenu1.Files.Add('AppEvents\appevents.dpr');
  ContextMenu1.Files.Add('Coolstuf\webbrows.dpr');
end;

これで後は実行してフォームを右クリックするだけです。(^-^)

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

----------------------------- ContMenu.pas -----------------------------
unit ContMenu;

interface
uses
  SysUtils, Windows, Messages, ShellAPI, ShlObj, ActiveX, Menus, Classes;

type
  TContextMenu = class(TPopupMenu)
  private
    FFiles: TStrings;
    FDirectory: String;
    procedure SetFiles(const Value: TStrings);
  public
    constructor Create(Owner: TComponent); override;
    destructor Destroy; override;
    procedure Popup(X, Y: Integer); override;
  published
    property Directory: String read FDirectory write FDirectory;
    property Files: TStrings read FFiles write SetFiles;
  end;

procedure Register;

implementation

var
  ctm2: IContextMenu2;
  OldWinProc: TFarProc;

procedure Register;
begin
  RegisterComponents('Samples', [TContextMenu]);
end;

{ TContextMenu }

//  送るメニューのお約束
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;

constructor TContextMenu.Create(Owner: TComponent);
begin
  inherited;
  FFiles := TStringList.Create;
end;

destructor TContextMenu.Destroy;
begin
  FFiles.Free;
  inherited;
end;

procedure TContextMenu.Popup(X, Y: Integer);
var
  ctm: IContextMenu;
  pidls: array of PItemIDList;
  sfDesktop,
  sfFolder: IShellFolder;
  ici: TCMInvokeCommandInfo;
  i: Integer;
  Count,
  Attr: Cardinal;
  Command: BOOL;
  CmdIndex: Integer;
  WFileName: WideString;
  FFileName: String;
begin
  if Assigned(OnPopup) then OnPopup(Self);
  if FAILED(SHGetDesktopFolder(sfDesktop)) then Exit;
  //  各ファイルのPItemIDListを取得
  if FFiles.Count = 0 then
   begin
    SetLength(pidls, 1);
    if FDirectory = '' then             //  マイ コンピュータ
     begin
      if FAILED(SHGetSpecialFolderLocation(0, CSIDL_DRIVES, pidls[0])) then
        Exit;
      if FAILED(SHGetDesktopFolder(sfFolder)) then Exit;
     end
    else
     begin
      FFileName := ExtractFileDir(FDirectory);
      if FDirectory = FFileName then    //  ドライブ
       begin
        if FAILED(SHGetSpecialFolderLocation(0, CSIDL_DRIVES, pidls[0])) then
          Exit;
        if FAILED(sfDesktop.BindToObject(pidls[0], nil, IID_IShellFolder,
                                         Pointer(sfFolder))) then Exit;
        WFileName := FFileName;
        if FAILED(sfFolder.ParseDisplayName(WindowHandle, nil,
                    PWideChar(WFileName), Count, pidls[0], Attr)) then Exit;
       end
      else                              //  フォルダ
       begin
        WFileName := FFileName;
        if FAILED(sfDesktop.ParseDisplayName(WindowHandle, nil,
                    PWideChar(WFileName), Count, pidls[0], Attr)) then Exit;
        if FAILED(sfDesktop.BindToObject(pidls[0], nil, IID_IShellFolder,
                                         Pointer(sfFolder))) then Exit;
        WFileName := ExtractFileName(FDirectory);
        if FAILED(sfFolder.ParseDisplayName(WindowHandle, nil,
                    PWideChar(WFileName), Count, pidls[0], Attr)) then Exit;
       end;
     end;
   end
  else
   begin
    //  ファイル or フォルダ
    SetLength(pidls, FFiles.Count);
    WFileName := FDirectory;
    if FAILED(sfDesktop.ParseDisplayName(WindowHandle, nil,
                    PWideChar(WFileName), Count, pidls[0], Attr)) then Exit;
    if FAILED(sfDesktop.BindToObject(pidls[0], nil, IID_IShellFolder,
                                     Pointer(sfFolder))) then Exit;
    for i := 0 to FFiles.Count - 1 do
     begin
      WFileName := FFiles[i];
      if FAILED(sfFolder.ParseDisplayName(WindowHandle, nil,
                    PWideChar(WFileName), Count, pidls[i], Attr)) then Exit;
     end;
   end;
  //  コンテキストメニューの取得
  if FAILED(sfFolder.GetUIObjectOf(WindowHandle, Length(pidls), pidls[0],
                            IID_IContextMenu, nil, Pointer(ctm))) then Exit;
  //  送るメニューの取得
  if FAILED(ctm.QueryInterface(IID_IContextMenu2, ctm2)) then Exit;
  OldWinProc := Pointer(SetWindowLong(WindowHandle, GWL_WNDPROC,
                        Integer(@SendToProc)));
  try
    try
      //  コンテキストメニューをポップアップメニューへ設定
      if FAILED(ctm.QueryContextMenu(Handle, 0, Items.Count + 1, $7FFF,
                                     CMF_EXPLORE)) then Exit;
      //  コンテキストメニューを開く
      Command := TrackPopupMenu(Handle, TPM_LEFTALIGN   or TPM_LEFTBUTTON or
                                        TPM_RIGHTBUTTON or TPM_RETURNCMD,
                                X, Y, 0, WindowHandle, nil);
      if Command then
       begin
        CmdIndex := Integer(Command) - 1;
        if CmdIndex < Items.Count then
         begin
          Items[CmdIndex].Click;
          Exit;
         end;
        //  選択されたコマンドを実行
        FillChar(ici, sizeof(TCMInvokeCommandInfo), 0);
        ici.cbSize       := SizeOf(TCMInvokeCommandInfo);
        ici.hwnd         := Handle;
        ici.lpVerb       := MAKEINTRESOURCE(CmdIndex - Items.Count);
        ici.nShow        := SW_SHOWNORMAL;
        ctm.InvokeCommand(ici);
       end;
    finally
      for i := GetMenuItemCount(Handle) - Items.Count - 1 downto 0 do
        DeleteMenu(Handle, i, MF_BYPOSITION);
    end;
  finally
    if Assigned(OldWinProc) then
      SetWindowLong(WindowHandle, GWL_WNDPROC, Integer(OldWinProc));
    ctm2 := nil;
  end;
end;

procedure TContextMenu.SetFiles(const Value: TStrings);
begin
  FFiles.Assign(Value);
end;

initialization
  OleInitialize(nil);

finalization
  OleUninitialize;

end.
 


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

Original document by Atelier Macchan 氏 ID:(JBC01362)

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