我希望将上下文菜单添加到 TPageControl 的(只是)选项卡,与选项卡区域不同(例如,Delphi 提供文件/页面选项)。我知道我可以用 TRzPageControl 做到这一点,但是用 TPageControl 怎么可能呢?
问问题
2614 次
2 回答
6
如果您不想创建组件,则始终可以使用 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;
于 2011-10-05T00:35:06.227 回答
3
很多年前,当我还是个孩子的时候(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.
它可能仍然有效。
于 2011-10-04T17:02:52.810 回答