任何 TControl 的下拉菜单

Question

继续这个话题：

Drop down menu for TButton

我已经用 any TControl 为 DropDown memu 编写了一个通用代码，但由于某种原因，它在 TPanel 上无法正常工作：

var
  TickCountMenuClosed: Cardinal = 0;
  LastPopupControl: TControl;

type
  TDropDownMenuHandler = class
  public
    class procedure MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  end;                            
  TControlAccess = class(TControl);

class procedure TDropDownMenuHandler.MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if LastPopupControl <> Sender then Exit;
  if (Button = mbLeft) and not ((TickCountMenuClosed + 100) < GetTickCount) then
  begin
    if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
    ReleaseCapture;
    // SetCapture(0);
    if Sender is TGraphicControl then Abort;
  end;
end;

procedure RegisterControlDropMenu(Control: TControl; PopupMenu: TPopupMenu);
begin
  TControlAccess(Control).OnMouseDown := TDropDownMenuHandler.MouseDown;
end;

procedure DropMenuDown(Control: TControl; PopupMenu: TPopupMenu);
var
  APoint: TPoint;
begin
  LastPopupControl := Control;
  RegisterControlDropMenu(Control, PopupMenu);
  APoint := Control.ClientToScreen(Point(0, Control.ClientHeight));
  PopupMenu.PopupComponent := Control;
  PopupMenu.Popup(APoint.X, APoint.Y);
  TickCountMenuClosed := GetTickCount;
end;

据我所知，这适用于TButton 和TSpeedButton 以及任何TGraphicControl（如TImage 或TSpeedButton 等）。

但是TPanel 无法按预期工作

procedure TForm1.Button1Click(Sender: TObject);
begin
  DropMenuDown(Sender as TControl, PopupMenu1);
end;

procedure TForm1.Panel1Click(Sender: TObject);
begin
  DropMenuDown(Sender as TControl, PopupMenu1); // Does not work!
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  DropMenuDown(Sender as TControl, PopupMenu1);
end;

procedure TForm1.Image1Click(Sender: TObject);
begin
  DropMenuDown(Sender as TControl, PopupMenu1);
end;

似乎TPanel 不尊重ReleaseCapture;，甚至在TDropDownMenuHandler.MouseDown 事件中也不尊重Abort。我可以做些什么来使这个工作与TPanel 和其他控件一起工作？我错过了什么？

Answer 1

并不是TPanel 不尊重ReleaseCapture，而是捕获根本不相关。这是弹出菜单启动并处于活动状态并再次单击控件后发生的情况：

• 单击取消模式菜单循环，关闭菜单并发布鼠标按下消息。
• VCL 在鼠标按下消息处理[csClicked] 中设置一个标志。
• 鼠标按下事件处理程序被触发，您释放捕获。
• 鼠标按下消息返回后，发布的鼠标按下消息被处理，VCL 检查标志，如果设置了则单击控件。
• 点击处理程序弹出菜单。

当然，我没有追踪一个工作示例，所以我不知道 ReleaseCapture 何时以及如何提供帮助。无论如何，它在这里无济于事。

---

我提出的解决方案与当前的设计略有不同。

我们想要的是第二次点击而不是导致点击。请看这部分代码：

procedure DropMenuDown(Control: TControl; PopupMenu: TPopupMenu);
var
  APoint: TPoint;
begin
  ...
  PopupMenu.PopupComponent := Control;
  PopupMenu.Popup(APoint.X, APoint.Y);
  TickCountMenuClosed := GetTickCount;
end;

第二次点击实际上是关闭菜单，然后通过同一个处理程序再次启动它。这就是导致PopupMenu.Popup 调用返回的原因。所以我们在这里可以看出鼠标按钮被单击（左键或双击），但尚未被 VCL 处理。这意味着消息还在队列中。

使用这种方法删除注册机制（鼠标按下处理程序黑客），它是不需要的，因此类本身以及全局变量。

