Delphi 是否在菜单项上检测鼠标左/右键单击?
在Delphi XE2中,如何检测用户是用鼠标左键还是右键单击弹出菜单项?弹出菜单处理在Windows的Delphi 是否在菜单项上检测鼠标左/右键单击?,delphi,mouseevent,menuitem,Delphi,Mouseevent,Menuitem,在Delphi XE2中,如何检测用户是用鼠标左键还是右键单击弹出菜单项?弹出菜单处理在Windows的user32.dll函数中进行。作为对左键或右键单击的响应,将生成WM_命令消息,该消息由Delphi VCL框架代码处理。wParam参数包含正在执行的菜单项的索引,LParam似乎始终为零 创建对左键和右键单击做出不同响应的菜单的唯一方法是自己生成弹出菜单,而不是从Windows生成 如果Windows的设计者决定将此信息作为窗口消息内的WParam或LParam的一部分传递给您,您可能已
user32.dll
函数中进行。作为对左键或右键单击的响应,将生成WM_命令
消息,该消息由Delphi VCL框架代码处理。wParam
参数包含正在执行的菜单项的索引,LParam
似乎始终为零
创建对左键和右键单击做出不同响应的菜单的唯一方法是自己生成弹出菜单,而不是从Windows生成
如果Windows的设计者决定将此信息作为窗口消息内的WParam或LParam的一部分传递给您,您可能已经做了一些事情,或者如果您可以钩住作为弹出菜单窗口消息循环一部分的鼠标按下事件,您也可以这样做,但我不知道这样做的可靠方法
如果您真的需要对左键和右键单击的菜单进行不同的处理,那么创建自己的弹出菜单可能会少一些工作。但是没有用户知道如何使用您的应用程序。对于标准Win32菜单,不推荐使用这种方法,事实上,据我所知,这是不可能的。使用此单元,将其作为一个组件安装,并替换标准的
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中对其进行了测试,效果很好。多亏了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;
多亏了作者和FriezBit,但我认为这个解决方案有点漂亮(也更改了DispatchRC):
函数TRCPopupMenu.DispatchRC(aHandle:humenu;aPosition:Integer):布尔;
var FParentItem:TMenuItem;
开始
结果:=假;
如果Handle=aHandle,则
FParentItem:=项目
其他的
FParentItem:=FindItem(aHandle,fkHandle);
如果FParentItem为零,则
开始
单击(FParentItem.Items[aPosition]);
结果:=真;
结束;
{如果Handle=aHandle,则
开始
单击(项目[位置]);
结果:=真;
结束;}
结束;
有趣-我2分钟前在以下位置发现了相同的组件:
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;