goccia giù per TButton

Question

Sto cercando di simulare un menu a discesa per un TButton, come illustrato di seguito:

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; 

Il problema è che quando il menu è sceso verso il basso, se clicco di nuovo il tasto I vorrebbe che il menu si chiuda, ma invece scende di nuovo.

Sto cercando una soluzione specificatamente per Delphi generico TButton non equivalente di terze parti.

Answer 1

Seguendo la nostra discussione (Vlad & I), si utilizza una variabile di sapere quando il popup è entrata l'ultima aperta a scegliere se si visualizza la PopupMenu o annullare l'evento del mouse:

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

Dopo aver esaminato la soluzione fornita da Whiler & Vlad, e confrontandolo con il modo in cui WinSCP implementa la stessa cosa, attualmente sto usando il seguente codice:

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. 

ha il vantaggio di non richiedere alcuna modifica al codice del da, a parte calli ng ButtonMenu() nel onClick gestore:

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