12

我想在单击按钮时显示一个弹出菜单，但是此过程在 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 错误] Form1.pas(398): E2197 常量对象不能作为 var 参数传递
[DCC 错误] Form1.pas( 398): E2197 常量对象不能作为 var 参数传递

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

4

3 回答 3

32

做就是了

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.ClientToScreenwith签名

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

    因此，如果您在一个类方法中，则作为 , 的后代的类TControl将ClientToScreen引用后者。如果不是，它将参考前一个。当然，这个需要知道我们要从哪个窗口转换坐标！

  2. 另外，如果您声明

    var mb1: TMouseButton

    作为参数，则只TMouseButton接受类型变量。但是我看不出你为什么想要这个ShowPopupMenuEx函数签名的任何理由。事实上，我认为根本不需要这样的功能......

替代

我上面的代码将在光标位置弹出菜单。如果您需要相对于按钮的一个角固定该点，则可以这样做

// 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;
于 2010-10-21T11:45:28.477 回答
6

此错误是因为您的代码正在调用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并且可以工作。

于 2010-10-21T11:53:37.693 回答
0

同样对于 TToolButton

（假设 TToolButtonStyle是tbsDropDown...）

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

为此，根据An Alternative上面@Andreas 的代码，只需添加Down := True属性，如下所示：

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

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

于 2020-06-02T16:47:36.753 回答