How to show a TPopupMenu when you click a TButton?
Asked Answered
Z

3

12

I want to show a popupmenu when click a button, but this procedure has error in 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;

when click button show this error :

[DCC Error] Form1.pas(205): E2010 Incompatible types: 'HWND' and 'TPoint'
[DCC Error] Form1.pas(398): E2197 Constant object cannot be passed as var parameter
[DCC Error] Form1.pas(398): E2197 Constant object cannot be passed as var parameter

Is there any better way for show popupmenu, when click a button?

Zabaglione answered 21/10, 2010 at 11:39 Comment(2)
Why do you use var-parameters for the ShopPopupMenuEx( )-procedure?Changsha
oops, this my mistake, sorry.Zabaglione
C
36

Just do

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

Some more discussion

If you for some reason need to use OnMosuseUp, you can do

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;

Your code doesn't work because

  1. ClientToScreen is a function of the Windows API with signature

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

    But, there is also a TControl.ClientToScreen with signature

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

    Hence, if you are in a class method, the class being a decendant of TControl, ClientToScreen will refer to the latter one. If not, it will refer to the former one. And this one, of course, needs to know which window we are to transform coordinates from!

  2. Also, if you declare

    var mb1: TMouseButton
    

    as a parameter, then only a variable of type TMouseButton will be accepted. But I cannot see any reason why you would like this signature of your ShowPopupMenuEx function. In fact, I see no need for such a function at all...

An Alternative

My code above will popup the menu at the cursor pos. If you need to fix the point relative to one corner of the button, instead, you can do

// 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;    
Chaille answered 21/10, 2010 at 11:45 Comment(0)
E
6

this error is because your code is calling the Windows.ClientToScreen function instead of the TControl.ClientToScreen function

try something like this

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;

or declare your procedure ShowPopupMenuEx inside of your Tform1 class and will work.

Enochenol answered 21/10, 2010 at 11:53 Comment(10)
It is rather stupid to use Self.ClientToScreen when there is a TButton.ClientToScreen. Also, I beat you with eight minutes...Chaille
@Andreas try the code wich i posted, and you will understand why i call Self.ClientToScreen instead of TButton.ClientToScreenEnochenol
@RRUZ: I am sorry. I don't see it.Chaille
But I do think it is bad manners to post a subset of all information in my post eight minutes after I submitted my post. Sorry, I cannot feel any different...Chaille
@Andreas: Your code uses the current cursor position while RRUZ's code uses the bottom left corner of the button. So there is a difference. And IMHO RRUZ's version looks better. ;-)Apparently
@Andreas, i'm sorry but I did not realize that there was another similar answer, i just answer the question and then i went for a cup of coffee.Enochenol
@RRUZ: That's OK. But sometimes people do this knowingly, and that annoys me. @Ullrich: Then you have not read all of my answer! I provide both alternatives. (And the latter one, using TButton.ClientToScreen. And - just so you do not think I am cheating - I did post that part of the answer too prior to RRUZ posting his answer.)Chaille
Ok Andreas, it was not my intention to cause a misunderstanding with you. ;)Enochenol
@Andreas: I saw your "An Alternative" update after RRUZ's answer.Apparently
@Enochenol best solution ... Andreas Rejbrand your solution use mouse cursor, that not work when user click button with spacebar or enter for exampleNitrochloroform
L
2

Similarly for TToolButton

(Assuming TToolButton Style is tbsDropDown...)

In my experience, I find more often than not, I'd rather the drop down menu displayed when the entire button is clicked, not just the drop down arrow (⯆).

To achieve this, based on the code by @Andreas under An Alternative above, simply add Down := True property, as in:

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

This also simulates the button background display behavior.

Launder answered 2/6, 2020 at 16:47 Comment(0)

© 2022 - 2024 — McMap. All rights reserved.