Drop down menu for any TControl

Question

Continue of this topic:

Drop down menu for TButton

I have wrote a generic code for DropDown memu with any TControl, but for some reason it dose not work as expected with 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;

This works well with TButton and with TSpeedButton and with any TGraphicControl (like TImage or TSpeedButton etc) as far as I can tell.

BUT does not work as expected with 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;

Seems like TPanel is not respecting ReleaseCapture; and not even Abort in the event TDropDownMenuHandler.MouseDown. What can I do to make this work with TPanel and other controls? What am I missing?

Rosie

@TLama class procedure has always been part of the language – Cavallaro

It might be related to the fact that TButtomControl is directly derived from TWinControl while TCustomPanel is derived from TCustomControl which is derived from TWinControl. So it is posible that TCustomControl prevents some of your code from executing properly. I suggest you check the inheritance tree for other controls that don't work to see if they are also derived from TCustomControl. – Tennies

Answer 1

It's not that TPanel is not respecting ReleaseCapture, it is that the capture is not relevant at all. This is what happens after the popup menu is launched and active, and the control is clicked once again:

• The click cancels the modal menu loop, the menu is closed and a mouse down message is posted.
• VCL sets a flag within the mouse down message handling [csClicked].
• Mouse down event handler is fired, you release the capture.
• After the mouse down message returns, posted mouse up message is processed, VCL checks for the flag and clicks the control if it is set.
• The click handler pops the menu.

Granted I didn't trace a working example so I can't tell when and how ReleaseCapture is helpful. In any case, it can't help here.

---

The solution I'd propose is a little different than the current design.

What we want is a second click to not to cause a click. See this part of the 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 in fact what closes the menu, before launching it again through the same handler. It is what causes the PopupMenu.Popup call to return. So what we can tell here is that the mouse button is clicked (either a left button or a double click), but not yet processed by the VCL. That means the message is yet in the queue.

Remove the registration mechanism (mouse down handler hacking) with this approach, it is not needed, and the class itself as a result, and the globals.

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;

Additionally this doesn't depend on processing timing.

Fluctuant

This is really an outstanding answer/solution! thank you. I have tested it with every possible senario and control, and it works like a charm. Can you only tell me if the first PeekMessage can affect other controls that are not related to the popup routine? I have tested and seems ok. – Rosie

@Rosie - The first one doesn't remove any message, it shouldn't have any affect. – Fluctuant

Answer 2

Requirements

If I understand you correctly, then the requirements are:

1. At the first left mouse button click on a Control, a PopupMenu should be shown beneath the Control.
2. At the second left mouse button click an that same Control, the shown PopupMenu should be closed.

Realize that, disregarding the implementation of requirement 1 for the moment, requirement 2 happens automatically: when you click outside a PopupMenu, the PopupMenu will close. This concludes to that the implementation of the first should not interfere with the second.

Possible solutions:

• Count the clicks on the Control: at the first click, show the PopupMenu and at the second click, do nothing. But this will not work, because the PopupMenu may be closed already by clicks elsewhere and then a second click should actually be the first click.
• At the first click, show the PopupMenu. At the second click, determine whether the PopupMenu is still shown. If so, then do nothing. Otherwise, assume a first click. This also will not work, because when a second click is processed, the PopupMenu will be already closed.
• At the first click, show the PopupMenu. At the second click, determine whether the PopupMenu is closed sometime during the last couple of milliseconds. If so, then the disappearance is due to this very second click and do nothing. This is the solution you are currently using by utilizing the fact that TPopupMenu.Popup will not return until the PopupMenu is closed.

The current implementation

1. During the OnClick event of a Control:
   • The OnMouseDown event of the control is assigned to a custom handler,
   • The PopupMenu is Shown.
2. On the second click on the Control:
   • The time when then PopupMenu was closed is saved (this is still during execution of the previous OnClick event),
   • The custom OnMouseDown event handler is called,
   • If the saved time was within the last 100 milliseconds, the mouse capture is released and all execution is aborted.

Note: a possibly already OnMouseDown event setting is not saved and gone!

Why this works for a Button

A TCustomButton handles click events by responding to a by Windows send CN_COMMAND message. That is a specific Windows BUTTON sytem class control characteristic. By canceling the mouse capture mode, this message is not send. Thus the Control's OnClick event is not fired on the second click.

Why this doesn't work for a Panel

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

Solution for both

Use davea's answer on your other question wherein he simply does nothing if the saved time of the PopupMenu's closing was within the last 100 milliseconds.

Nellnella

Your "Requirements" part was correct. thanks for the feedback. I have tested davea's answer (Delphi 7). it did not work as expected for TButton/TPanel. the popup menu is not closing the secode time when mouse down on the control. have you tested it? I will examine your comments about the "Why this doesn't work for a Panel" and get back. – Rosie

Yes, with XE2 though. – Nellnella

Hmm, just tested this in D7: no problems (it works). – Nellnella

Sorry, but that code did not worked for me. in any case +1 for the very good explanation. I must accept Sertac answer because it is really an outstanding solution. – Rosie