Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to show a TPopupMenu when you click a TButton?

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?

like image 612
User Avatar asked Oct 21 '10 11:10

User


2 Answers

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;    
like image 121
Andreas Rejbrand Avatar answered Sep 28 '22 01:09

Andreas Rejbrand


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.

like image 43
RRUZ Avatar answered Sep 28 '22 00:09

RRUZ