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

【问题标题】：Adding a context menu to the tab of a TPageControl将上下文菜单添加到 TPageControl 的选项卡
【发布时间】：2011-10-04 16:28:53
【问题描述】：

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

【问题讨论】：

标签： delphi click contextmenu tpagecontrol

【解决方案1】：

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

假设您创建了 2 个 PopuMenus pmTabs 和 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;

【讨论】：

htOnItem in GetHitTestInfoAt(MousePos.X, MousePos.Y) 对我来说似乎更具可读性（希望是相同的 :-)）。
@Ulrich Gerhardt，对于这个简单的案例，我同意你的看法，但我从使用超过 1 个命中区域的更通用的方法开始：[htOnItem, htOnLabel] * GetHitTestInfoAt(MousePos.X, MousePos.Y) <> []

【解决方案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.

它可能仍然有效。

【讨论】：

您可以通过将IndexOfTabAt(X, Y) 保存在局部变量中来每天节省一些纳焦耳电能...
当然，您可以对页面控件（而不是选项卡控件）执行完全相同的操作。