你如何排列TPopupMenu,使其准确定位在按钮上方?

War*_* P 9 delphi vcl popupmenu delphi-2007

我想要一个按钮上方的弹出菜单:

在此输入图像描述

Delphi包装Win32菜单系统的方式似乎排除了基础Win32 API提供的当天不在VCL作者大脑中的每个模式或标志.一个这样的例子似乎是TPM_BOTTOMALIGN可以传递到的TrackPopupMenu但是,Delphi包装似乎使得这不仅不能在库存VCL中,而且通过不明智地使用私有和受保护的方法,是不可能的(至少在我看来是不可能的) )在运行时或通过覆盖准确地执行.VCL组件TPopupMenu的设计也不是很好,因为它应该有一个调用的虚拟方法PrepareForTrackPopupMenu除了调用TrackPopupMenuor 之外还执行其他操作TrackPopupMenuEx,然后允许某人覆盖实际调用该Win32方法的方法.但现在已经太晚了.也许Delphi XE5将完成对Win32 API的基本覆盖.

我试过的方法:

方法A:使用METRICS或字体:

准确地确定弹出菜单的高度,以便在调用popupmenu.Popup(x,y)之前减去Y值.结果:必须处理Windows主题的所有变体,并做出我似乎无法确定的假设.似乎不太可能在现实世界中取得好成绩.以下是基本字体度量方法的示例:

   height := aPopupMenu.items.count * (abs(font.height) + 6) + 34;
Run Code Online (Sandbox Code Playgroud)

您可以考虑隐藏的项目,对于单个主题模式设置的单个版本的窗口,您可能会接近这样,但不完全正确.

方法B:让Windows执行:

尝试传入TPM_BOTTOMALIGN最终到达Win32 API调用TrackPopupMenu.

到目前为止,我想我可以做到,如果我修改VCL菜单.我在这个项目中使用Delphi 2007.尽管如此,我对这个想法并不是那么开心.

这是我正在尝试的那种代码:

procedure TMyForm.ButtonClick(Sender: TObject);
var
  pt:TPoint;
  popupMenuHeightEstimate:Integer;
begin
   // alas, how to do this accurately, what with themes, and the OnMeasureItem event
   // changing things at runtime.
      popupMenuHeightEstimate := PopupMenuHeight(BookingsPopupMenu); 

      pt.X := 0;
      pt.Y := -1*popupMenuHeightEstimate;
      pt := aButton.ClientToScreen(pt);  // do the math for me.
      aPopupMenu.popup( pt.X, pt.Y );

end;
Run Code Online (Sandbox Code Playgroud)

或者我想这样做:

  pt.X := 0;
  pt.Y := 0;
  pt := aButton.ClientToScreen(pt);  // do the math for me.
  aPopupMenu.popupEx( pt.X, pt.Y, TPM_BOTTOMALIGN);
Run Code Online (Sandbox Code Playgroud)

当然,VCL中没有popupEx.也没有任何方式可以传递更多的旗帜,而TrackPopupMenu不是VCL人员在1995年版本1.0中添加的那些.

注意:我认为在显示菜单之前估计高度的问题是不可能的,因此我们实际上应该TrackPopupMenu通过估计高度来解决问题.

更新:TrackPopupMenu直接调用不起作用,因为VCL方法TPopupMenu.Popup(x,y) 中的其余步骤是调用我的应用程序绘制其菜单并使其看起来正确所必需的,但是如果没有恶意欺骗就不可能调用它们,因为它们是私有方法.修改VCL是一个地狱般的主张,我也不想接受它.

Uwe*_*abe 5

有点hacky,但它可能解决它.

为TPopupMenu声明一个拦截类,重写Popup:

type
  TPopupMenu = class(Vcl.Menus.TPopupMenu)
  public
    procedure Popup(X, Y: Integer); override;
  end;

procedure TPopupMenu.Popup(X, Y: Integer);
const
  Flags: array[Boolean, TPopupAlignment] of Word =
    ((TPM_LEFTALIGN, TPM_RIGHTALIGN, TPM_CENTERALIGN),
     (TPM_RIGHTALIGN, TPM_LEFTALIGN, TPM_CENTERALIGN));
  Buttons: array[TTrackButton] of Word = (TPM_RIGHTBUTTON, TPM_LEFTBUTTON);
var
  AFlags: Integer;
begin
  PostMessage(PopupList.Window, WM_CANCELMODE, 0, 0);
  inherited;
  AFlags := Flags[UseRightToLeftAlignment, Alignment] or
    Buttons[TrackButton] or
    TPM_BOTTOMALIGN or
    (Byte(MenuAnimation) shl 10);
  TrackPopupMenu(Items.Handle, AFlags, X, Y, 0 { reserved }, PopupList.Window, nil);
end;
Run Code Online (Sandbox Code Playgroud)

诀窍是将取消消息发布到菜单窗口,取消继承的TrackPopupMenu调用.

  • 看看他的问题,我认为他试图让PopupMenu出现在Buttons原点之上,而不是鼠标光标.添加X:= MyForm.Button.ClientOrigin.X; Y:= MyForm.Button.ClientOrigin.Y - 2; 在继承之前应该这样做.+1给你很棒的答案! (2认同)