delphi - TButton 的下拉菜单

Question

我正在尝试模拟 TButton 的下拉菜单，如下所示:

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

procedure TForm1.Button1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    DropMenuDown(Button1, PopupMenu1);
    // ReleaseCapture;
  end;
end;

问题是，当菜单下拉时，如果我再次单击按钮，我希望菜单关闭，但它又再次下拉。

我正在寻找专门通用 Delphi TButton 的解决方案，而不是任何第三方等效解决方案。

Answer 1

在审查了 Whiler 和 Vlad 提供的解决方案并将其与 WinSCP 实现相同功能的方式进行比较后，我当前使用以下代码:

unit ButtonMenus;
interface
uses
  Vcl.Controls, Vcl.Menus;

procedure ButtonMenu(Control: TControl; PopupMenu: TPopupMenu);

implementation

uses
  System.Classes, WinApi.Windows;

var
  LastClose: DWord;
  LastPopupControl: TControl;
  LastPopupMenu: TPopupMenu;

procedure ButtonMenu(Control: TControl; PopupMenu: TPopupMenu);
var
  Pt: TPoint;
begin
  if (Control = LastPopupControl) and (PopupMenu = LastPopupMenu) and (GetTickCount - LastClose < 100) then begin
    LastPopupControl := nil;
    LastPopupMenu := nil;
  end else begin
    PopupMenu.PopupComponent := Control;
    Pt := Control.ClientToScreen(Point(0, Control.ClientHeight));
    PopupMenu.Popup(Pt.X, Pt.Y);
    { Note: PopupMenu.Popup does not return until the menu is closed }
    LastClose := GetTickCount;
    LastPopupControl := Control;
    LastPopupMenu := PopupMenu;
  end;
end;

end.

除了在 onClick 处理程序中调用 ButtonMenu() 之外，它的优点是不需要更改任何代码:

procedure TForm1.Button1Click(Sender: TObject);
begin
  ButtonMenu(Button1, PopupMenu1);
end;