Подтвердить что ты не робот

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

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

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

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

Существует ли стандартизированный способ достижения этого?

Спасибо

Craig.

4b9b3361

ОТВЕТЫ

Ответ 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.

Ответ 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.

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

Отбросьте a 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 Interposer может быть улучшен путем подклассификации формы во время выполнения, по требованию (путем установки нового Form.WindowProc) без необходимости переопределения WndProc для каждой Формы. Но обычно для каждого приложения обычно используется только одно главное меню. Возможно, следующая версия...:)

Протестировано в XP/Vista/Win7

Ответ 3

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

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

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

Ответ 4

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

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

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