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;
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése