默认情况下,当您从TMainMenu或TPopupMenu等中选择一个项目时,菜单会在单击后关闭。我想改变这种行为,以便当我选择一个菜单项时,菜单不会关闭但仍然可见并在最后一次点击时打开,这样可以更容易地选择另一个菜单项。当然,将焦点切换到另一个控件应该像正常一样隐藏菜单,但如果焦点仍然在菜单上,请保持可见。
如果可以,我希望此行为仅适用于指定的菜单项。换句话说,如果我可以使所有菜单项正常工作,但如果我指定一个或两个菜单项,那么这些菜单项在选择时不会关闭菜单。
我想这样做的原因是这样的,我在我的应用程序中有一个Preferences表单,其中可以配置许多选项,通常的东西等,但也在主表单中我有一些常见的更常用的选项设置在TMainMenu中。我希望能够在不关闭菜单的情况下选择这些常用选项,以便可以选择其他选项,而无需浏览菜单项。
是否有标准化的方法来实现这一目标?
由于
克雷格。
答案 0 :(得分:11)
在下面的代码中,右键单击表单上的面板时,会启动一个包含三个项目的弹出菜单。第一项表现正常,另外两项也会触发其点击事件,但弹出式菜单未关闭。
弹出窗口是使用'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.
答案 1 :(得分:7)
基于@ Sertac的代码和其他资源,我创建了一个小型单元,它构成了TPopupMenu
和TMainMenu
的Interposer类(也适用于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
。在<{em> 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中测试
答案 2 :(得分:4)
我的猜测是,虽然这是可以接受的,但你应该考虑编写自己的菜单系统,使用面板或表格,或完整的自定义控件/组件集,如果你想要的话,根本不使用标准的TPopupMenu或TMainMenu这样做。
如果你想要一些入门源代码,我会从像Toolbar2000 + SpTBX Sources这样的东西开始。我很确定你能用这些来实现这一点,但不能用TMainMenu和TPopupMenu完成,因为它们包含了一些Win32内置函数,这些内置函数会有行为(包括在你不想要的时候关闭),它是不可能覆盖的。 / p>
您也可以使用Developer Express工具栏组件开箱即用。
答案 3 :(得分:2)
我最近有同样的需求,并发现TMS Smooth控件有“撕下”菜单,它具有类似的功能,但需要(如名称所示)菜单,嗯,撕掉!我从未接受过,因为我的需求不足以证明时间,金钱或第三方产品的使用是合理的。但是,我已经使用过其他一流的东西了。
不确定他们的撕下菜单是否会满足您的需求,但您可能想要查看它。