Delphi; Добавить поддержку PopupMenu в элемент управления без источника - PullRequest
Новая
       34

Delphi; Добавить поддержку PopupMenu в элемент управления без источника

0 голосов
/ 17 января 2019

У меня есть элемент управления VCL, для которого у меня нет источника, у которого нет свойства PopupMenu и связанных событий. Как я могу добавить это?

Элемент управления (согласно документации) наследуется от TCustomControl, который наследуется от TWinControl.

Просматривая исходный код Delphi VCL, вы обнаружите, что обрабатывает сообщение WM_CONTEXTMENU.

Я могу создать элемент управления во время выполнения, поэтому он не должен поддерживать функциональность времени разработки, если это упрощает его.

Delphi 10,3

Ответы [ 2 ]

0 голосов
/ 17 января 2019

Как указано в документации для WM_CONTEXTMENU, когда дочернее окно не обрабатывает сообщение, процедура окна по умолчанию отправляет сообщение в родительское окно.

Таким образом, вы можете отобразить всплывающее меню, обработав сообщение на родительском элементе управления. В приведенном ниже примере отображается «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;
0 голосов
/ 17 января 2019

Вы можете:

  • назначить обработчик общедоступному свойству WindowProc элемента управления для непосредственной обработки сообщений, например 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для общественности. 

    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;
...