Как показать TPopupMenu при нажатии кнопки TButton? - PullRequest
7 голосов
/ 21 октября 2010

Я хочу показать всплывающее меню при нажатии кнопки, но эта процедура имеет ошибку в 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

Есть ли лучший способ для отображения всплывающего меню при нажатии кнопки?

Ответы [ 2 ]

22 голосов
/ 21 октября 2010

Просто сделайте

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;    
5 голосов
/ 21 октября 2010

эта ошибка вызвана тем, что ваш код вызывает функцию 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 класса и будете работать.

...