如何检测右键单击带有 WM_MENURBUTTONUP 的 TMenuItem？

Question

在 Windows 10 上的 32 位 Delphi 11 VCL 应用程序中，我使用 TApplicationEvents 组件来捕获 Windows 消息。不幸的是，当我右键单击 TPopupMenu MenuItem 时，TApplicationEvents 似乎对 WM_MENURBUTTONUP 消息没有反应：

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
begin
  case Msg.message of
      Winapi.Messages.WM_MENURBUTTONUP: CodeSite.Send('TForm1.ApplicationEvents1Message: WM_MENURBUTTONUP');
  end;
end;

Microsoft documentation 说：

WM_MENURBUTTONUP 消息
当光标在菜单项上时用户释放鼠标右键时发送。

作为替代方案，WM_COMMAND 通过左击和右击发送。但是，出于特定目的，我只需要在右键单击菜单项时做出反应。

Answer 1

documentation 的引用部分解释了为什么您没有看到此消息：

在用户 [...]

时发送

TApplicationEvents.OnMessage 事件只能检测 已发布 消息，不能检测 已发送 消息。

TMainMenu

所以如果你想检测这个消息，你可以添加

  protected
    procedure WndProc(var Message: TMessage); override;

到你的表单类，实现如下：

procedure TForm1.WndProc(var Message: TMessage);
begin
  if Message.Msg = WM_MENURBUTTONUP then
    ShowMessage('rbu')
  else
    inherited
end;

试试，例如：

procedure TForm1.WndProc(var Message: TMessage);
begin
  if Message.Msg = WM_MENURBUTTONUP then
  begin
    var MI := Menu.FindItem(Message.LParam, fkHandle);
    if Assigned(MI) and InRange(Message.WParam, 0, MI.Count - 1) then
      ShowMessageFmt('Menu item "%s" right clicked.', [MI.Items[Message.WParam].Caption]);
  end
  else
    inherited
end;

TPopupMenu

对于TPopupMenu，您需要编写自己的TPopupList后代：

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

{ TPopupListEx }

procedure TPopupListEx.WndProc(var Message: TMessage);
begin
  if Message.Msg = WM_MENURBUTTONUP then
    ShowMessage('rbu')
  else
    inherited
end;

initialization
  FreeAndNil(PopupList);
  PopupList := TPopupListEx.Create;

并确保将TPopupMenu 的TrackButton 设置为tbLeftButton。

如果您有多个弹出菜单，您可以尝试这样的操作（未完全测试）：

procedure TPopupListEx.WndProc(var Message: TMessage);
begin
  if Message.Msg = WM_MENURBUTTONUP then
  begin
    for var X in PopupList do
      if TObject(X) is TPopupMenu then
      begin
        OutputDebugString(PChar(TPopupMenu(X).Name));
        var MI: TMenuItem;
        if TPopupMenu(X).Handle = HMENU(Message.LParam) then
          MI := TPopupMenu(X).Items
        else
          MI := TPopupMenu(X).FindItem(HMENU(Message.LParam), fkHandle);
        if Assigned(MI) and InRange(Message.WParam, 0, MI.Count - 1) then
        begin
          ShowMessageFmt('Menu item "%s" right clicked.', [MI.Items[Message.WParam].Caption]);
          Break;
        end;
      end;
  end
  else
    inherited
end;