delphi - How to select a Menu Item without closing the Menu?

Question

By default when you select an item from a TMainMenu or TPopupMenu etc, the menu closes after it was clicked. I would like to change this behavior so that when I select on a menu item, the menu does not close but remains visible and open at the point it was last clicked, making it easier to select another menu item if desired. Of course, switching focus to another control should hide the menu like normal, but if the focus is still on the menu keep it visible.

If this is possible, I would like this behavior to only work on specified menu items. In other words, if I can make all the menu items work like normal, but if I specify one or two menu items, these will not close the menu when selected.

The reason I want to do this is like so, I have a Preferences form in my Application where many options can be configured, the usual stuff etc, but also in the Main Form I have some of the common more frequent used options set in a TMainMenu. These common options in my menu I would like to be able to select without closing the menu, so that other options can be selected for example without having to navigate through the menu items.

Is there a standardized way of achieving this?

Thanks

Craig.

Answer 1

In the below code, when right clicked on the panel on the form, a popup menu with three items is launched. The first item behaves normally, the other two items also fires their click events but the popup menu is not closed.

The popup is launched with 'TrackPopupMenu', if instead you'd like to use 'OnPopup' events, or need to use sub menus having non-closing items, refer to the link in the comment I posted to your question. Adapting the code for a main menu would not be difficult as well..

I'm not commenting the code not to promote the usage of the approach since it makes use of an undocumented message, also I feel it is a bit convoluted..

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.