Как выбрать пункт меню, не закрывая меню?

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.

Answer 2

Основываясь на коде @ Sertac и других ресурсах, я создал небольшой блок, который делает класс Interposer TPopupMenu и TMainMenu (также для версий TNT).

Он также обрабатывает подменю (каждый раз, когда подменю активируется, создается новое окно меню с новым дескриптором меню).

Идея состояла в том, чтобы создать определяемый приложением хук (WH_CALLWNDPROC) с максимально коротким сроком службы. Хук будет активен только до тех пор, пока активен модальный цикл меню. Как только ловушка обнаружит новый дескриптор всплывающего окна (через WM_ENTERIDLE), она затем подклассирует его, пока не будет уничтожена.

{.$DEFINE TNT}
unit AppTrackMenus;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Forms, Contnrs, Menus
  {$IFDEF TNT}, TntMenus{$ENDIF};

type
  TTrackMenuNotifyEvent = procedure(Sender: TMenu; Item: TMenuItem; var CanClose: Boolean) of object;

  TPopupMenu = class(Menus.TPopupMenu)
  private
    FTrackMenu: Boolean;
    FOnTrackMenuNotify: TTrackMenuNotifyEvent;
  public
    procedure Popup(X, Y: Integer); override;
    property TrackMenu: Boolean read FTrackMenu write FTrackMenu;
    property OnTrackMenuNotify: TTrackMenuNotifyEvent read FOnTrackMenuNotify write FOnTrackMenuNotify;
  end;

  {$IFDEF TNT}
  TTntPopupMenu = class(TntMenus.TTntPopupMenu)
  private
    FTrackMenu: Boolean;
    FOnTrackMenuNotify: TTrackMenuNotifyEvent;
  public
    procedure Popup(X, Y: Integer); override;
    property TrackMenu: Boolean read FTrackMenu write FTrackMenu;
    property OnTrackMenuNotify: TTrackMenuNotifyEvent read FOnTrackMenuNotify write FOnTrackMenuNotify;
  end;
  {$ENDIF}

  TMainMenu = class(Menus.TMainMenu)
  private
    FTrackMenu: Boolean;
    FOnTrackMenuNotify: TTrackMenuNotifyEvent;
  public
    property TrackMenu: Boolean read FTrackMenu write FTrackMenu;
    property OnTrackMenuNotify: TTrackMenuNotifyEvent read FOnTrackMenuNotify write FOnTrackMenuNotify;
  end;

  {$IFDEF TNT}
  TTntMainMenu = class(TntMenus.TTntMainMenu)
  private
    FTrackMenu: Boolean;
    FOnTrackMenuNotify: TTrackMenuNotifyEvent;
  public
    property Hook: Boolean read FTrackMenu write FTrackMenu;
    property OnTrackMenuNotify: TTrackMenuNotifyEvent read FOnTrackMenuNotify write FOnTrackMenuNotify;
  end;
  {$ENDIF}

procedure FormMainMenuWndProcMessage(var Msg: TMessage; AForm: TCustomForm);

implementation    

const
  { Undocumented Menu Messages }
  MN_SETHMENU                 = $01E0;
  MN_GETHMENU                 = $01E1;
  MN_SIZEWINDOW               = $01E2;
  MN_OPENHIERARCHY            = $01E3;
  MN_CLOSEHIERARCHY           = $01E4;
  MN_SELECTITEM               = $01E5;
  MN_CANCELMENUS              = $01E6;
  MN_SELECTFIRSTVALIDITEM     = $01E7;
  MN_GETPPOPUPMENU            = $01EA;
  MN_FINDMENUWINDOWFROMPOINT  = $01EB;
  MN_SHOWPOPUPWINDOW          = $01EC;
  MN_BUTTONDOWN               = $01ED;
  MN_MOUSEMOVE                = $01EE;
  MN_BUTTONUP                 = $01EF;
  MN_SETTIMERTOOPENHIERARCHY  = $01F0;
  MN_DBLCLK                   = $01F1;

var
  ActiveHookMenu: TMenu = nil;  

