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

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在一个名为TrackPopupMenuWindows 的函数内部。响应左键或右键单击，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;