delphi - TPageControlのタブにコンテキストメニューを追加する

Question

タブ領域とは異なり、TPageControlの（ちょうど）タブにコンテキストメニューを追加したいと思います（たとえば、Delphiがファイル/ページオプションを提供するように）。私はTRzPageControlでこれを行うことができることを知っていますが、TPageControlでどのようにそれが可能でしょうか？

Answer 1

コンポーネントを作成したくない場合は、常に PageControl の OnContextPopup を使用し、マウスの位置に応じてその PopupMenu を切り替えることができます。

2 つの PopuMenus pmTabs と pmPages を作成したと仮定すると、次のコードは、タブ領域をクリックすると 1 番目を表示し、それ以外の場合は 2 番目を表示します。

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.

それはまだうまくいくかもしれません。