Добавление контекстного меню на вкладку TPageControl - PullRequest
Новая
       35

Добавление контекстного меню на вкладку TPageControl

4 голосов
/ 04 октября 2011

Я хочу добавить контекстное меню на (только) вкладку TPageControl в отличие от области вкладок (например, как Delphi предлагает опции файла / страницы). Я знаю, что могу сделать это с TRzPageControl, но как это возможно с TPageControl, пожалуйста?

Ответы [ 2 ]

4 голосов
/ 05 октября 2011

Если вы не хотите создавать компонент, вы всегда можете использовать OnContextPopup вашего PageControl и в зависимости от положения мыши переключать его 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;
3 голосов
/ 04 октября 2011

Много лет назад, когда я был еще ребенком (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.

Это может все еще работать.

...