Drop down menu cho TButton

Question

Tôi cố gắng để mô phỏng một menu thả xuống cho một TButton, như hình dưới đây:

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; 

Vấn đề là khi menu được giảm xuống, nếu tôi nhấp vào nút một lần nữa tôi muốn menu đóng lại, nhưng thay vào đó nó lại giảm xuống.

Tôi đang tìm giải pháp cụ thể cho chung Delphi TButton không phải bất kỳ tương đương nào của bên thứ ba.

Answer 1

Tiếp theo (Vlad & I) thảo luận của chúng tôi, bạn sử dụng một biến để biết khi popup được mở cửa cuối cùng để lựa chọn nếu bạn hiển thị popupmenu hoặc hủy bỏ sự kiện chuột:

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. 

Answer 2

Sau khi xem xét các giải pháp cung cấp bởi Whiler & Vlad, và so sánh nó với cách WinSCP thực hiện điều tương tự, tôi đang sử dụng đoạn mã sau:

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. 

nó có lợi thế là không đòi hỏi bất kỳ thay đổi mã để các từ, ngoài việc mô sẹo ng ButtonMenu() trong trình xử lý onClick:

procedure TForm1.Button1Click(Sender: TObject); 
begin 
    ButtonMenu(Button1, PopupMenu1); 
end;