Delphi; Add PopupMenu support to a control without source

user_1566140 0
Viewed 398

I have a VCL control for which I do not have the source that does not have a PopupMenu property and associated event(s). How can I add this?

The control (per the documentation) inherits from TCustomControl, which inherits from TWinControl.

Looking through the Delphi VCL source it seems to involve handling the WM_CONTEXTMENU message.

I can create the control at runtime, so it doesn't have to support design-time functionality if that makes it simpler.

Delphi 10.3

subclassing contextmenu menu delphi
2 Answers

As the documentation for WM_CONTEXTMENU states, when a child window does not process the message, the default window procedure sends the message to the parent window.

So you can display the popup menu by handling the message on the parent of the control. Below example displays a "PopupMenu1" for a "Panel1" placed on a form, you may need to adjust if your control is not directly placed on the form.

type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    Panel1: TPanel;
    ..
  protected
    procedure WMContextMenu(var Message: TWMContextMenu);
      message WM_CONTEXTMENU;
  end;

...

procedure TForm1.WMContextMenu(var Message: TWMContextMenu);
var
  Pt: TPoint;
  Control: TControl;
begin
  Pt := SmallPointToPoint(Message.Pos);
  Control := ControlAtPos(ScreenToClient(Pt), False, True, True);
  if Control = Panel1 then begin
    PopupMenu1.PopupComponent := Panel1;
    PopupMenu1.Popup(Pt.X, Pt.Y);
    Message.Result := 1;
  end;
  inherited;
end;
user_2436140

You can either:

  • assign a handler to the control's public WindowProc property to handle messages directly, like WM_CONTEXTPOPUP.

    var
  OldWndProc: TWndMethod;

...

procedure TMyForm.CreateControl;
var
  Ctrl: TTheControl;
begin
  Ctrl := TTheControl.Create(Self);
  OldWndProc := Ctrl.WindowProc;
  Ctrl.WindowProc := MyCtrlWndProc;
  ...
end;

procedure TMyForm.MyCtrlWndProc(var Message: TMessage);
begin
  if Message.Msg = WM_CONTEXTMENU then
  begin
    ...
  end;
  OldWndProc(Message);
end;

  • derive from the control and override its virtual WndProc() method.

    type
  TMyControl = class(TTheControl)
  protected
    procedure WndProc(var Message: TMessage); override;
  end;

procedure TMyControl.WndProc(var Message: TMessage);
begin
  if Message.Msg = WM_CONTEXTMENU then
  begin
    ...
  end;
  inherited;
end;

...

procedure TMyForm.CreateControl;
var
  Ctrl: TMyControl;
begin
  Ctrl := TMyControl.Create(Self);
  ...
end;

  • derive from the control and promote its protected PopupMenu property or OnContextPopup event to public.

    type
  TMyControl = class(TTheControl)
  public
    property PopupMenu;
  end;

procedure TMyForm.CreateControl;
var
  Ctrl: TMyControl;
begin
  Ctrl := TMyControl.Create(Self);
  Ctrl.PopupMenu := PopupMenu1;
  ...
end;


    type
  TMyControl = class(TTheControl)
  public
    property OnContextPopup;
  end;

procedure TMyForm.CreateControl;
var
  Ctrl: TMyControl;
begin
  Ctrl := TMyControl.Create(Self);
  Ctrl.OnContextPopup := DoContextPopup;
  ...
end;

procedure TMyForm.DoContextPopup(Sender: TObject);
begin
  PopupMenu1.Popup(...);
end;
user_658630
Related