Adding a context menu to the tab of a TPageControl

I wish to add a context menu to the (just the) tab of a TPageControl as distinct from the tab area (e.g like Delphi does to offer file/page开发者_如何学Python options). I know I can do this with TRzPageControl but how might it be possible with TPageControl please?

If you don't want to create a component, you can always use the OnContextPopup of your PageControl and depending on the Mouse position switch its PopupMenu.

Assume you have created 2 PopuMenus pmTabs ans pmPages, the following code will display the 1st when hitting the tabs area and the 2nd otherwise:

procedure TForm2.PageControl1ContextPopup(Sender: TObject; MousePos: TPoint;
  var Handled: Boolean);
begin
  with Sender as TPageControl do begin
    if [htOnItem] * GetHitTestInfoAt(MousePos.X, MousePos.Y) <> [] then
      PopupMenu := pmTabs
    else
      PopupMenu := pmPages;
  end;
end;

Many years ago, when I was still a kid (16 years old or something), I wrote this:

unit TabControlEx;

interface

uses
  Windows, Menus, SysUtils, Classes, Controls, ComCtrls;

type
  TTabControlEx = class(TCustomTabControl)
  private
    { Private declarations }
  protected
    { Protected declarations }
    FPopupMenu: TPopupMenu;
    FPopupActivatesTab: boolean;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  public
    { Public declarations }
  published
    { Published declarations }
    property Align;
    property Anchors;
    property BiDiMode;
    property Constraints;
    property Cursor;
    property DockSite;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property Height;
    property Hint;
    property HotTrack;
    property Images;
    property Left;
    property MultiLine;
    property MultiSelect;
    property OwnerDraw;
    property ParentBiDiMode;
    property ParentFont;
    property ParentShowHint;
    property PopupActivatesTab: boolean read FPopupActivatesTab write FPopupActivatesTab;
    property PopupMenu;
    property RaggedRight;
    property ScrollOpposite;
    property ShowHint;
    property Style;
    property TabHeight;
    property TabIndex;
    property TabOrder;
    property TabPopupMenu: TPopupMenu read FPopupMenu write FPopupmenu;
    property TabPosition;
    property Tabs;
    property TabStop;
    property TabWidth;
    property Top;
    property Visible;
    property Width;
    property OnChange;
    property OnChanging;
    property OnContextPopup;
    property OnDockDrop;
    property OnDockOver;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEndDock;
    property OnDrawTab;
    property OnEnter;
    property OnExit;
    property OnGetImageIndex;
    property OnGetSiteInfo;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDrag;
    property OnStartDock;
    property OnUnDock;
  end;

procedure Register;

implementation

{$R *.dcr}

procedure TTabControlEx.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  CursorPos: TPoint;
begin

  inherited MouseDown(Button, Shift, X, Y);

  if (Button = mbRight) and (IndexOfTabAt(X, Y) <> -1) then
    if Assigned(TabPopupMenu) then
    begin

      if FPopupActivatesTab and (TabIndex <> IndexOfTabAt(X, Y)) then
      begin
        TabIndex := IndexOfTabAt(X, Y);
        if Assigned(OnChange) then OnChange(self);
      end;

      GetCursorPos(CursorPos);

      with CursorPos do
        FPopupMenu.Popup(X, Y);

    end;

end;

procedure Register;
begin
  RegisterComponents('Rejbrand', [TTabControlEx]);
end;

end.

It might still work.