将上下文菜单添加到 TPageControl 的选项卡

Question

我希望将上下文菜单添加到 TPageControl 的（只是）选项卡，以区别于选项卡区域（例如，像 Delphi 那样提供文件/页面选项）。我知道我可以用 TRzPageControl 做到这一点，但是用 TPageControl 怎么可能呢？

Answer 1

如果您不想创建组件，则始终可以使用 PageControl 的 OnContextPopup 并根据鼠标位置切换其 PopupMenu。

假设您创建了 2 个 PopuMenus pmTab 和 pmPages，以下代码将在点击选项卡区域时显示第一个，否则显示第二个：

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;

Answer 2

许多年前，当我还是个孩子（16 岁左右）时，我写过这样的话：

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.

它可能仍然有效。