Come si allinea un oggetto TPopup in modo che si posizioni esattamente sopra un pulsante?

Question

Voglio un menu pop-up sopra un pulsante:

Delphi avvolge il sistema di menu Win32 in un modo che sembra precludere ogni modalità o la bandiera che il sottostante Win32 API fornisce che non era in l'autore del VCL cervello in quel giorno. Uno di questi esempi sembra essere il TPM_BOTTOMALIGN che può essere passato a TrackPopupMenu ma, il wrapper Delphi sembra rendere questo non solo impossibile nel VCL di serie, ma da un uso improduttivo di metodi privati ​​e protetti, è impossibile (almeno mi sembra essere impossibile) da eseguire in modo accurato in fase di esecuzione o in caso di sovrascritture. Il componente VCL TPopupMenu non è molto ben progettato, in quanto avrebbe dovuto avere un metodo virtuale chiamato PrepareForTrackPopupMenu che faceva tutto tranne la chiamata a TrackPopupMenu o TrackPopupMenuEx e quindi consentire a qualcuno di sovrascrivere un metodo che effettivamente invoca quel metodo Win32. Ma è troppo tardi adesso. Forse Delphi XE5 avrà questa copertura di base dell'API Win32 eseguita correttamente.

Approcci ho provato:

Approccio A: Uso METRICS o Caratteri:

determinare con precisione l'altezza di un menu a tendina così posso sottrarre il valore Y prima di chiamare popupmenu.Popup (x, y). Risultati: Dovrebbe gestire tutte le varianti dei temi di Windows e fare supposizioni di cui non sembro essere sicuro. Sembra improbabile che porti a buoni risultati nel mondo reale. Ecco un esempio di un approccio di base metriche di font:

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

si può prendere in considerazione gli elementi nascosti, e per una sola versione di Windows con una sola impostazione della modalità tema in effetti, si potrebbe avvicinarsi in quel modo, ma non completamente giusto.

Approccio B: Let di Windows Do It:

tenta di passare in TPM_BOTTOMALIGN fine di raggiungere Win32 API chiamata TrackPopupMenu.

Finora, penso di poterlo fare, se modifico i menu VCL.pas .. Sto usando Delphi 2007 in questo progetto. Non sono molto contento di questa idea però.

Ecco il tipo di codice che sto cercando:

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; 

In alternativa ho voluto fare questo:

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

Naturalmente, popupEx non è lì in VCL. Né alcun modo per trasmettere più flag a TrackPopupMenu rispetto a quelli che i ragazzi VCL hanno aggiunto probabilmente nel 1995, nella versione 1.0.

Nota: Credo che il problema di stimare l'altezza prima di mostrare il menu sia impossibile, quindi dovremmo effettivamente risolvere il problema con TrackPopupMenu non stimando l'altezza.

Aggiornamento: Calling TrackPopupMenu direttamente non funziona, perché il resto dei passaggi nel metodo VCL TPopupMenu.Popup(x,y) sono necessarie per invocare per la mia applicazione per dipingere il suo menu e hanno un aspetto corretto, tuttavia non è possibile invocare loro senza il male inganno perché sono metodi privati. Modificare la VCL è una proposta infernale e non desidero nemmeno intrattenerlo.

Answer 1

Un po 'hacky, ma potrebbe risolverlo.

dichiarare una classe interceptor per TPopupMenu sovrascrivendo 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; 

Il trucco è quello di inviare un messaggio di cancellazione alla finestra del menu che annulla la chiamata ereditato TrackPopupMenu.

Answer 2

Non riesco a duplicare il problema con TrackPopupMenu. Con un semplice test qui con D2007, le didascalie, le immagini, i sottomenu degli oggetti sembrano guardare e funzionare correttamente.

Ad ogni modo, l'esempio seguente installa un gancio CBT appena prima che il menu venga spuntato. Il gancio recupera la finestra associata al menu per poterla suddividere in sottoclasse.

Se non si cura di un possibile lampeggiamento del menu popup in condizioni di stress, invece di un gancio, è possibile utilizzare la classe PopupList per gestire WM_ENTERIDLE per accedere alla finestra del 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;