type
  TPopupWndList = class;

  TPopupWnd = class
  private
    FHandle: THandle;
    FMenuHandle: HMENU;
    FOrgPopupWindowProc, FHookedPopupWindowProc: Pointer;
    FSelectedItemPos: Integer;
    FSelectedItemID: UINT;
    FHooked: Boolean;
    FPopupWndList: TPopupWndList;
    function GetHMenu: HMENU;
    procedure PopupWindowProc(var Msg: TMessage);
    procedure Hook;
    procedure UnHook;
    procedure MenuSelectPos(Menu: TMenu; ItemPos: UINT; out CanClose: Boolean);
    procedure MenuSelectID(Menu: TMenu; ItemID: UINT; out CanClose: Boolean);
  public
    property Handle: THandle read FHandle write FHandle;
    property MenuHandle: HMENU read FMenuHandle;
    constructor Create(APopupWndList: TPopupWndList; AHandle: THandle); overload;
    destructor Destroy; override;
  end;

  TPopupWndList = class(TObjectList)
  public
    function FindHookedPopupHWnd(MenuWindow: HWND): TPopupWnd;
    function FindHookedPopupHMenu(Menu: HMENU): TPopupWnd;
  end;

{ TPopupWnd }
constructor TPopupWnd.Create(APopupWndList: TPopupWndList; AHandle: THandle);
begin
  inherited Create;
  FHandle := AHandle;
  FMenuHandle := GetHMenu;
  FPopupWndList := APopupWndList;
  Hook;
end;

destructor TPopupWnd.Destroy;
begin
  if FHooked then // JIC: normally UnHook is called in PopupWindowProc WM_DESTROY
    UnHook;
  inherited;
end;

procedure TPopupWnd.Hook;
begin
  FOrgPopupWindowProc := Pointer(GetWindowLong(FHandle, GWL_WNDPROC));
  FHookedPopupWindowProc := MakeObjectInstance(PopupWindowProc);
  SetWindowLong(FHandle, GWL_WNDPROC, Longint(FHookedPopupWindowProc));
  FHooked := True;
end;

procedure TPopupWnd.UnHook;
begin
  SetWindowLong(FHandle, GWL_WNDPROC, Longint(FOrgPopupWindowProc));
  FreeObjectInstance(FHookedPopupWindowProc);
  FHooked := False;
end;

procedure TPopupWnd.PopupWindowProc(var Msg: TMessage);
var
  NormalItem: Boolean;
begin
  case Msg.Msg of
    MN_SELECTITEM:
      begin
        // -1 ($FFFF) => mouse is outside the menu window  
        FSelectedItemPos := Integer(Msg.wParam); // HiWord(Msg.wParam)
      end;
    MN_DBLCLK:
      begin
        Exit; // eat
      end;
    MN_BUTTONDOWN:
      begin
        MenuSelectPos(ActiveHookMenu, UINT(Msg.WParamLo), NormalItem);
        if not NormalItem then
          Exit;
      end;
    WM_KEYDOWN:
      if (Msg.WParam = VK_RETURN) and (FSelectedItemPos <> -1) and (FSelectedItemID <> 0) then begin            
        MenuSelectID(ActiveHookMenu, FSelectedItemID, NormalItem);
        if not NormalItem then
          Exit;
      end;
    WM_DESTROY:
      begin            
        UnHook;
      end;
  end;
  Msg.Result := CallWindowProc(FOrgPopupWindowProc, FHandle, Msg.Msg, Msg.WParam, Msg.LParam);
end;

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

function GetMenuItemPos(Menu: HMENU; ItemID: UINT): Integer;
var
  I: Integer;
  MenuItemInfo: TMenuItemInfo;
begin
  Result := -1;                         
  if IsMenu(Menu) then
    for I := 0 to GetMenuItemCount(Menu) do
    begin
      FillChar(MenuItemInfo, SizeOf(MenuItemInfo), 0);
      MenuItemInfo.cbSize := SizeOf(MenuItemInfo);
      MenuItemInfo.fMask := MIIM_ID;
      if (GetMenuItemInfo(Menu, I, True, MenuItemInfo)) then
        if MenuItemInfo.wID = ItemID then
        begin
          Result := I;
          Exit;
        end;
    end;
