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

有时需要在软件中判断右键菜单是处于弹出还是关闭状态，但是在Delphi中，PopupMenu只有弹出的事件，没有关闭的事件。网上找了很久，没有看到合适的方法。有一个介绍是使用Win32API中的TrackPopupMenu，但是这个方法对稍微复杂一点的菜单就会出现显示错误，还是不行。最后在Advanced Application Controls组件中发现了acApartPopupMenu控件，它增加了一个onCloseUp的事件，这样就可以方便的知道popupmenu的状态了。

因为Advanced Application Controls比较大，所以我把TacApartPopupMenu单独提取出来，直接安装成新控件就可以替代原有的popupmenu了。

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

end.