TPopupMenu OnClose Event

Here's the source of the extended PopupList class you need to add to your projects in order to be able to respond when the popup menu is closed:

unit PopupListEx;  
interface  
  uses Controls;  
  const    
    CM_MENU_CLOSED = CM_BASE + 1001;    
    CM_ENTER_MENU_LOOP = CM_BASE + 1002;    
    CM_EXIT_MENU_LOOP = CM_BASE + 1003;  
implementation  
uses Messages, Forms, Menus;  
type  TPopupListEx = class(TPopupList)    
  protected      
    procedure WndProc(var Message: TMessage) ; override;    
  private      
    procedure PerformMessage(cm_msg : integer; msg : TMessage) ;    
end;  
{ TPopupListEx }
procedure TPopupListEx.PerformMessage(cm_msg: integer; msg : TMessage) ;
begin
     if Screen.Activeform <> nil then
       Screen.ActiveForm.Perform(cm_msg, msg.WParam, msg.LParam) ;
end;
procedure TPopupListEx.WndProc(var Message: TMessage) ;
begin
  case message.Msg of
    WM_ENTERMENULOOP: PerformMessage(CM_ENTER_MENU_LOOP, Message) ;
    WM_EXITMENULOOP : PerformMessage(CM_EXIT_MENU_LOOP, Message) ;
    WM_MENUSELECT :
      with TWMMenuSelect(Message) do      
      begin        
        if (Menu = 0) and (Menuflag = $FFFF) then
        begin
          PerformMessage(CM_MENU_CLOSED, Message) ;
        end;
      end;
  end;    
  inherited;
end;  

initialization;
Popuplist.Free; //free the "default", "old" list    
PopupList:= TPopupListEx.Create; //create the new one    
// The new PopupList will be freed by    
// finalization section of Menus unit.
end.

Here's how to use the PopupListEx unit:
Drop a TPopupMenu on a Delphi form
Add several menu items to the PopupMenu
Include the "PopupListEx" in the uses clause
Write a procedure to handle PopupListEx's messages: CM_MENU_CLOSED, CM_ENTER_MENU_LOOP and CM_EXIT_MENU_LOOP
An example implementation (download):

uses PopupListEx, ...  
TForm1 = class(TForm)  ...
private    
  procedure CM_MenuClosed(var msg: TMessage) ; message CM_MENU_CLOSED;    
  procedure CM_EnterMenuLoop(var msg: TMessage) ; message CM_ENTER_MENU_LOOP;    
  procedure CM_ExitMenuLoop(var msg: TMessage) ; message CM_EXIT_MENU_LOOP;  ...
implementation  
procedure TForm1.CM_EnterMenuLoop(var msg: TMessage) ;
begin
  Caption := 'PopMenu entered';
end;
procedure TForm1.CM_ExitMenuLoop(var msg: TMessage) ;
begin    
  Caption := 'PopMenu exited';
end;  
procedure TForm1.CM_MenuClosed(var msg: TMessage) ;
begin    
  Caption := 'PopMenu closed';
end;

轉貼至 http://delphi.about.com/od/adptips2006/qt/popuplistex.htm