end;

procedure TPopupWnd.MenuSelectID(Menu: TMenu; ItemID: UINT; out CanClose: Boolean);
var
  Item: TMenuItem;
  NotifyEvent: TTrackMenuNotifyEvent;
  R: TRect;
begin
  CanClose := True;
  Item := Menu.FindItem(ItemID, fkCommand);
  if Assigned(Item) then
  begin
    NotifyEvent := nil;
    {$IFDEF TNT}
    if Menu is TTntPopupMenu then
      NotifyEvent := TTntPopupMenu(Menu).FOnTrackMenuNotify
    else
    {$ENDIF}
    if Menu is TPopupMenu then
      NotifyEvent := TPopupMenu(Menu).FOnTrackMenuNotify
    else
    {$IFDEF TNT}
    if Menu is TTntMainMenu then
      NotifyEvent := TTntMainMenu(Menu).FOnTrackMenuNotify
    else
    {$ENDIF}
    if Menu is TMainMenu then
      NotifyEvent := TMainMenu(Menu).FOnTrackMenuNotify;

    if Assigned(NotifyEvent) then
      NotifyEvent(Menu, Item, CanClose);

    if not CanClose then
    begin
      Item.Click;
      if GetMenuItemRect(FHandle, FMenuHandle, GetMenuItemPos(FMenuHandle, ItemID), R) then
      begin
        MapWindowPoints(0, FHandle, R, 2);
        InvalidateRect(FHandle, @R, False);
      end else
        InvalidateRect(FHandle, nil, False);
    end;
  end;
end;

function TPopupWnd.GetHMenu: HMENU;
begin
  Result := SendMessage(FHandle, MN_GETHMENU, 0, 0);
end;

{ TPopupWndList }
function TPopupWndList.FindHookedPopupHWnd(MenuWindow: HWND): TPopupWnd;
var
  I: Integer;
  PopupWnd: TPopupWnd;
begin
  Result := nil;
  for I := 0 to Count - 1 do
  begin
    PopupWnd := TPopupWnd(Items[I]);
    if (PopupWnd.FHooked) and (PopupWnd.Handle = MenuWindow) then
    begin
      Result := PopupWnd;
      Exit;
    end;
  end;
end;

function TPopupWndList.FindHookedPopupHMenu(Menu: HMENU): TPopupWnd;
var
  I: Integer;
  PopupWnd: TPopupWnd;
begin
  Result := nil;
  for I := 0 to Count - 1 do
  begin
    PopupWnd := TPopupWnd(Items[I]);
    if (PopupWnd.FHooked) and (PopupWnd.MenuHandle{GetHMenu} = Menu) then
    begin
      Result := PopupWnd;
      Exit;
    end;
  end;
end;

var
  PopupWndList: TPopupWndList = nil;
  MenuCallWndHook: HHOOK = 0;
  SelectedItemID: UINT = 0;
  NeedPopupWindowHandle: Boolean = False;
  InitMenuPopupCount: Integer = 0;

function CallWndHookProc(nCode: Integer; wParam: WPARAM; Msg: PCWPStruct): LRESULT; stdcall;
var
  Menu: HMENU;
  MenuWnd: HWND;
  PopupWnd: TPopupWnd;