procedure DropMenuDown(Control: TControl; PopupMenu: TPopupMenu);
var
  APoint: TPoint;
  Msg: TMsg;
  Wnd: HWND;
  ARect: TRect;
begin
  APoint := Control.ClientToScreen(Point(0, Control.ClientHeight));
  PopupMenu.PopupComponent := Control;
  PopupMenu.Popup(APoint.X, APoint.Y);

  if (Control is TWinControl) then
    Wnd := TWinControl(Control).Handle
  else
    Wnd := Control.Parent.Handle;
  if PeekMessage(Msg, Wnd, WM_LBUTTONDOWN, WM_LBUTTONDBLCLK, PM_NOREMOVE) then begin
    ARect.TopLeft := Control.ClientOrigin;
    ARect.Right := ARect.Left + Control.Width;
    ARect.Bottom := ARect.Top + Control.Height;
    if PtInRect(ARect, Msg.pt) then
      PeekMessage(Msg, Wnd, WM_LBUTTONDOWN, WM_LBUTTONDBLCLK, PM_REMOVE);
  end;
end;

此外，这不依赖于处理时间。

Answer 2

要求

如果我理解正确，那么要求是：

1. 第一次鼠标左键单击控件时，控件下方应显示一个 PopupMenu。
2. 在第二个鼠标左键单击同一控件时，应关闭显示的 PopupMenu。

意识到，暂时忽略需求 1 的实现，需求 2 会自动发生：当您在 PopupMenu 外部单击时，PopupMenu 将关闭。由此得出结论，第一个的实施不应干扰第二个。

可能的解决方案：

• 计算控件的点击次数：第一次点击时，显示 PopupMenu，第二次点击时，什么也不做。但这不起作用，因为 PopupMenu 可能已经被其他地方的点击关闭，然后第二次点击实际上应该是第一次点击。
• 第一次单击时，显示 PopupMenu。在第二次单击时，确定 PopupMenu 是否仍然显示。如果是这样，那么什么也不做。否则，假设第一次单击。这也不起作用，因为在处理第二次点击时，PopupMenu 将已经关闭。
• 第一次单击时，显示 PopupMenu。在第二次单击时，确定 PopupMenu 是否在最后几毫秒内关闭。如果是这样，那么消失是由于第二次点击而没有做任何事情。这是您当前使用的解决方案，它利用了 TPopupMenu.Popup 在 PopupMenu 关闭之前不会返回的事实。

当前的实现

1. 在控件的OnClick 事件期间：
   • 控件的OnMouseDown事件分配给自定义处理程序，
   • PopupMenu 已显示。
2. 第二次点击控件：
   • 保存了当时 PopupMenu 关闭的时间（这仍然是在执行之前的 OnClick 事件期间），
   • 自定义OnMouseDown事件处理程序被调用，
   • 如果保存的时间在最后 100 毫秒内，则释放鼠标捕获并中止所有执行。

注意：可能已经有 OnMouseDown 的事件设置没有保存并消失！

为什么这适用于按钮

TCustomButton 通过响应 Windows 发送的CN_COMMAND 消息来处理点击事件。那是特定的 Windows BUTTON 系统类控制特性。通过取消鼠标捕获模式，不会发送此消息。因此，控件的OnClick 事件不会在第二次单击时触发。

为什么这对面板不起作用

TPanel 通过将csClickEvents 样式添加到其ControlStyle 属性来处理点击事件。这是一个特定的 VCL 特性。通过中止执行，由于WM_LBUTTONDOWN 消息而导致的后续代码将停止。然而，TPanel 的 OnClick 事件在其 WM_LBUTTONUP 消息处理程序的下方某处被触发，因此OnClick 事件仍被触发。

两者的解决方案

在your other question 上使用davea's answer，如果保存的PopupMenu 关闭时间在最后100 毫秒内，他什么也不做。