DELPHI使用TabControl将窗口标签化

DELPHI使用TabControl将窗口标签化
DELPHI使用TabControl将窗口标签化
代码如下:
//************************************************************* *************
//主窗体代码:
//************************************************************* *************
unit UMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graph ics, Controls, Forms,
Dialogs, Menus, ComCtrls, ToolWin, ExtCtrls;
type
TfrmMain = class(TForm)
mnMain: TMainMenu;
mniBase: TMenuItem;
mniModules: TMenuItem;
nmiSysConfig: TMenuItem;
Panel1: TPanel;
cbTop: TCoolBar;
tbMenu: TToolBar;
gfgfhgf1: TMenuItem;
gfhghgf1: TMenuItem;
tabChildren: TTabControl;
mnTab: TPopupMenu;
mniTabClose: TMenuItem;
C1: TMenuItem;
mniRolls: TMenuItem;
mniCard: TMenuItem;
procedure mniModulesClick(Sender: TObject);
procedure tabChildrenChange(Sender: TObject);
procedure mniCardClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure AdjustTabControl(Sender:TForm; Delete:Boole an);
end;
var
frmMain: TfrmMain;
implementation
uses uModules, uDm, uCard;
{$R *.dfm}
//增加/删除/激活与子窗体相关的Tab页
procedure TfrmMain.AdjustTabControl(Sender:TForm; Del ete:Boolean);
var
I:Integer;
Found:Boolean;
begin
//查找
Found := False;
for I := 0 to tabChildren.Tabs.Count - 1 do
begin
if Sender.Caption = tabChildren.Tabs[I] then
begin
Found := True; //找到
if Delete then //删除
tabChildren.Tabs.Delete(I)
else //激活
if tabChildren.TabIndex <> I then
tabChildren.TabIndex := I;
break;
end;
end;
if not Found then //增加并激活
begin
tabChildren.Tabs.Add(Sender.Caption);
tabChildren.TabIndex := tabChildren.Tabs.Count - 1; end;
end;
//选择Tab页时激活相应子窗体
procedure TfrmMain.tabChildrenChange(Sender: TObject); var
TabCap:String;
I: Integer;
Child: TForm;
begin
TabCap:=tabChildren.Tabs[tabChildren.TabIndex];
for I := MDIChildCount - 1 downto 0 do
begin
Child := MDIChildren[I];
if Child.Caption = TabCap then
Child.Show;
end;
end;
//模块配置
procedure TfrmMain.mniModulesClick(Sender: TObject);
begin
if nil = FindComponent( 'frmModules ') then
frmModules := TfrmModules.Create(Self);
frmModules.Show;
end;
//卡片维护
procedure TfrmMain.mniCardClick(Sender: TObject);
begin
if nil = FindComponent( 'frmCard ') then
frmCard := TfrmCard.Create(Self);
frmCard.Show;
end;
end.
//************************************************************* *************
//子窗体代码:
//************************************************************* *************
unit uCard;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graph ics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
type
TfrmCard = class(TForm)
pnlTop: TPanel;
btnClose: TButton;
procedure FormClose(Sender: TObject; var Action: TCl oseAction);
procedure btnCloseClick(Sender: TObject);
procedure pnlTopResize(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmCard: TfrmCard;
implementation
uses uDm, uMain;
{$R *.dfm}
//关闭窗体,释放
procedure TfrmCard.FormClose(Sender: TObject; var Ac tion: TCloseAction);
begin
Action:= caFree;
end;
//关闭按钮
procedure TfrmCard.btnCloseClick(Sender: TObject);
begin
frmMain.AdjustTabControl(Self as TForm, True); //删除Tab页
Close;
end;
//窗体调整
procedure TfrmCard.pnlTopResize(Sender: TObject);
begin
btnClose.Left := pnlTop.Width - 10 - btnClose.Width;
end;
//激活窗体时最大化
procedure TfrmCard.FormActivate(Sender: TObject);
begin
WindowState := wsMaximized; //
frmMain.AdjustTabControl(Self as TForm, False); //增加或激活Tab页
end;
end.。