Drop-down menu for any TControl

Question

Continue this topic:

Drop-down menu for TButton

I wrote a generic code for memo DropDown with any TControl , but for some reason the dose is not working as expected using TPanel :

 var TickCountMenuClosed: Cardinal = 0; LastPopupControl: TControl; type TDropDownMenuHandler = class public class procedure MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); end; TControlAccess = class(TControl); class procedure TDropDownMenuHandler.MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if LastPopupControl <> Sender then Exit; if (Button = mbLeft) and not ((TickCountMenuClosed + 100) < GetTickCount) then begin if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0); ReleaseCapture; // SetCapture(0); if Sender is TGraphicControl then Abort; end; end; procedure RegisterControlDropMenu(Control: TControl; PopupMenu: TPopupMenu); begin TControlAccess(Control).OnMouseDown := TDropDownMenuHandler.MouseDown; end; procedure DropMenuDown(Control: TControl; PopupMenu: TPopupMenu); var APoint: TPoint; begin LastPopupControl := Control; RegisterControlDropMenu(Control, PopupMenu); APoint := Control.ClientToScreen(Point(0, Control.ClientHeight)); PopupMenu.PopupComponent := Control; PopupMenu.Popup(APoint.X, APoint.Y); TickCountMenuClosed := GetTickCount; end; 

As much as possible?

This works well with TButton and TSpeedButton and with any TGraphicControl (e.g. TImage or TSpeedButton , etc.).

BUT does not work as expected using TPanel

 procedure TForm1.Button1Click(Sender: TObject); begin DropMenuDown(Sender as TControl, PopupMenu1); end; procedure TForm1.Panel1Click(Sender: TObject); begin DropMenuDown(Sender as TControl, PopupMenu1); // Does not work! end; procedure TForm1.SpeedButton1Click(Sender: TObject); begin DropMenuDown(Sender as TControl, PopupMenu1); end; procedure TForm1.Image1Click(Sender: TObject); begin DropMenuDown(Sender as TControl, PopupMenu1); end; 

TPanel does not seem to comply with ReleaseCapture; and not even Abort in the case of TDropDownMenuHandler.MouseDown . What can I do to make this work with TPanel and other controls? What am I missing?

Answer 1

Not that the TPanel did not comply with ReleaseCapture , the capture does not matter at all. This happens after the popup menu is launched and activated, and the control is clicked again:

• Clicking cancels the cycle of the modal menu, the menu closes and a mouse down message is displayed.
• VCL sets the flag in the processing of mouse messages [csClicked] .
• The mouse event handler is called, you release the capture.
• After the mouse message is omitted, the processed message is pushed up, the VCL checks the flag and clicks the control if it is set.
• The click handler displays a menu.

Of course, I did not follow the working example, so I can not say when and how ReleaseCapture is useful. In any case, this cannot help.

---

The solution I propose is slightly different from the existing project.

We want to make a second click so as not to trigger a click. See this piece of code:

 procedure DropMenuDown(Control: TControl; PopupMenu: TPopupMenu); var APoint: TPoint; begin ... PopupMenu.PopupComponent := Control; PopupMenu.Popup(APoint.X, APoint.Y); TickCountMenuClosed := GetTickCount; end; 

The second click is what closes the menu before starting it again through the same handler. This PopupMenu.Popup call to PopupMenu.Popup . Therefore, we can say that the mouse button is pressed (either the left button or double-click), but the VCL has not yet been processed. This means that the message is still in the queue.

Remove the registration mechanism (hacker mouse manipulator) with this approach, it is not needed, but the class itself and global variables.

 procedure DropMenuDown(Control: TControl; PopupMenu: TPopupMenu); var APoint: TPoint; Msg: TMsg; Wnd: HWND; ARect: TRect; begin APoint := Control.ClientToScreen(Point(0, Control.ClientHeight)); PopupMenu.PopupComponent := Control; PopupMenu.Popup(APoint.X, APoint.Y); if (Control is TWinControl) then Wnd := TWinControl(Control).Handle else Wnd := Control.Parent.Handle; if PeekMessage(Msg, Wnd, WM_LBUTTONDOWN, WM_LBUTTONDBLCLK, PM_NOREMOVE) then begin ARect.TopLeft := Control.ClientOrigin; ARect.Right := ARect.Left + Control.Width; ARect.Bottom := ARect.Top + Control.Height; if PtInRect(ARect, Msg.pt) then PeekMessage(Msg, Wnd, WM_LBUTTONDOWN, WM_LBUTTONDBLCLK, PM_REMOVE); end; end; 

In addition, it does not depend on the processing time.

Answer 2

Requirements

If you understand correctly, then the requirements are:

• With the first left mouse button, click on the control; PopupMenu should be shown under the control.
• On the second left mouse button, click the same control shown PopupMenu should be closed.

Understand that regardless of the requirement 1 at the moment, requirement 2 occurs automatically: when you go beyond PopupMenu, PopupMenu will close. This ends with the fact that the implementation of the first should not interfere with the second.

Possible solutions:

• Count the clicks on the control: when you press it the first time, display PopupMenu and when you click it the second time, do nothing. But this will not work, because PopupMenu can be closed already by clicking elsewhere, and then the second click should be the first click.
• At the first click, click PopupMenu. In the second click, determine if PopupMenu is displayed. If so, then do nothing. Otherwise, make the first click. This also will not work, because when the second click is processed, PopupMenu will already be closed.
• At the first click, click PopupMenu. In the second click, determine if PopupMenu has ever closed in the last few milliseconds. If so, then the disappearance is due to this very second click and does nothing. This is the solution you are currently using, using the fact that TPopupMenu.Popup will not return until PopupMenu is closed.

Current implementation

• During the OnClick event of the control:
  • The OnMouseDown event of the control is assigned to a custom handler,
  • PopupMenu is displayed.
• In the second click on the control:
  • PopupMenu's closing time is saved (this is still being executed during the previous OnClick event)
  • The custom OnMouseDown event handler is called,
  • If the saved time was within the last 100 milliseconds, mouse capture is freed and all execution is interrupted.

Note. Perhaps the already set OnMouseDown parameter is not saved and is gone!

Why does this work for a button

A TCustomButton handles click events in response to a Windows CN_COMMAND . This is a specific Windows BUTTON sytem class management specification. By canceling the mouse capture mode, this message is not sent. Thus, the Control OnClick event OnClick not OnClick in the second click.

Why it does not work for the panel

A TPanel handles click events by adding the csClickEvents style to the ControlStyle property. This is a specific feature of VCL. Canceling execution, the subsequent code stops due to the WM_LBUTTONDOWN message. However, the OnClick event of the TPanel fired somewhere down its WM_LBUTTONUP message handler, so the OnClick event is still OnClick .

Solution for

Use davea's answer to your other question , in which it simply does nothing if the saved PopupMenu closing time has been within the last 100 milliseconds.