Detect left/right mouse button on menu item click?

问题

In Delphi XE2, how can I detect if the user clicked a popup menu item with the left or with the right mouse button?

回答1:

Use this unit, install it as a component and replace the standard TPopupMenu which adds an OnMenuRightClick event.

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.

You can then use the OnMenuRightClick event to perform some action on a right click!

Note: I didn't make this unit - I don't know who did but credit goes to whoever did... I have however just tested it in Delphi XE2 and it works fine.

回答2:

Thanks to TLama and the author of that code ! very usefull but just need a minor update : That procedure just check at the first level of Items, if your menu contains sub-items, it didn't work... So we have to overload the DispatchRC function to make a recursive search of the clicked item. I did that and it works fine :

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;

回答3:

Popup menu processing happens inside user32.dll in a function called TrackPopupMenu which is part of Windows. In response to either a left or right click, a WM_COMMAND message is generated, which is handled by Delphi VCL framework code. The wParam parameter contains the index of the menu item which is being executed, and the LParam appears to always be zero.

Your only way to create a menu that will respond differently to a left and right click is to generate the popup menu yourself, and not from Windows.

If the designers of Windows had decided to pass this information to you as part of the WParam or LParam inside the window message, you could have probably done something with this, or if you could hook the mouse-down events that are part of the popup menu's window message loop, you could perhaps do this, but I am unaware of a reliable means of doing this.

Creating your own popup menus would perhaps be less work, if you really needed a different handling for left and right clicked menus. But then no user would know how to use your application. Such an idea is not recommended, and indeed, not possible by any means I know of, with standard Win32 menus.

回答4:

Thanks to author and freezebit, but I think a bit beautifully this solution (changed also 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;

来源：https://stackoverflow.com/questions/13041782/detect-left-right-mouse-button-on-menu-item-click

标签

Delphi

mouseevent

menuitem