如何排列TPopupMenu，使其在按鈕上精確定位？

Question

我想要一個按鈕上方的彈出菜單：

德爾福包裝在Win32菜單系統中，這似乎排除每一個模式或基礎Win32 API提供了是不是在VCL筆者的標誌的方式大腦在那一天。一個這樣的例子似乎是TPM_BOTTOMALIGN，它可以傳遞到TrackPopupMenu，但是，Delphi包裝似乎使這不僅在股票VCL中不可能，而且通過不公正地使用私有和受保護的方法是不可能的（至少在我看來是不可能的）在運行時準確地執行或覆蓋。 VCL組件TPopupMenu的設計也不是很好，因爲它應該有一個名爲PrepareForTrackPopupMenu的虛擬方法，該方法除了調用TrackPopupMenu或TrackPopupMenuEx之外的其他功能，然後允許某人覆蓋實際調用該Win32方法的方法。但現在已經太晚了。也許Delphi XE5將完成Win32 API的基本覆蓋。

途徑我曾嘗試：

解決方法A：使用指標或字體：

準確判斷一個彈出菜單的高度，所以我可以調用popupmenu.Popup（X，Y）之前減去Y值。結果：必須處理Windows主題的所有變體，並假設我似乎無法確定。似乎不太可能在現實世界中產生好的結果。這是一個基本的字體度量方法的一個例子：

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

您可以考慮隱藏物品，和Windows的單一版本實際上是一個單一的主題模式設置，你可能會得到接近這樣的，但不非常正確。

方法B：讓Windows做它：

嘗試在TPM_BOTTOMALIGN傳遞給最終達到Win32 API調用TrackPopupMenu。

到目前爲止，我認爲我可以做到，如果我修改VCL menus.pas ..我在這個項目中使用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; 

另外我想這樣做：

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

當然，popupEx是不存在的VCL。也沒有任何方法可以將更多的 標誌傳遞給TrackPopupMenu，而不是那些VCL傢伙可能在1995年添加的版本， 版本1.0。

注意：我相信在顯示菜單之前估計高度的問題是不可能的，因此我們應該通過TrackPopupMenu來解決問題，而不是通過估計高度。

更新：調用TrackPopupMenu直接不起作用，因爲在VCL方法TPopupMenu.Popup(x,y)其餘步驟都需要調用我的應用程序繪製它的菜單，並讓它看起來是正確的，但它是不可能來調用它們而不惡欺騙，因爲它們是私人方法。修改VCL是一個地獄般的主張，我也不希望這樣做。

Answer 1

有點不好意思，但它可能會解決它。

聲明一個攔截器類TPopupMenu重寫彈出：

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; 

訣竅是張貼取消消息給取消繼承TrackPopupMenu呼叫菜單窗口。

Answer 2

我不能用TrackPopupMenu複製您的問題。通過D2007的簡單測試，項目的標題，圖像，子菜單看起來很正常。

無論如何，下面的例子在彈出菜單之前安裝一個CBT鉤子。鉤子檢索與菜單關聯的窗口，以便能夠對其進行子類化。

如果您不在意在強調條件下可能閃爍彈出式菜單，而不是掛鉤，則可以使用PopupList類來處理WM_ENTERIDLE以進入菜單窗口。

type 
    TForm1 = class(TForm) 
    Button1: TButton; 
    PopupMenu1: TPopupMenu; 
    ... 
    procedure PopupMenu1Popup(Sender: TObject); 
    private 
    ... 
    end; 

    ... 

implementation 

{$R *.dfm} 

var 
    SaveWndProc: Pointer; 
    CBTHook: HHOOK; 
    ControlWnd: HWND; 
    PopupToMove: HMENU; 

function MenuWndProc(Window: HWND; Message, WParam: Longint; 
    LParam: Longint): Longint; stdcall; 
const 
    MN_GETHMENU = $01E1; // not defined in D2007 
var 
    R: TRect; 
begin 
    Result := CallWindowProc(SaveWndProc, Window, Message, WParam, LParam); 

    if (Message = WM_WINDOWPOSCHANGING) and 
     // sanity check - does the window hold our popup? 
     (HMENU(SendMessage(Window, MN_GETHMENU, 0, 0)) = PopupToMove) then begin 

    if PWindowPos(LParam).cy > 0 then begin 
     GetWindowRect(ControlWnd, R); 
     PWindowPos(LParam).x := R.Left; 
     PWindowPos(LParam).y := R.Top - PWindowPos(LParam).cy; 
     PWindowPos(LParam).flags := PWindowPos(LParam).flags and not SWP_NOMOVE; 
    end else 
     PWindowPos(LParam).flags := PWindowPos(LParam).flags or SWP_NOMOVE; 
    end; 
end; 

function CBTProc(nCode: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall; 
const 
    MENUWNDCLASS = '#32768'; 
var 
    ClassName: array[0..6] of Char; 
begin 
    Result:= CallNextHookEx(CBTHook, nCode, WParam, LParam); 

    // first window to be created that of a menu class should be our window since 
    // we already *popped* our menu 
    if (nCode = HCBT_CREATEWND) and 
     Bool(GetClassName(WParam, @ClassName, SizeOf(ClassName))) and 
     (ClassName = MENUWNDCLASS) then begin 
    SaveWndProc := Pointer(GetWindowLong(WParam, GWL_WNDPROC)); 
    SetWindowLong(WParam, GWL_WNDPROC, Longint(@MenuWndProc)); 
    // don't need the hook anymore... 
    UnhookWindowsHookEx(CBTHook);  
    end; 
end; 


procedure TForm1.PopupMenu1Popup(Sender: TObject); 
begin 
    ControlWnd := Button1.Handle;   // we'll aling the popup to this control 
    PopupToMove := TPopupMenu(Sender).Handle; // for sanity check above 
    CBTHook := SetWindowsHookEx(WH_CBT, CBTProc, 0, GetCurrentThreadId); // hook.. 
end;