Delphi;将 PopupMenu 支持添加到没有源的控件

Question

我有一个 VCL 控件，但我没有没有 PopupMenu 属性和关联事件的源代码。我该如何添加？

控件（根据文档）继承自 TCustomControl，后者继承自 TWinControl。

查看 Delphi VCL 源代码似乎涉及处理 WM_CONTEXTMENU 消息。

我可以在运行时创建控件，因此它不必支持设计时功能，如果这样更简单的话。

Delphi 10.3

Answer 1

您可以：

给控件的publicWindowProc属性分配一个处理程序来直接处理消息，比如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;

从控件派生并覆盖其虚拟 WndProc() 方法。

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;

从控件派生并将其受保护的 PopupMenu 属性或 OnContextPopup 事件提升到 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;

Answer 2

正如 documentation for WM_CONTEXTMENU 所述，当子 window 不处理消息时，默认 window 过程将消息发送给父 window。

因此您可以通过处理控件父级上的消息来显示弹出菜单。下面的示例显示 "PopupMenu1" 用于放置在窗体上的 "Panel1"，如果您的控件没有直接放置在窗体上，您可能需要进行调整。

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;

Delphi;将 PopupMenu 支持添加到没有源的控件

Delphi; Add PopupMenu support to a control without source

delphi

contextmenu

menu

subclassing