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?
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
ClientToScreen
is a function of the Windows API with signaturefunction ClientToScreen(hWnd: HWND; var lpPoint: TPoint): BOOL;
But, there is also a
TControl.ClientToScreen
with signaturefunction 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!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 yourShowPopupMenuEx
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;
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.
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.
精彩评论