【问题标题】:How to show a TPopupMenu when you click a TButton?单击 TButton 时如何显示 TPopupMenu?
【发布时间】:2011-04-28 13:41:43
【问题描述】:

我想在点击一个按钮时显示一个弹出菜单,但是这个程序在 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 参数传递

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

【问题讨论】:

  • 为什么在 ShopPopupMenuEx( ) 过程中使用 var 参数?
  • 哎呀,这是我的错误,对不起。

标签: delphi button cursor-position popupmenu


【解决方案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 函数的这个签名。事实上,我认为根本不需要这样的功能......

另一种选择

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

// 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;    

【讨论】:

    【解决方案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;
    

    或在 Tform1 类中声明您的过程 ShowPopupMenuEx 并且可以工作。

    【讨论】:

    • 当有TButton.ClientToScreen 时使用Self.ClientToScreen 是相当愚蠢的。还有,我八分钟就打败你了……
    • @Andreas 试试我发布的代码,你就会明白我为什么叫Self.ClientToScreen 而不是TButton.ClientToScreen
    • @RRUZ:对不起。我没看到。
    • 但我确实认为在我提交帖子八分钟后在我的帖子中发布所有信息的子集是不礼貌的。对不起,我感觉不到任何不同...
    • @Andreas:您的代码使用当前光标位置,而 RRUZ 的代码使用按钮的左下角。所以是的区别。恕我直言,RRUZ 的版本看起来更好。 ;-)
    【解决方案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;
    

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

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 1970-01-01
      • 2011-10-21
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 2017-05-24
      相关资源
      最近更新 更多