Jak wyrównać menu TPopup, aby dokładnie ustawił się nad przyciskiem?

Question

chcę wyskakujące menu powyżej przycisku:

Delphi otacza menu systemu Win32 w sposób, który wydaje się wykluczać każdym trybie lub flagę bazowego Win32 API zapewnia, że ​​nie był w VCL autora mózg tego dnia. Jednym z takich przykładów wydaje się być TPM_BOTTOMALIGN, który może być przekazany do TrackPopupMenu, ale opakowanie Delphi wydaje się uczynić to nie tylko niemożliwe w magazynie VCL, ale przez nierozsądne użycie prywatnych i chronionych metod, jest niemożliwe (przynajmniej wydaje mi się, że być niemożliwe), aby zrobić dokładnie w czasie wykonywania lub przez przesłonięcia. Komponent VCL TPopupMenu również nie jest zbyt dobrze zaprojektowany, ponieważ powinien mieć wirtualną metodę o nazwie PrepareForTrackPopupMenu, która wykonała wszystko inne niż wywołanie TrackPopupMenu lub TrackPopupMenuEx, a następnie pozwoli komuś zastąpić metodę, która faktycznie wywołuje tę metodę Win32. Ale teraz jest już za późno. Być może Delphi XE5 będzie miało to podstawowe pokrycie API Win32.

Podejścia próbowałem:

Podejście: Użyj danych lub Czcionki:

dokładnie określić wysokość menu kontekstowego więc mogę odjąć wartość Y przed wywołaniem popupmenu.Popup (X, Y). Wyniki: Będą musiały obsłużyć wszystkie warianty motywów systemu Windows i przyjąć założenia, na które nie jestem pewny. Wydaje się mało prawdopodobne, aby przyniosło to dobre wyniki w realnym świecie. Oto przykład z podstawowego podejścia parametrów czcionki:

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

Można uwzględniać ukrytych przedmiotów, a za jednym wersją systemu Windows za pomocą jednego ustawienia trybu motyw w efekcie może zbliżyć się w ten sposób, ale nie dokładnie tak.

Podejście B: Niech system Windows to zrobić:

Spróbuj przejść w końcu dotrzeć do TPM_BOTTOMALIGN Win32 API wezwanie TrackPopupMenu.

Do tej pory, myślę, że mogę to zrobić, jeśli zmodyfikuję menu VCL.pas .. Używam Delphi 2007 w tym projekcie. Jednak nie cieszę się z tego pomysłu.

Oto rodzaj kodu usiłuję:

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; 

Alternatywnie Chciałem to zrobić:

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

Oczywiście popupEx nie ma w VCL. Ani sposób na przekazanie większej liczby flag do TrackPopupMenu niż tych, które dodali użytkownicy VCL prawdopodobnie w 1995 roku, w wersji 1.0.

Uwaga: Uważam, że problem oszacowania wysokości przed wyświetleniem menu jest niemożliwy, dlatego powinniśmy faktycznie rozwiązać problem przez TrackPopupMenu, nie szacując wysokości.

Aktualizacja: wywołanie TrackPopupMenu bezpośrednio nie działa, ponieważ pozostałe kroki w metodzie VCL TPopupMenu.Popup(x,y) są konieczne, aby wywołać aplikację, aby malować menu i wyglądać poprawnie, jednak nie można ich wywołać bez zła oszustwo, ponieważ są to prywatne metody. Modyfikacja VCL jest piekielną propozycją i nie chcę tego zabawiać.

Answer 1

Trochę zdziczały, ale może go rozwiązać.

stwierdzenie klasy przechwytywania dla TPopupMenu nadrzędne 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; 

Sztuką jest, aby umieścić Anuluj do okna menu, który przerywa połączenie TrackPopupMenu dziedziczone.

Answer 2

Nie mogę skopiować Twojego problemu z TrackPopupMenu. Z prostym testem tutaj z D2007, napisy przedmiotów, obrazy, podmenu wydają się wyglądać i działają poprawnie.

W każdym razie poniższy przykład instaluje zaczep CBT tuż przed otwarciem menu. Hak pobiera okno powiązane z menu, aby móc je podklasować.

Jeśli nie obchodzi Cię możliwe miganie menu podręcznego w warunkach stresowych, zamiast haka, możesz użyć klasy PopupList do obsługi WM_ENTERIDLE, aby przejść do okna menu.

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;