Показать сообщение отдельно
  #5  
Старый 27.05.2018, 20:25
lmikle lmikle вне форума
Модератор
 
Регистрация: 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.
Ответить с цитированием