原创如何判断软件中右键菜单是弹出还是关闭

 2009-2-27 09:54  3960 24 4 分类: 软件与OS

有时需要在软件中判断右键菜单是处于弹出还是关闭状态，但是在Delphi中，PopupMenu只有弹出的事件，没有关闭的事件。网上找了很久，没有看到合适的方法。有一个介绍是使用Win32API中的TrackPopupMenu，但是这个方法对稍微复杂一点的菜单就会出现显示错误，还是不行。最后在Advanced Application Controls组件中发现了acApartPopupMenu控件，它增加了一个onCloseUp的事件，这样就可以方便的知道popupmenu的状态了。 因为Advanced Application Controls比较大，所以我把TacApartPopupMenu单独提取出来，直接安装成新控件就可以替代原有的popupmenu了。  <pre><code>unit acApartPopupMenuinterface uses Windows Messages Classes Controls Menustype TacApartPopupMenu class TacInternalPopupList classTPopupList protected FPopupMenu TacApartPopupMenu procedure WndProcvar Message TMessage override public constructor CreateaPopupMenu TacApartPopupMenu destructor Destroy override end TacApartPopupMenu classTPopupMenu private FAbout String FCursor TCursor FOnCloseUp TNotifyEvent FInternalPopupList TacInternalPopupList protected public constructor CreateaOwner TComponent override destructor Destroy override procedure PopupX Y Integer override procedure PopupFromCursorPos published property About String read FAbout write FAbout stored False property Cursor TCursor read FCursor write FCursor default crDefault property OnCloseUp TNotifyEvent read FOnCloseUp write FOnCloseUp endimplementation uses Formsconstructor TacInternalPopupListCreateaPopupMenu TacApartPopupMenubegin inherited Create FPopupMenu aPopupMenu AddFPopupMenuenddestructor TacInternalPopupListDestroybegin RemoveFPopupMenu inheritedendprocedure TacInternalPopupListWndProcvar Message TMessagevar MenuItem TMenuItem FindKind TFindItemKind ContextID Integerbegin if Count then with Message FPopupMenu do case Msg of WM_EXITMENULOOP if AssignedFOnCloseUp then FOnCloseUpFPopupMenu WM_MENUSELECT with TWMMenuSelectMessage do begin FindKind fkCommand if MenuFlag and MF_POPUP then begin FindKind fkHandle ContextId GetSubMenuMenu IDItem end else ContextId IDItem MenuItem FindItemContextId FindKind if MenuItem nil then begin ApplicationHint MenuItemHint if FCursor crDefault then if MenuFlag and MF_HILITE then SetCursorScreenCursorsFCursor else SetCursorScreenCursorscrDefault Exit end end end inheritedendconstructor TacApartPopupMenuCreateaOwner TComponentbegin inherited FInternalPopupList TacInternalPopupListCreateSelfenddestructor TacApartPopupMenuDestroybegin FInternalPopupListFree inheritedendprocedure TacApartPopupMenuPopupX Y Integervar OriginalPopupList TPopupListbegin OriginalPopupList PopupList PopupList FInternalPopupList try inherited finally PopupList OriginalPopupList endendprocedure TacApartPopupMenuPopupFromCursorPosvar P TPointbegin GetCursorPosP PopupPX PYend</code></pre><pre><code></code></pre> end.

工程师专属征文！分享知识经验，就能拿奖励～