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的解决方案，而不是任何第三方等效物。

- Vlad

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;

- davea

---

这是更好和更通用的解决方案。另请参见此答案。+1 - NGLN

Answer 2

根据我们（Vlad和我）的讨论，您可以使用一个变量来知道上一次弹出窗口是何时打开的，以此来选择是否显示弹出菜单或取消鼠标事件：

unit Unit4;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.StdCtrls;

type
  TForm4 = class(TForm)
    PopupMenu1: TPopupMenu;
    Button1: TButton;
    fgddfg1: TMenuItem;
    fdgdfg1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    cMenuClosed: Cardinal;

  public
    { Public declarations }
  end;

var
  Form4: TForm4;

implementation

{$R *.dfm}

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 TForm4.Button1Click(Sender: TObject);
begin
  DropMenuDown(Button1, PopupMenu1);
  cMenuClosed := GetTickCount;
end;

procedure TForm4.Button1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (Button = mbLeft) and not ((cMenuClosed + 100) < GetTickCount) then
  begin
    ReleaseCapture;
  end;
end;

procedure TForm4.FormCreate(Sender: TObject);
begin
  cMenuClosed := 0;
end;

end.

- Whiler

---

弹出列表是否有些过度了？我们知道菜单在DropMenuDown行之后就关闭了（因为弹出是同步的），或者我错过了什么？ - Vlad

如果您点击按钮...然后，您等待n秒钟而不做任何事情....然后...您决定再次按下按钮...在按下它之前，因为您什么也没有做...弹出窗口仍然打开吗？所以，如果您在DropMenuDown(Button1, PopupMenu1);之后立即cMenuClosed := GetTickCount;，我刚才解释的情况就不应该起作用... - Whiler

我的意思是这样的：`procedure TForm1.Button1Click(Sender: TObject); begin DropMenuDown(Button1, PopupMenu1); cMenuClosed := GetTickCount; end;procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (Button = mbLeft) and not ((cMenuClosed + 100) < GetTickCount) then begin ReleaseCapture; end; end;` - Vlad

你的回答给了我正确的想法，所以我会接受它 :) 谢谢。 - Vlad