如何在点击TButton时显示一个TPopupMenu？

Question

我想在点击按钮时显示一个弹出式菜单，但是在Delphi XE中这个过程出现了错误。

procedure ShowPopupMenuEx(var mb1:TMouseButton;var X:integer;var Y:integer;var pPopUP:TPopupMenu);
var
  popupPoint : TPoint;
begin
  if (mb1 = mbLeft) then begin
    popupPoint.X := x ;
    popupPoint.Y := y ;
    popupPoint := ClientToScreen(popupPoint);   //Error Here
    pPopUP.Popup(popupPoint.X, popupPoint.Y) ;   
  end;
end;

procedure TForm1.Button1MouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
begin
  ShowPopupMenuEx(button,Button1.Left,Button1.Top,PopupMenu1); //Error Here
end;

当点击按钮时显示这个错误。

DCC错误] Form1.pas(205): E2010 不兼容类型：'HWND'和'TPoint' [DCC Error] Form1.pas(398): E2197 不能将常量对象作为变量参数传递 [DCC Error] Form1.pas(398): E2197 不能将常量对象作为变量参数传递。

当点击一个按钮时，有没有更好的方法来显示弹出菜单？

Answer 1

只要做

procedure TForm1.Button1Click(Sender: TObject);
var
  pnt: TPoint;
begin
  if GetCursorPos(pnt) then
    PopupMenu1.Popup(pnt.X, pnt.Y);
end;

一些更多的讨论

如果你出于某种原因 需要 使用 OnMosuseUp，你可以做

procedure TForm1.Button1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  pnt: TPoint;
begin
  if (Button = mbLeft) and GetCursorPos(pnt) then
    PopupMenu1.Popup(pnt.X, pnt.Y);
end;

你的代码不能用，因为

1. ClientToScreen 是Windows API的一个函数，其签名为

   function ClientToScreen(hWnd: HWND; var lpPoint: TPoint): BOOL;
   

   但是，也有一个 TControl.ClientToScreen 有签名

   function TControl.ClientToScreen(const Point: TPoint): TPoint;
   

   因此，如果你在一个类方法中，这个类是由 TControl, ClientToScreen 将指的是后一种。如果不是，就会参考前一个。而这个，当然需要知道我们要从哪个窗口转换坐标!

2. 另外，如果你声明

   var mb1: TMouseButton
   

   作为参数，那么只有一个类型为 TMouseButton 将被接受。但我不明白为什么你会喜欢你的这个签名。ShowPopupMenuEx 功能。事实上，我认为根本不需要这样的功能... ...

一个替代方案

我上面的代码会在光标pos处弹出菜单。如果你需要将点固定在按钮的一个角上，你可以做以下操作

// Popup at the top-left pixel of the button
procedure TForm1.Button1Click(Sender: TObject);
begin
  with Button1.ClientToScreen(point(0, 0)) do
    PopupMenu1.Popup(X, Y);
end;

// Popup at the bottom-right pixel of the button
procedure TForm1.Button1Click(Sender: TObject);
begin
  with Button1.ClientToScreen(point(Button1.Width, Button1.Height)) do
    PopupMenu1.Popup(X, Y);
end;

// Popup at the bottom-left pixel of the button
procedure TForm1.Button1Click(Sender: TObject);
begin
  with Button1.ClientToScreen(point(0, Button1.Height)) do
    PopupMenu1.Popup(X, Y);
end;    

Answer 2

这个错误是因为你的代码调用了 Windows.ClientToScreen 函数，而不是TControl.ClientToScreen 功能

试试这样

procedure TForm6.Button2Click(Sender: TObject);
var
   pt : TPoint;
begin
    pt.x := TButton(Sender).Left + 1;
    pt.y := TButton(Sender).Top + TButton(Sender).Height + 1;
    pt := Self.ClientToScreen( pt );
    PopupMenu1.popup( pt.x, pt.y );
end;

或宣布你的程序 ShowPopupMenuEx 里面 Tform1 类，并将工作。

Answer 3

同样，对于TToolButton

(假设TToolButton Style 是 tbsDropDown...)

根据我的经验，我发现更多的时候，我宁愿下拉菜单在整个按钮被点击时显示，而不仅仅是在 下拉箭头 (⯆).

为了达到这个目的，根据@Andreas在下的代码，在 An Alternative 以上，只需加上 Down := True 属性，如。

procedure TForm1.ToolButton1Click(Sender: TObject);
begin
  with ToolButton1, ClientToScreen(Point(0, Height)) do
  begin
    Down := True;
    DropdownMenu.Popup(X, Y);
  end;
end;

这也模拟了按钮的背景显示行为。