begin
  if (nCode = HC_ACTION) then
  begin
    case Msg.message of
      WM_INITMENUPOPUP:
        begin // TWMInitMenuPopup
          Inc(InitMenuPopupCount);
          NeedPopupWindowHandle := True;
          SelectedItemID := 0;
          if PopupWndList = nil then
          begin
            PopupWndList := TPopupWndList.Create(True); // OwnsObjects
          end;
        end;
      WM_UNINITMENUPOPUP:
        begin
          Dec(InitMenuPopupCount);
        end;
      WM_ENTERIDLE:
        begin
          if (Msg.wParam = MSGF_MENU) and NeedPopupWindowHandle then
          begin
            NeedPopupWindowHandle := False;
            MenuWnd := HWND(Msg.lParam);
            if Assigned(PopupWndList) and (PopupWndList.FindHookedPopupHWnd(MenuWnd) = nil) then
              PopupWndList.Add(TPopupWnd.Create(PopupWndList, MenuWnd));
          end;
        end;
      WM_MENUSELECT:
        begin
          // MSDN: If the high-order word of wParam contains 0xFFFF and the lParam parameter contains NULL, the system has closed the menu.
          if (Msg.lParam = 0) and (HiWord(Msg.wParam) = $FFFF) then // Menu Closed
          begin
            FreeAndNil(PopupWndList);
          end
          else
          begin
            Menu := HMENU(Msg.lParam);
            if HiWord(Msg.wParam) and MF_POPUP <> 0 then // fkHandle
              SelectedItemID := GetSubMenu(Menu, LoWord(Msg.WParam))
            else // fkCommand
              SelectedItemID := LoWord(Msg.wParam); // TWMMenuSelect(Msg).IDItem;
            if Assigned(PopupWndList) then
            begin
              PopupWnd := PopupWndList.FindHookedPopupHMenu(Menu);
              if Assigned(PopupWnd) then
              begin
                PopupWnd.FSelectedItemID := LoWord(Msg.wParam);
              end;
            end;
          end;
        end;
    end;
  end;
  Result := CallNextHookEx(MenuCallWndHook, nCode, WParam, Longint(Msg));
end;

procedure InstallMenuCallWndHook(Menu: TMenu);
begin
  ActiveHookMenu := Menu;
  MenuCallWndHook := SetWindowsHookEx(WH_CALLWNDPROC, @CallWndHookProc, 0, GetCurrentThreadId);
end;

procedure UnInstallMenuCallWndHook;
begin
  if MenuCallWndHook <> 0 then
    UnHookWindowsHookEx(MenuCallWndHook);
  MenuCallWndHook := 0;
  ActiveHookMenu := nil;
  PopupWndList := nil;
end;

{ TPopupMenu }
procedure TPopupMenu.Popup(X, Y: Integer);
begin
  if not FTrackMenu then
    inherited
  else
  try
    InstallMenuCallWndHook(Self);
    inherited;
  finally
    UnInstallMenuCallWndHook;
  end;
end;

{ TTntPopupMenu }
{$IFDEF TNT}
procedure TTntPopupMenu.Popup(X, Y: Integer);
begin
  if not FTrackMenu then
    inherited
  else
  try
    InstallMenuCallWndHook(Self);
    inherited;
  finally
    UnInstallMenuCallWndHook;
  end;
end;
{$ENDIF}

function GetMenuForm(Menu: TMenu): TCustomForm;
var
  LForm: TWinControl;
begin
  Result := nil;
  if Menu.WindowHandle <> 0 then
  begin
    LForm := FindControl(Menu.WindowHandle);
    if (LForm <> nil) and (LForm is TCustomForm) then
      Result := LForm as TCustomForm;
  end;
end;

function FormMainMenuIsValid(AForm: TCustomForm): Boolean;
begin
  Result := False;
  if Assigned(AForm) and Assigned(AForm.Menu) then
  begin
    {$IFDEF TNT}
    if (AForm.Menu is TTntMainMenu) then
      Result := TTntMainMenu(AForm.Menu).FTrackMenu
    else
    {$ENDIF}
    if (AForm.Menu is TMainMenu) then
      Result := TMainMenu(AForm.Menu).FTrackMenu;
  end;
end;

