Разработка визуального компонента TButtonMenu

unit UnitButtonMenu;
 
interface
 
uses
  SysUtils, Classes, Controls, StdCtrls, Menus, Forms, Windows;
 
type
  TButtonMenu = class(TButton)
  procedure OnClick(Sender: TObject);
 
  private
    FPopupMenu: TPopupMenu;
  published
    property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
 
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Samples', [TButtonMenu]);
end;
 
procedure TButtonMenu.OnClick(Sender: TObject);
 var
   popupPoint : TPoint;
 begin
   if Assigned(FPopupMenu) then
   begin
     popupPoint.X := Left + Width div 2 ;
     popupPoint.Y := Top + Height div 2 ;
     popupPoint := ClientToScreen(popupPoint) ;
     FPopupMenu.Popup(popupPoint.X, popupPoint.Y) ;
   end;
  end;
 
end.

unit UnitButtonMenu;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls;
 
type
  TButtonMenu = class(TFrame)
    MenuButton: TButton;
    procedure MenuButtonClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
implementation
 
{$R *.dfm}
 
procedure TButtonMenu.MenuButtonClick(Sender: TObject);
 var
   popupPoint : TPoint;
 begin
   if Assigned(PopupMenu) then
   begin
     popupPoint.X := MenuButton.Left + MenuButton.Width div 2 ;
     popupPoint.Y := MenuButton.Top + MenuButton.Height div 2 ;
     popupPoint := ClientToScreen(popupPoint) ;
     PopupMenu.Popup(popupPoint.X, popupPoint.Y) ;
   end;
  end;
 
end.