我正在尝试模拟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;
问题是,当菜单下拉时,如果我再次单击该按钮,我希望菜单关闭,但它再次下拉。
我正在寻找专门针对通用德尔福的解决方案,TButton
而不是任何第三方等效物。
在查看了 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.
它的优点是不需要对 from 进行任何代码更改,除了在 onClick
处理程序中调用 ButtonMenu()
:
procedure TForm1.Button1Click(Sender: TObject);
begin
ButtonMenu(Button1, PopupMenu1);
end;
在我们的(Vlad & I)讨论之后,您可以使用变量来了解上次打开弹出窗口的时间,以选择是显示弹出菜单还是取消鼠标事件:
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.