In D5 there is finally a method to detect when the menu was closed without a
selection (i.e. none of the menuitem OnClick handlers fired). Add the unit
below to your project and the form the popup menu is on will receive the
custom messages defined in the unit when the menu appears or closes.
missing TPopupMenu feature: checking for visibility
Posted by jpluimers on 2019/06/25
a method to detect when the menu was closed without a selection (i.e. none of the menuitem OnClick handlers fired). Add the unit below to your project and the form the popup menu is on will receive the custom messages defined in the unit when the menu appears or closes.
The solution by Peter Below in ExPopupList works from D5 on: [Archive.is] missing TPopupMenu features? – Google Groups.
Now you can hook the [WayBack] TControl.OnContextPopup Event for a [WayBack] TPopupMenu activation, and the custom Windows messages CM_MENUCLOSED, CM_ENTERMENULOOP and CM_EXITMENULOOP to monitor the state of the popup menu.
Via:
- [WayBack] popupmenu – Delphi Pop Up menu visibilty – Stack Overflow
- [WayBack] Check if popupmenu is visible – Delphi Pages Forums
–jeroen
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| 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; { Case } | |
| inherited; | |
| end; | |
| Initialization | |
| Popuplist.Free; | |
| PopupList:= TExPopupList.Create; | |
| // Note: will be freed by Finalization section of Menus unit. | |
| end. |






Leave a comment