在菜单项单击时检测鼠标左键/右键？

Question

在Delphi XE2中，如何检测用户是用鼠标左键还是右键单击弹出菜单项？

Answer 1

使用此单元，将其作为组件安装并替换标准的TPopupMenu，后者添加了OnMenuRightClick 事件。

unit RCPopupMenu;

interface

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

type
  TMenuRightClickEvent = procedure (Sender: TObject; Item: TMenuItem) of object;

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

  TRCPopupMenu = class(TPopupMenu)
  private
    FOnMenuRightClick: TMenuRightClickEvent;
  protected
    function DispatchRC(aHandle: HMENU; aPosition: Integer): Boolean;
    procedure RClick(aItem: TMenuItem);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Popup(X, Y: Integer); override;
  published
    property OnMenuRightClick: TMenuRightClickEvent read FOnMenuRightClick write FOnMenuRightClick;
  end;

procedure Register;

var
  RCPopupList: TRCPopupList;

implementation

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

{ TRCPopupList }

procedure TRCPopupList.WndProc(var Message: TMessage);
var
  i: Integer;
  pm: TPopupMenu;
begin
  if Message.Msg = WM_MENURBUTTONUP then
  begin
    for I := 0 to Count - 1 do
    begin
      pm := TPopupMenu(Items[i]);
      if pm is TRCPopupMenu then
        if TRCPopupMenu(Items[i]).DispatchRC(Message.lParam, Message.wParam) then
          Exit;
    end;
  end;
  inherited WndProc(Message);
end;

{ TRCPopupMenu }

constructor TRCPopupMenu.Create(AOwner: TComponent);
begin
  inherited;
  PopupList.Remove(Self);
  RCPopupList.Add(Self);
end;

destructor TRCPopupMenu.Destroy;
begin
  RCPopupList.Remove(Self);
  PopupList.Add(Self);
  inherited;
end;

function TRCPopupMenu.DispatchRC(aHandle: HMENU; aPosition: Integer): Boolean;
begin
  Result := False;
  if Handle = aHandle then
  begin
    RClick(Items[aPosition]);
    Result := True;
  end;
end;

procedure TRCPopupMenu.Popup(X, Y: Integer);
const
  Flags: array[Boolean, TPopupAlignment] of Word =
    ((TPM_LEFTALIGN, TPM_RIGHTALIGN, TPM_CENTERALIGN),
    (TPM_RIGHTALIGN, TPM_LEFTALIGN, TPM_CENTERALIGN));
  Buttons: array[TTrackButton] of Word = (TPM_RIGHTBUTTON, TPM_LEFTBUTTON);
var
  AFlags: Integer;
begin
  DoPopup(Self);
  AFlags := Flags[UseRightToLeftAlignment, Alignment] {or Buttons[TrackButton]};
  if (Win32MajorVersion > 4) or ((Win32MajorVersion = 4) and (Win32MinorVersion > 0)) then
  begin
    AFlags := AFlags or (Byte(MenuAnimation) shl 10);
    AFlags := AFlags or TPM_RECURSE;
  end;
  TrackPopupMenuEx(Items.Handle, AFlags, X, Y, RCPopupList.Window, nil);
end;

procedure TRCPopupMenu.RClick(aItem: TMenuItem);
begin
  if Assigned (FOnMenuRightClick) then
    FOnMenuRightClick(Self, aItem);
end;

var
  oldPL: TPopupList;

initialization
  RCPopupList := TRCPopupList.Create;
finalization
  RCPopupList.Free;

end.

然后您可以使用OnMenuRightClick 事件在右键单击时执行一些操作！

注意：我没有制作这个单元 - 我不知道是谁制作的，但功劳归于制作者...不过，我刚刚在 Delphi XE2 中对其进行了测试，它工作正常。

Answer 2

感谢 TLama 和该代码的作者！非常有用，但只需要一个小更新： 该程序仅在项目的第一级检查，如果您的菜单包含子项目，则它不起作用... 所以我们必须重载 DispatchRC 函数来对点击的项目进行递归搜索。 我做到了，效果很好：

function TRCPopupMenu.DispatchRC(aHandle: HMENU; aPosition: Integer): Boolean;
begin
  //Result := False; // freezebit : now, unused value
  if Handle = aHandle then
  begin
    RClick(Items[aPosition]);
    Result := True;
    Exit; // freezebit : found, so leave
  end;
  Result := DispatchRC(aHandle, aPosition, Items); // freezebit : now make a recursive search in all sub-items
end;

// freezebit : this function search in all sub-items recursively if we found the right-clicked TMenuItem
function TRCPopupMenu.DispatchRC(aHandle: HMENU; aPosition: Integer; aItems: TMenuItem): Boolean;
var
  i: integer;
  itm: TMenuItem;
begin
  Result := False;
  for i := 0 to aItems.Count - 1 do begin
    itm := aItems[i];
    if itm.Count = 0 then
      Continue;
    if itm.Items[0].Parent.Handle = aHandle then begin
      RClick(itm.Items[aPosition]);
      Result := True;
      Exit;
    end;
    if DispatchRC(aHandle, aPosition, itm) then begin
      Result := True;
      Exit;
    end;
  end;
end;

Answer 3

弹出菜单处理发生在user32.dll 中的一个名为TrackPopupMenu 的函数中，该函数是Windows 的一部分。响应左键或右键单击，将生成WM_COMMAND 消息，由 Delphi VCL 框架代码处理。 wParam 参数包含正在执行的菜单项的索引，LParam 似乎始终为零。

创建对左键和右键单击响应不同的菜单的唯一方法是自己生成弹出菜单，而不是从 Windows 中生成。

如果 Windows 的设计者决定将此信息作为窗口消息中 WParam 或 LParam 的一部分传递给您，您可能已经对此进行了处理，或者如果您可以挂钩作为一部分的鼠标按下事件在弹出菜单的窗口消息循环中，您也许可以这样做，但我不知道这样做的可靠方法。

如果您确实需要对左键和右键单击菜单进行不同的处理，那么创建自己的弹出菜单可能会少一些工作。但是没有用户会知道如何使用您的应用程序。对于标准 Win32 菜单，不建议使用这样的想法，而且事实上，以我所知道的任何方式都不可能。

Answer 4

感谢作者和 freezebit，但我觉得这个解决方案有点漂亮（也更改了 DispatchRC）：

function TRCPopupMenu.DispatchRC(aHandle: HMENU; aPosition: Integer): Boolean;
var FParentItem: TMenuItem;
begin
  Result := False;
  if Handle = aHandle then
    FParentItem := Items
  else
    FParentItem := FindItem(aHandle, fkHandle);
  if FParentItem <> nil then
    begin
      RClick(FParentItem.Items[aPosition]);
      Result := True;
    end;
{  if Handle = aHandle then
  begin
    RClick(Items[aPosition]);
    Result := True;
  end;}
end;