Làm thế nào để bạn xếp hàng TPopupMenu để nó chính xác vị trí chính nó trên một nút?

Question

Tôi muốn có một popup menu ở trên một nút:

Delphi kết thúc tốt đẹp hệ thống menu Win32 trong một cách mà dường như ngăn cản mỗi chế độ hoặc cờ mà cơ bản Win32 API cung cấp đó không phải là trong tác giả của VCL não vào ngày đó. Một ví dụ có vẻ như là TPM_BOTTOMALIGN có thể được chuyển vào TrackPopupMenu nhưng, trình bao bọc Delphi dường như không thể làm điều này không chỉ trong VCL cổ phiếu, mà bằng cách sử dụng các phương pháp riêng tư và được bảo vệ cẩn thận là điều không thể là không thể) để thực hiện chính xác vào thời gian chạy hoặc bằng ghi đè. Thành phần VCL TPopupMenu không được thiết kế rất tốt, vì nó phải có một phương thức ảo gọi là PrepareForTrackPopupMenu đã làm mọi thứ khác ngoài lệnh gọi TrackPopupMenu hoặc TrackPopupMenuEx, và sau đó cho phép người khác ghi đè phương thức thực sự gọi phương thức Win32 đó. Nhưng giờ đã quá muộn rồi. Có lẽ Delphi XE5 sẽ có phạm vi bảo hiểm cơ bản của API Win32 được thực hiện đúng.

phương pháp tiếp cận Tôi đã thử:

Tiếp cận A: Sử dụng số liệu hoặc Fonts:

xác định chính xác chiều cao của một popup menu để tôi có thể trừ đi giá trị Y trước khi gọi popupmenu.Popup (x, y). Kết quả: Sẽ phải xử lý tất cả các biến thể của Windows theming, và làm cho các giả định mà tôi dường như không thể chắc chắn về. Dường như không có kết quả tốt trong thế giới thực. Dưới đây là một ví dụ về cách tiếp cận của font chữ cơ bản:

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

Bạn có thể đưa vào các mục ẩn tài khoản, và cho một phiên bản duy nhất của cửa sổ với một thiết lập chế độ chủ đề duy nhất có hiệu lực, bạn có thể nhận được gần như thế, nhưng không phải chính xác.

Tiếp cận B: Chúng ta hãy cầu Windows thực hiện:

Cố gắng vượt qua trong TPM_BOTTOMALIGN để cuối cùng đạt Win32 API gọi TrackPopupMenu.

Cho đến nay, tôi nghĩ rằng tôi có thể làm điều đó, nếu tôi sửa đổi các menu VCL.pas .. Tôi đang sử dụng Delphi 2007 trong dự án này. Tôi không phải tất cả những gì hạnh phúc về ý tưởng đó.

Dưới đây là các loại mã tôi đang cố gắng:

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; 

Ngoài ra tôi muốn làm điều này:

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

Tất nhiên, popupEx là không có trong VCL. Cũng không có cách nào để chuyển vào nhiều hơn cờ đến TrackPopupMenu so với những người mà VCL đã thêm vào có thể vào năm 1995, trong phiên bản 1.0.

Lưu ý: Tôi tin rằng vấn đề ước tính chiều cao trước khi hiển thị menu là không thể, do đó chúng tôi thực sự cần giải quyết vấn đề bằng cách TrackPopupMenu không bằng cách ước tính chiều cao.

Cập nhật: Gọi TrackPopupMenu trực tiếp không hoạt động, vì các bước còn lại trong phương pháp VCL TPopupMenu.Popup(x,y) là cần thiết để ứng dụng của tôi vẽ thực đơn của nó và có vẻ chính xác, tuy nhiên không thể gọi chúng lừa bởi vì họ là phương pháp riêng tư. Sửa đổi VCL là một đề xuất địa ngục và tôi cũng không muốn giải trí.

Answer 1

Một chút hacky, nhưng nó có thể giải quyết được.

Khai báo một lớp đánh chặn cho TPopupMenu trọng 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; 

Bí quyết là để gửi một thông điệp hủy vào cửa sổ trình đơn mà hủy bỏ TrackPopupMenu gọi kế thừa.

Answer 2

Tôi không thể sao chép vấn đề của bạn với TrackPopupMenu. Với một bài kiểm tra đơn giản ở đây với D2007, các chú thích, hình ảnh, menu phụ có vẻ giống và hoạt động chính xác.

Dù sao, ví dụ bên dưới cài đặt móc CBT ngay trước khi menu được bật. Móc lấy cửa sổ liên kết với trình đơn để có thể phân lớp nó.

Nếu bạn không quan tâm đến khả năng nhấp nháy của menu bật lên trong điều kiện căng thẳng, thay vì móc, bạn có thể sử dụng lớp PopupList để xử lý WM_ENTERIDLE để đến cửa sổ trình đơn.

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;