delphi - 如何在不关闭菜单的情况下选择菜单项？

Question

默认情况下，当您从 TMainMenu 或 TPopupMenu 等中选择一个项目时，菜单将在单击后关闭。我想更改此行为，以便当我选择菜单项时，菜单不会关闭，而是在上次单击时保持可见并打开，从而可以更轻松地选择另一个菜单项(如果需要)。当然，将焦点切换到另一个控件应该像平常一样隐藏菜单，但如果焦点仍在菜单上，则保持其可见。

如果可能的话，我希望此行为仅适用于指定的菜单项。换句话说，如果我可以使所有菜单项像平常一样工作，但如果我指定一两个菜单项，则这些菜单项在选择时不会关闭菜单。

我想这样做的原因是这样的，我的应用程序中有一个首选项表单，可以配置许多选项，常用的东西等，而且在主表单中我有一些常见的更频繁使用的选项在 TMainMenu 中设置。我希望能够在不关闭菜单的情况下选择菜单中的这些常见选项，这样就可以选择其他选项，而无需浏览菜单项。

是否有实现这一目标的标准化方法？

谢谢

克雷格。

Answer 1

在下面的代码中，当右键单击表单上的面板时，将启动一个包含三个项目的弹出菜单。第一个项目表现正常，其他两个项目也触发其单击事件，但弹出菜单未关闭。

弹出窗口是通过“TrackPopupMenu”启动的，如果您想使用“OnPopup”事件，或者需要使用具有非关闭项的子菜单，请参阅我针对您的问题发布的评论中的链接。调整主菜单的代码也不难。

我对代码进行评论并不是为了推广该方法的使用，因为它使用了未记录的消息，而且我觉得它有点复杂。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ExtCtrls;

type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    Item1Normal1: TMenuItem;
    Item2NoClose1: TMenuItem;
    Item3NoClose1: TMenuItem;
    Panel1: TPanel;
    procedure Panel1ContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);
  private
    FGetPopupWindowHandle: Boolean;
    FPopupWindowHandle: HWND;
    OrgPopupWindowProc, HookedPopupWindowProc: Pointer;
    FSelectedItemID: UINT;
    procedure WmInitMenuPopup(var Msg: TWMInitMenuPopup); message WM_INITMENUPOPUP;
    procedure WmEnterIdle(var Msg: TWMEnterIdle); message WM_ENTERIDLE;
    procedure WmMenuSelect(var Msg: TWMMenuSelect); message WM_MENUSELECT;
    procedure PopupWindowProc(var Msg: TMessage);
    procedure MenuSelectPos(Menu: TMenu; ItemPos: UINT; out CanClose: Boolean);
    procedure MenuSelectID(Menu: TMenu; ItemID: UINT; out CanClose: Boolean);
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Panel1ContextPopup(Sender: TObject; MousePos: TPoint;
  var Handled: Boolean);
var
  Pt: TPoint;
begin
  Pt := (Sender as TPanel).ClientToScreen(MousePos);
  TrackPopupMenu(PopupMenu1.Handle, 0, Pt.X, Pt.Y, 0, Handle, nil);
end;

procedure TForm1.WmInitMenuPopup(var Msg: TWMInitMenuPopup);
begin
  inherited;
  if Msg.MenuPopup = PopupMenu1.Handle then
    FGetPopupWindowHandle := True;
end;

procedure TForm1.WmEnterIdle(var Msg: TWMEnterIdle);
begin
  inherited;
  if FGetPopupWindowHandle then begin
    FGetPopupWindowHandle := False;
    FPopupWindowHandle := Msg.IdleWnd;

    HookedPopupWindowProc := classes.MakeObjectInstance(PopupWindowProc);
    OrgPopupWindowProc := Pointer(GetWindowLong(FPopupWindowHandle, GWL_WNDPROC));
    SetWindowLong(FPopupWindowHandle, GWL_WNDPROC, Longint(HookedPopupWindowProc));
  end;
end;

procedure TForm1.WmMenuSelect(var Msg: TWMMenuSelect);
begin
  inherited;
  if Msg.Menu = PopupMenu1.Handle then
    FSelectedItemID := Msg.IDItem;
end;


const
  MN_BUTTONDOWN = $01ED;

procedure TForm1.PopupWindowProc(var Msg: TMessage);
var
  NormalItem: Boolean;
begin
  case Msg.Msg of
    MN_BUTTONDOWN:
      begin
        MenuSelectPos(PopupMenu1, UINT(Msg.WParamLo), NormalItem);
        if not NormalItem then
          Exit;
      end;
    WM_KEYDOWN:
      if Msg.WParam = VK_RETURN then begin
        MenuSelectID(PopupMenu1, FSelectedItemID, NormalItem);
        if not NormalItem then
          Exit;
      end;
    WM_DESTROY:
      begin
        SetWindowLong(FPopupWindowHandle, GWL_WNDPROC, Longint(OrgPopupWindowProc));
        classes.FreeObjectInstance(HookedPopupWindowProc);
      end;
  end;

  Msg.Result := CallWindowProc(OrgPopupWindowProc, FPopupWindowHandle,
      Msg.Msg, Msg.WParam, Msg.LParam);

end;


procedure TForm1.MenuSelectID(Menu: TMenu; ItemID: UINT; out CanClose: Boolean);
var
  Item: TMenuItem;
begin
  CanClose := True;
  Item := Menu.FindItem(ItemID, fkCommand);
  if Assigned(Item) then begin
    // Menu Item is clicked
    Item.Click;
//    Panel1.Caption := Item.Name;
    CanClose := Item = Item1Normal1;
  end;
end;

procedure TForm1.MenuSelectPos(Menu: TMenu; ItemPos: UINT; out CanClose: Boolean);
begin
  MenuSelectID(Menu, GetMenuItemID(Menu.Handle, ItemPos), CanClose);
end;

end.