Drop down menu for TButton

前端 未结 2 2045
栀梦
栀梦 2021-02-06 07:06

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         


        
2条回答
  •  青春惊慌失措
    2021-02-06 07:57

    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;
    

提交回复
热议问题