检测菜单项上的左/右鼠标按钮?

时间:2012-10-24 01:32:13

标签: delphi mouseevent menuitem

在Delphi XE2中,如何检测用户是否使用左键或鼠标右键单击了弹出菜单项?

4 个答案:

答案 0 :(得分: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中测试它并且它工作正常。

答案 1 :(得分:1)

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

答案 2 :(得分:0)

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

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

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

如果您真的需要对左右菜单进行不同的处理,那么创建自己的弹出菜单可能会少一些工作。但是,没有用户会知道如何使用您的应用程序。我不推荐这样的想法,实际上,我不知道用标准的Win32菜单。

答案 3 :(得分:-1)

感谢作者和freezebit,但我觉得这个解决方案有点精美(也改变了DispatchRC):

integral2(height, -2, 2, -2, 2)