procedure FormMainMenuWndProcMessage(var Msg: TMessage; AForm: TCustomForm);
begin
  if not FormMainMenuIsValid(AForm) then
    Exit;

  case Msg.Msg of
    WM_INITMENU:
      begin
        // MSDN: Sent when a menu is about to become active. It occurs when the user clicks an item on the menu bar or presses a menu key.
        // A window receives this message through its WindowProc function
        // A WM_INITMENU message is sent only when a menu is first accessed; only one WM_INITMENU message is generated for each access.
        // For example, moving the mouse across several menu items while holding down the button does not generate new messages
        InstallMenuCallWndHook(AForm.Menu);
      end;
    WM_MENUSELECT:
      begin
        // MSDN: If the high-order word of wParam contains 0xFFFF and the lParam parameter contains NULL, the system has closed the menu.
        if (Msg.lParam = 0) and (HiWord(Msg.wParam) = $FFFF) then // Menu Closed
        begin
          UnInstallMenuCallWndHook;
        end;
      end;
  end;
end;

end.

Использование:

Укажите TPopupMenu и / или TMainMenu в форме. в uses включают AppTrackMenus после Menus. Создайте несколько пунктов меню и для каждого пункта меню, который вы не хотите закрывать при нажатии, установите Tag = 666 (для этого примера). Вы можете назначить каждому из этих элементов OnClick обработчик событий CheckNoCloseClick.

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

TForm1 = class(TForm)
...
  procedure CheckNoCloseClick(Sender: TObject);
protected
  procedure WndProc(var Msg: TMessage); override; // for TMainMenu
private
  procedure TrackMenuNotifyHandler(Sender: TMenu; Item: TMenuItem; var CanClose: Boolean);
end;

implementation

procedure TForm1.FormCreate(Sender: TObject);
begin
  PopupMenu1.TrackMenu := True;
  PopupMenu1.OnTrackMenuNotify := TrackMenuNotifyHandler;
  MainMenu1.TrackMenu := True;
  MainMenu1.OnTrackMenuNotify := TrackMenuNotifyHandler;
end;

procedure TForm1.CheckNoCloseClick(Sender: TObject);
begin
  TMenuItem(Sender).Checked := not TMenuItem(Sender).Checked;
end;

procedure TForm1.TrackMenuNotifyHandler(Sender: TMenu; Item: TMenuItem; var CanClose: Boolean);
begin
  Caption := Sender.ClassName + '-' + Item.ClassName + '-' + Item.Name;
  CanClose := Item.Tag <> 666;
end;

procedure TForm1.WndProc(var Msg: TMessage); // for TMainMenu
begin
  FormMainMenuWndProcMessage(Msg, Self);
  inherited;
end;

Интерпозер TMainMenu может быть улучшен путем подклассификации его формы во время выполнения, по требованию (путем установки нового Form.WindowProc) без необходимости переопределения WndProc для каждой формы. Но обычно есть только одно главное меню для каждого приложения. Может быть, следующая версия ...:)

Проверено в XP / Vista / Win7

Answer 3

Я предполагаю, что, хотя это приемлемо, вам, вероятно, следует подумать о написании собственной системы меню, с использованием панелей или форм, или полного пользовательского набора элементов управления / компонентов, и вообще не использовать стандартный TPopupMenu или TMainMenu, если вы хотитесделайте это.

Если вам нужен исходный код для начинающих, я бы начал с чего-то вроде Источников Toolbar2000 + SpTBX.Я почти уверен, что вы сможете сделать это, используя их, но не с TMainMenu и TPopupMenu, потому что они обертывают некоторые встроенные функции Win32, которые будут иметь поведение (включая закрытие, когда вы не хотите), которое невозможно переопределить.

Вы также можете сделать что-то подобное из коробки с компонентами панели инструментов Developer Express.

Answer 4

Недавно у меня возникла такая же потребность, и я обнаружил, что элементы управления TMS Smooth имеют «отрывные» меню, которые имеют аналогичную функцию, но требуют (как указано в названии), чтобы меню было, ну, оторвано!Я никогда не обращал на это внимания, потому что мои потребности были недостаточно сильны, чтобы оправдать время, деньги или использование стороннего продукта.Но я использовал другие их вещи, которые были первоклассными.

Не уверен, что их оторванные меню удовлетворят ваши потребности, но вы, возможно, захотите изучить это.

http://www.tmssoftware.com/site/advsmoothmegamenu.asp