2009. szeptember 14., hétfő

Detect when a TPopupMenu is closed


Problem/Question/Abstract:

Is it possible to know when a popup menu closes? I really need to differentiate between when a user selects an item or when the menu disappears because the user clicks somewhere else and it loses focus. Is there some message sent to the app window once TrackPopupMenu() returns?

Answer:

Solve 1:

There are messages that are send to the window specified as the menus owner in the call to TrackPopupMenu. If you are using Delphi 5, add the following unit to your project and your form will get the three custom messages defined in the units interface:

unit ExPopupList;

interface

uses Controls;

const
  CM_MENUCLOSED = CM_BASE - 1;
  CM_ENTERMENULOOP = CM_BASE - 2;
  CM_EXITMENULOOP = CM_BASE - 3;

implementation

uses Messages, Forms, Menus;

type
  TExPopupList = class(TPopupList)
  protected
    procedure WndProc(var Message: TMessage); override;
  end;

  { TExPopupList }

procedure TExPopupList.WndProc(var Message: TMessage);

  procedure Send(msg: Integer);
  begin
    if Assigned(Screen.Activeform) then
      Screen.ActiveForm.Perform(msg, Message.wparam, Message.lparam);
  end;

begin
  case message.Msg of
    WM_ENTERMENULOOP:
      Send(CM_ENTERMENULOOP);
    WM_EXITMENULOOP:
      Send(CM_EXITMENULOOP);
    WM_MENUSELECT:
      with TWMMenuSelect(Message) do
        if (Menuflag = $FFFF) and (Menu = 0) then
          Send(CM_MENUCLOSED);
  end;
  inherited;
end;

initialization
  Popuplist.Free;
  PopupList := TExPopupList.Create;
  {Note: will be freed by Finalization section of Menus unit}

end.


Solve 2

The TPopupMenu.Popup method (which is used to display such a menu even when presented "automatically" by the VCL) has it's own message pump whilst being displayed. i.e. the Popup procedure only returns to the caller when the menu has been dismissed.

I used this feature to implement a minor extension to TPopupMenu that not only raises an event when the menu has been dismissed, but also peeks in the relevant message queue for the presence of a WM_COMMAND message - i.e. was the menu dismissed because an item was selected or because the menu was cancelled with no item selected. This can then be reflected in the event.

{ ... }
type
  TIXPopupMenuEvent = procedure(Sender: TObject; Cancelled: Boolean) of object;

  TIXPopupMenu = class(TPopupMenu)
  private
    eOnDismissed: TIXPopupMenuEvent;
  public
    procedure Popup(X, Y: Integer); override;
  published
    property OnDismissed: TIXPopupMenuEvent read eOnDismissed write eOnDismissed;
  end;

implementation

{TIXPopupMenu}

procedure TIXPopupMenu.Popup(X, Y: Integer);
var
  msg: tagMSG;
begin
  inherited;
  if Assigned(OnDismissed) then
    OnDismissed(Self, PeekMessage(msg, PopupList.Window, WM_COMMAND,
      WM_COMMAND, PM_NOREMOVE) = FALSE);
end;

Nincsenek megjegyzések:

Megjegyzés küldése