How do you line up a TPopupMenu so that it accurately positions itself above a button?

Question

I want a popup menu above a button:

Delphi wraps the Win32 menu system in a way that seems to preclude every mode or flag that the underlying Win32 API provides that was not in the VCL author's brain on that day. One such example appears to be the TPM_BOTTOMALIGN which can be passed into TrackPopupMenu but, the Delphi wrapper appears to render this not only impossible in the stock VCL, but by injudicious use of private and protected methods, is impossible (at least seems to me to be impossible) to do either accurately at runtime, or by overrides. The VCL component TPopupMenu is not very well designed either, as it should have had a virtual method called PrepareForTrackPopupMenu that did everything other than the call to TrackPopupMenu or TrackPopupMenuEx, and then allow someone to override a method that actually invokes that Win32 method. But that's too late now. Maybe Delphi XE5 will have this basic coverage of the Win32 API done right.

Approaches I have tried:

Approach A: Use METRICS or Fonts:

Accurately determine height of a popup menu so I can subtract the Y value before calling popupmenu.Popup(x,y). Results: Would have to handle all variants of Windows theming, and make assumptions that I seem unable to be sure about. Seems unlikely to result in good results in the real world. Here's an example of a basic font metrics approach:

   height := aPopupMenu.items.count * (abs(font.height) + 6) + 34;

You can take into account hidden items, and for a single version of windows with a single theme mode setting in effect, you might get close like that, but not exactly right.

Approach B: Let Windows Do It:

Try to pass in TPM_BOTTOMALIGN to eventually reach Win32 API call TrackPopupMenu.

So far, i think I can do it, if I modify the VCL menus.pas.. I am using Delphi 2007 in this project. I am not all that happy about that idea though.

Here is the kind of code I am trying:

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;

Alternatively I wanted to do this:

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

Of course, popupEx is not there in the VCL. Nor any way to pass in more flags to TrackPopupMenu than those that the VCL guys added probably in 1995, in version 1.0.

Note: I believe the problem of estimating the height before showing the menu is impossible, thus we should be actually having the problem solved by TrackPopupMenu not by estimating the height.

Update: Calling TrackPopupMenu directly does not work, because the rest of the steps in the VCL method TPopupMenu.Popup(x,y) are necessary to invoke for my application to paint its menu and have it look correct, however it is impossible to invoke them without evil trickery because they are private methods. Modifying the VCL is a hellish proposition and I don't wish to entertain that either.

Answer 1

A little bit hacky, but it might solve it.

Declare an interceptor class for TPopupMenu overriding 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;

The trick is to post a cancel message to the menu window which cancels the inherited TrackPopupMenu call.