如果你想让第二页不可进入,下面的程序可以做到。
procedure TForm1.PageControl1Changing(Sender: TObject;
var AllowChange: Boolean);
begin
i:=pagecontrol1.ActivePageIndex;
end;
procedure TForm1.PageControl1Change(Sender: TObject);
begin
if pagecontrol1.ActivePageIndex=1 then
pagecontrol1.ActivePageIndex:=i;
end;
但上面的程序会产生刷新闪动,如何去掉闪动和把不可用的页的Caption字体变灰?
这样可否
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TMainForm = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
Memo1: TMemo;
Edit1: TEdit;
Button1: TButton;
TabSheet3: TTabSheet;
procedure PageControl1Changing(Sender: TObject;
var AllowChange: Boolean);
procedure PageControl1DrawTab(Control: TCustomTabControl;
TabIndex: Integer; const Rect: TRect; Active: Boolean);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
MainForm: TMainForm;
i: Integer;
implementation
{$R *.dfm}
procedure TMainForm.PageControl1Changing(Sender: TObject;
var AllowChange: Boolean);
var
pt: TPoint;
begin
GetCursorPos(pt);
pt := PageControl1.ScreenToClient(pt);
if PageControl1.IndexOfTabAt(pt.X, pt.Y ) = 1 then
AllowChange := False;
end;
procedure TMainForm.PageControl1DrawTab(Control: TCustomTabControl;
TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
rt: TRect;
begin
with PageControl1.Canvas do
begin
rt := Rect;
Brush.Color := clBtnFace;
FillRect(rt);
if TabIndex = 1 then
Font.Color := clGrayText;
DrawText(Handle, PChar(PageControl1.Pages[TabIndex].Caption),
-1, rt, DT_CENTER or DT_VCENTER);
end;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
PageControl1.OwnerDraw := True;
end;
end.