检测菜单项上的左/右鼠标按钮是否点击？

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

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

您的唯一方法是创建一个对左右单击不同响应的菜单，而不是从Windows生成弹出式菜单。

如果Windows的设计者决定将这些信息作为窗口消息中的WParam或LParam的一部分传递给您，那么您可能会对此做出某些操作，或者如果您可以钩住鼠标按下事件弹出菜单的窗口消息循环的一部分，你也许可以做到这一点，但我不知道这样做的可靠方法。

如果您确实需要对左右菜单进行不同的处理，创建自己的弹出式菜单可能会减少工作量。但是，然后没有用户会知道如何使用您的应用程序。我不推荐这样的想法，事实上，我不能用任何我知道的方法，用标准的Win32菜单。

Answer 3

感谢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 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;