Question

继续本主题：

我已经使用任何 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等）。< / p>

但是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;似乎不尊重Abort，甚至不尊重TDropDownMenuHandler.MouseDown。我可以做些什么来使用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

要求

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

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

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

可能的解决方案：

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

当前的实施

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

注意：可能已经存在OnMouseDown事件设置并且已经消失了！

为什么这适用于Button

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

为什么这对Panel

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

两者的解决方案

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

任何TControl的下拉菜单

2 个答案:

要求

当前的实施

为什么这适用于Button

为什么这对Panel

两者的解决方案