Üçüncü parti bileşenlere alerjim olduğu için kod yazarak sınıf oluşturmak suretiyle çözüm tercih ediyorum. Belki direkt bir yöntemi vardır ama ben bu şekilde en eski Delphi sürümlerine kadar destek verecek şekilde mütevazi halini tercih ediyorum.
Daha önce bir çalışmam olmuştu, kod parçası olarak paylaşayım. Bunu dileyen kendine göre yapılandırabilir.
Aşağıda proje olarak paylaştım ancak indirmeden göz atmak isteyenler için bir UNIT hazırladım.
Kullanımı daha aşağıda...
unit MDI_PageControlHelperU;
interface
uses System.SysUtils, System.Types,
Vcl.Forms, Vcl.Controls, Vcl.ComCtrls;
Type
tMDI_PageControl = class( TObject )
private
FPageControl : TPageControl;
FImageList : TImageList;
procedure DoTabSelected(Sender: TObject);
procedure SetImageList( aImageList: TImageList );
public
constructor Create( aPageControl: TPageControl );
destructor Destroy; override;
procedure NewChild( aChildForm: TForm );
procedure CloseChild( aChildForm: TObject );
procedure SelectChild( aChildForm: TObject );
property ImageList: TImageList read FImageList write SetImageList;
end;
implementation
{ tMDI_PageControl }
constructor tMDI_PageControl.Create(aPageControl: TPageControl);
begin
FPageControl := aPageControl;
FPageControl.Height := 40;
FPageControl.TabHeight := FPageControl.Height;
FPageControl.TabWidth := 80;
// Mevcut Tab varsa varsayılan olarak silinsin..
while FPageControl.PageCount > 0
do
FreeAndNil(FPageControl.Pages[FPageControl.PageCount-1]);
end;
destructor tMDI_PageControl.Destroy;
begin
inherited;
end;
procedure tMDI_PageControl.NewChild(aChildForm: TForm);
var
LTabSheet : TTabSheet;
begin
LTabSheet := TTabSheet.Create(FPageControl);
LTabSheet.Caption := aChildForm.Caption;
LTabSheet.PageControl := FPageControl;
LTabSheet.ImageIndex := -1;
LTabSheet.OnShow := DoTabSelected;
LTabSheet.VCLComObject := aChildForm;
if (FImageList <> nil)
and (FImageList.Count >= 2)
then LTabSheet.ImageIndex := 1
else LTabSheet.ImageIndex := -1;
LTabSheet.Show;
end;
procedure tMDI_PageControl.DoTabSelected(Sender: TObject);
begin
TForm(TTabSheet(sender).VCLComObject).Show;
end;
procedure tMDI_PageControl.SelectChild(aChildForm: TObject);
var
i : Integer;
begin
for i := FPageControl.PageCount-1 downto 0
do if TForm(aChildForm) = TForm(FPageControl.Pages[i].VCLComObject) then
begin
FPageControl.ActivePageIndex := i;
break;
end;
end;
procedure tMDI_PageControl.SetImageList(aImageList: TImageList);
begin
FImageList := aImageList;
FPageControl.Images := FImageList;
FPageControl.TabWidth := FPageControl.TabWidth + FImageList.Width;
end;
procedure tMDI_PageControl.CloseChild(aChildForm: TObject);
var
i : Integer;
begin
for i := FPageControl.PageCount-1 downto 0
do if TForm(aChildForm) = TForm(FPageControl.Pages[i].VCLComObject) then
begin
FreeAndNil( FPageControl.Pages[i] );
end;
end;
end.
Kullanımı :
MdiForma bir tane PageControl ekleyin ve Align özelliğini alBottom yapın ki sayfalama en aşağıda kalsın.
Unit2'de sizin MdiChild formunuz var olsun. Türetilecek child formlar buradan klonlama yapılacak.
bir butona veya menüye de miYeniPencere isimli menü elemenanındaki şekilde atama yapılıyor olacak.
uses Unit2, MDI_PageControlHelperU;
var
FPage : tMDI_PageControl;
procedure TForm1.FormCreate(Sender: TObject);
var
LMenuItem: TMenuItem;
begin
ReportMemoryLeaksOnShutdown := true;
FPage := tMDI_PageControl.Create(PageControl1);
Fpage.ImageList := ImageList1;
if miPencereler.Count = 0 then
begin
LMenuItem := TMenuItem.Create(miPencereler);
LMenuItem.Caption := '-';
miPencereler.Add(LMenuItem);
end;
self.WindowMenu := miPencereler;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Assigned(FPage)
then
FreeAndNil(FPage);
end;
procedure TForm1.miYeniPencereClick(Sender: TObject);
{$j+}
const
LPencere : Integer = 0;
{$j-}
var
LFormChild : TForm;
begin
LFormChild := TFormChild.Create(self);
With LFormChild do
begin
inc(LPencere);
Name := Format('Child_%.2d', [LPencere] );
Caption := Name;
FormStyle := fsMDIChild;
OnDestroy := FPage.CloseChild;
OnActivate := FPage.SelectChild;
end;
FPage.NewChild( LFormChild );
end;
procedure TForm1.miCikisClick(Sender: TObject);
begin
Close;
end;
