9

ボタンの上にポップアップメニューが欲しい：

ここに画像の説明を入力

Delphi は、その時点では VCL 作成者の頭になかった、基礎となる Win32 API が提供するすべてのモードまたはフラグを排除するように見える方法で、Win32 メニュー システムをラップします。そのような例の 1 つは、TPM_BOTTOMALIGNwhich を渡すことができるようTrackPopupMenuに見えますが、Delphi ラッパーは、ストック VCL でこれを不可能にするだけでなく、プライベート メソッドと保護されたメソッドの無分別な使用によって、これを不可能にするように見えます (少なくとも私には不可能に思えます)。 ) 実行時に正確に行うか、オーバーライドによって行います。VCL コンポーネントの TPopupMenuもあまり適切に設計されていませんPrepareForTrackPopupMenu。TrackPopupMenuTrackPopupMenuEx、そしてその Win32 メソッドを実際に呼び出すメソッドを誰かがオーバーライドできるようにします。しかし、それは今では遅すぎます。おそらく、Delphi XE5 では、この Win32 API の基本的なカバーが適切に行われるでしょう。

私が試したアプローチ：

アプローチ A: METRICS またはフォントを使用する:

popupmenu.Popup(x,y) を呼び出す前に Y 値を減算できるように、ポップアップ メニューの高さを正確に決定します。結果: Windows テーマのすべてのバリアントを処理する必要があり、確信が持てないように思われる仮定を立てる必要があります。現実の世界で良い結果が得られる可能性は低いようです。基本的なフォント メトリクス アプローチの例を次に示します。

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

非表示のアイテムを考慮に入れることができます。単一のテーマ モード設定が有効になっている単一バージョンの Windows では、そのように近づくかもしれませんが、正確には正しくありません。

アプローチ B: Windows に任せる:

TPM_BOTTOMALIGN最終的に Win32 API call に到達するために渡してみてください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おそらく 1995 年にバージョン 1.0 で VCL 関係者が追加したものよりも多くのフラグを渡す方法はありません。

注: メニューを表示する前に高さを見積もるという問題は不可能だと思います。したがって、実際にはTrackPopupMenu、高さを見積もらないことで問題を解決する必要があります。

更新: TrackPopupMenuVCL メソッドの残りのステップは、アプリケーションがメニューをペイントして正しく表示されるようにするために呼び出す必要があるため、直接呼び出すことはできませんTPopupMenu.Popup(x,y) が、プライベート メソッドであるため、邪悪な策略なしでそれらを呼び出すことは不可能です。 . VCL を変更することは地獄のような命題であり、私もそれを楽しませたくありません。

4

2 に答える 2

6

少しハッキーですが、解決するかもしれません。

Popup をオーバーライドする 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 呼び出しをキャンセルするキャンセル メッセージをメニュー ウィンドウに投稿することです。

于 2013-05-31T15:56:45.253 に答える
2

の問題を再現できませんTrackPopupMenu。ここで D2007 を使用した簡単なテストを行うと、アイテムのキャプション、画像、サブメニューが正しく表示され、機能するように見えます。

とにかく、以下の例では、メニューがポップされる直前に CBT フックをインストールします。フックは、メニューに関連付けられたウィンドウを取得して、サブクラス化できるようにします。

ストレスの多い状況下でポップアップ メニューが点滅する可能性を気にしない場合は、フックの代わりにPopupListクラス to handleWM_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;
于 2013-06-01T13:30:11.893 に答える