rozwijanego menu dla TButton

Question

Próbuję symulować menu rozwijane dla TButton, jak pokazano poniżej:

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; 

Problemem jest to, że gdy menu jest spadła w dół, jeśli kliknę przycisk jeszcze raz ja chciałby zamknąć menu, ale zamiast tego ponownie opada.

szukam rozwiązania specjalnie dla rodzajowego Delphi TButton nie innego równoważnego 3rd Party.

Answer 1

Po naszej (Vlad & I) dyskusji, należy użyć zmiennej wiedzieć, kiedy popup był ostatnio otwarty do wyboru, jeśli wyświetli PopupMenu lub anulować zdarzenie myszy:

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

Po zapoznaniu się z rozwiązania przewidzianego przez Whiler & Vlad i porównując ją do sposobu WinSCP implementuje to samo, obecnie używam następujący kod:

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. 

To ma tę zaletę, że nie wymaga żadnych zmian kodu do z, oprócz kallusów ng ButtonMenu() w onClick Handler:

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