喫茶XRAY [Mr.XRAY掲示板]

ポップアップメニューを表示して，そのメニューのウィンドウの上で
マウスの右ボタンクリックで，別のポップアップメニューを表示するサンプルです．

(1) 新規にプロジェクトを作成して，保存します．
(2) Delphi のソースコードの Menu.pas をプロジェクトのフォルダにコピーします．
(3) Menu.pas に，以下の 1 行を追加します．
    TPM_RECURSE を追加すると右クリックで閉じなくなります．

    procedure TPopupMenu.Popup(X, Y: Integer);
      ...
      ...
      AFlags := AFlags or TPM_RECURSE;  //追加
      TrackPopupMenu(FItems.Handle, AFlags, X, Y, 0 { reserved }, PopupList.Window, nil);
    end;

(4) TPopupMenu コンポを 2 つフォームに配置して，適当に項目を作成します．
(5) TPanel コンポを 1 つ配置します．
(5) Form1 の PopupMenu プロパティを PopupMenu1 にします．
(6) テスト用のコードを以下のようにします．

面白そうなので，サブのポップアップメニューをいくつでも表示できるようにして
います．
動作確認は，Windows 7 U64(SP1) + Delphi XE(UP1) Pro です．

unit Unit1;

interface

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

type
    TPopupListEx = class(TPopupList)
    protected
      procedure WndProc(var Message: TMessage) ; override;
    end;

  TForm1 = class(TForm)
    Button1: TButton;
    PopupMenu1: TPopupMenu;
    Item_0: TMenuItem;
    Item_1: TMenuItem;
    Item_2: TMenuItem;
    Item_3: TMenuItem;
    N1: TMenuItem;
    Panel1: TPanel;
    PopupMenu2: TPopupMenu;
    Item_20: TMenuItem;
    Item_21: TMenuItem;
    Item_22: TMenuItem;
    Item_23: TMenuItem;
  private
    { Private 宣言 }
  protected
    procedure WMExitMenuLoop(var Message: TWMExitMenuLoop);
      message WM_EXITMENULOOP;
    procedure WMEnterMenuLoop(var Message: TWMEnterMenuLoop);
      message WM_ENTERMENULOOP;
    procedure WMMenuSelect(var Message: TWMMenuSelect);
      message WM_MENUSELECT;
  public
    { Public 宣言 }
    procedure WMApp100(var Message: TMessage); message WM_APP+100;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  hMouseHook : HHOOK;

//-----------------------------------------------------------------------------
//  マウスフックのコールバック関数
//  Form1にメッセージを送る
//  ポップアップメニュー上のマウスカーソル位置は，フックでないと検出不可
//-----------------------------------------------------------------------------
function MouseHookProc(nCode: Integer; wPar: WPARAM; lPar:LPARAM):
  Integer; stdcall;
var
  MousePos : TPoint;
begin
  if nCode < 0 then begin
    Result := CallNextHookEx(hMouseHook, nCode, wPar, lPar);
  end else begin
    if nCode = HC_ACTION then begin
      MousePos := PMouseHookStruct(lPar)^.pt;
      PostMessage(Form1.Handle, WM_APP+100, wPar, MakeLParam(MousePos.X, MousePos.Y));
      //PopupMenuのOnClickイベントを使用しない場合はResult := -1にしてExit;
      //このコードにすると，TMenuItem.OnClickは検出できなくなる
      Result := -1;
      exit;
    end;
    Result := CallNextHookEx(hMouseHook, nCode, wPar, lPar);
  end;
end;

//-----------------------------------------------------------------------------
//  PopupMenuが表示された時のメッセージ処理
//  マウスフックを開始する
//-----------------------------------------------------------------------------
procedure TForm1.WMEnterMenuLoop(var Message: TWMEnterMenuLoop);
begin
  if hMouseHook = 0 then begin
    hMouseHook := SetWindowsHookEx(WH_MOUSE, @MouseHookProc, 0, GetCurrentThreadID);
  end;
