27.05.2018, 20:25
|
Модератор
|
|
Регистрация: 17.04.2008
Сообщения: 8,015
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
|
|
Вот примерчик наваял с TTabSet,
Главная форма:
Код:
unit MainFrm;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, ChildBaseFrm, Vcl.ComCtrls,
Vcl.Tabs;
type
TMainForm = class(TForm)
MainMenu: TMainMenu;
miFile: TMenuItem;
miFileExit: TMenuItem;
miWindow: TMenuItem;
niWindowCreateA: TMenuItem;
miWindowCreateB: TMenuItem;
TabSet: TTabSet;
procedure miFileExitClick(Sender: TObject);
procedure niWindowCreateAClick(Sender: TObject);
procedure miWindowCreateBClick(Sender: TObject);
procedure TabSetChange(Sender: TObject; NewTab: Integer;
var AllowChange: Boolean);
private
{ Private declarations }
procedure CreateChildForm(FrmClass : TChildClass);
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
uses ChildAFrm, ChildBFrm;
procedure TMainForm.CreateChildForm(FrmClass : TChildClass);
var
Frm : TChildBaseForm;
Idx : Integer;
begin
Frm := FrmClass.Create(Application);
Idx := TabSet.Tabs.Add(Frm.Caption);
TabSet.Tabs.Objects[Idx] := Frm;
TabSet.TabIndex := Idx;
Frm.SetTab(TabSet);
end;
procedure TMainForm.miFileExitClick(Sender: TObject);
begin
Close;
end;
procedure TMainForm.miWindowCreateBClick(Sender: TObject);
begin
CreateChildForm(TChildBForm);
end;
procedure TMainForm.niWindowCreateAClick(Sender: TObject);
begin
CreateChildForm(TChildAForm);
end;
procedure TMainForm.TabSetChange(Sender: TObject; NewTab: Integer;
var AllowChange: Boolean);
begin
AllowChange := True;
If NewTab <> TabSet.TabIndex Then
(TabSet.Tabs.Objects[NewTab] As TChildBaseForm).BringToFront;
end;
end.
Базовая форма для MDIChild (там все MDIChild формы надо теперь наследовать от нее, в примере созданы 2 такие формы, на таких формах никакаой логики уже не надо, все в этой сделано)
Код:
unit ChildBaseFrm;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Tabs;
type
TChildBaseForm = class(TForm)
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
{ Private declarations }
FTab : TTabSet;
public
{ Public declarations }
procedure SetTab(ATab : TTabSet);
end;
TChildClass = class of TChildBaseForm;
var
ChildBaseForm: TChildBaseForm;
implementation
{$R *.dfm}
procedure TChildBaseForm.FormActivate(Sender: TObject);
var
I : Integer;
begin
If Assigned(FTab) Then
For I := 0 To FTab.Tabs.Count-1 Do
If FTab.Tabs.Objects[i] = Self Then
Begin
FTab.TabIndex := I;
Break;
End;
end;
procedure TChildBaseForm.FormClose(Sender: TObject; var Action: TCloseAction);
var
I : Integer;
begin
Action := caFree;
If Assigned(FTab) Then
Begin
For I := 0 To FTab.Tabs.Count-1 Do
If FTab.Tabs.Objects[i] = Self Then
Begin
FTab.Tabs.Delete(I);
If FTab.TabIndex > -1 Then
(FTab.Tabs.Objects[FTab.TabIndex] As TChildBaseForm).BringToFront;
Break;
End;
End;
end;
procedure TChildBaseForm.FormCreate(Sender: TObject);
begin
FTab := Nil;
end;
procedure TChildBaseForm.SetTab(ATab : TTabSet);
begin
FTab := ATab;
end;
end.
Пример дочерней MDIChild формы (фактически, у формы только Caption поменян, ну и Name):
Код:
unit ChildAFrm;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, ChildBaseFrm;
type
TChildAForm = class(TChildBaseForm)
private
{ Private declarations }
public
{ Public declarations }
end;
var
ChildAForm: TChildAForm;
implementation
{$R *.dfm}
end.
|