Drop down menu for TButton

Question

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         


        

Answer 1

Following our (Vlad & I) discussion, you use a variable to know when the popup was last opened to choose if you display the popupmenu or cancel the mouse event:

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.