I am trying to simulate a drop down menu for a TButton, as shown below:
procedure DropMenuDown(Control: TControl; PopupMenu: TPopupMenu);
var
APoint: TPoint;
b
After reviewing the solution provided by Whiler & Vlad, and comparing it to the way WinSCP implements the same thing, I'm currently using the following code:
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.
It has the advantage of not requiring any code changes to the from, apart from calling ButtonMenu()
in the onClick
handler:
procedure TForm1.Button1Click(Sender: TObject);
begin
ButtonMenu(Button1, PopupMenu1);
end;