end;

//-----------------------------------------------------------------------------
//  PopupMenuが閉じた時のメッセージ処理
//  マウスフックを終了して，PopupMeneを全て閉じる
//-----------------------------------------------------------------------------
procedure TForm1.WMExitMenuLoop(var Message: TWMExitMenuLoop);
var
  MousePos : TPoint;
begin
  GetCursorPos(MousePos);

  //1つでも閉じれば全て閉じることにする
  SendMessage(Handle, WM_APP+100, WM_LBUTTONUP, MakeLParam(MousePos.X, MousePos.Y));
  if hMouseHook <> 0 then begin
    UnhookWindowsHookEx(hMouseHook);
    hMouseHook := 0;
  end;
end;

//-----------------------------------------------------------------------------
//  PopupMenuで項目を選択された時のメッセージ処理
//  選択されている項目名を表示
//  実際に選択したかで項目を取得するには，WM_LBUTTONUPがいいかも知れない
//  ただし，どの項目を選択したかは，このWM_MENUSELECTまたは
//  TPopupList.WndProc内でないと取得は困難だろう
//-----------------------------------------------------------------------------
procedure TForm1.WMMenuSelect(var Message: TWMMenuSelect);
var
  i        : Integer;
  MenuItem : TMenuItem;
begin
  if (Message.MenuFlag = $FFFF) and (Message.Menu = 0) then exit;

  Panel1.Caption := '';
  for i := 0 to ComponentCount - 1 do begin
    if Components[i].ClassName = 'TPopupMenu' then begin
      if TPopupMenu(Components[i]).Handle = Message.Menu then begin
        MenuItem := TPopupMenu(Components[i]).FindItem(Message.IDItem, fkCommand);
        Panel1.Caption := MenuItem.Name;
        Break;
      end;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  ローカルマウスフックのメッセージを受信
//-----------------------------------------------------------------------------
procedure TForm1.WMApp100(var Message: TMessage);
var
  X         : Integer;
  Y         : Integer;
  hPopupWnd : HWND;
begin
  X := LOWORD(Message.LParam);
  Y := HIWORD(Message.LParam);

  //左ボタンUP(項目を選択した時)はTPopupMenuを全て閉じることにする
  if (Message.WParam = WM_LBUTTONUP) then begin
    while True do begin
      hPopupWnd := FindWindow('#32768', nil);
      if hPopupWnd = 0 then break;

      SendMessage(hPopupWnd, WM_CLOSE, 0, 0);
      Application.ProcessMessages;
      Sleep(1);
    end;
  end else
  //右ボタンUPでは新しくTPopupMenuを表示する
  if (Message.WParam = WM_RBUTTONUP) then begin
    PopupMenu2.Popup(X, Y);
  end;
end;

//-----------------------------------------------------------------------------
//  PopupMenu内部のPopupListのメッセージ処理
//  これらのメッセージを受信したら，アプリのアクティブなフォームにメッセージを送る
//-----------------------------------------------------------------------------

{ TPopupListEx }

procedure TPopupListEx.WndProc(var Message: TMessage);
begin
  if Screen.Activeform <> nil then begin
    if Message.Msg = WM_ENTERMENULOOP then begin
      Screen.ActiveForm.Perform(WM_ENTERMENULOOP, Message.WParam, Message.LParam);
    end else
    if Message.Msg = WM_EXITMENULOOP then begin
      Screen.ActiveForm.Perform(WM_EXITMENULOOP, Message.WParam, Message.LParam);
    end;
    if Message.Msg = WM_MENUSELECT then begin
      Screen.ActiveForm.Perform(WM_MENUSELECT, Message.WParam, Message.LParam);
    end;
  end;
  inherited;
end;

initialization
  Popuplist.Free;
  PopupList:= TPopupListEx.Create;

end.

下図は，設計時と実行した画面です．
Panel1 に，(左ボタンDOWNまたは矢印キー等で)選択の項目名を表示します．