Main form status barında mdichild isimlerini görüntüleme

Main form status barında mdichild isimlerini görüntüleme - Baskı Önizleme

+- Delphi Can (https://www.delphican.com)
+-- Forum: Delphi (https://www.delphican.com/forumdisplay.php?fid=3)
+--- Forum: Genel Programlama (https://www.delphican.com/forumdisplay.php?fid=6)
+--- Konu Başlığı: Main form status barında mdichild isimlerini görüntüleme (/showthread.php?tid=7968)

Main form status barında mdichild isimlerini görüntüleme - nevzatc - 14-12-2024

Herkese merhaba arkadaşilar,

Projenin main formuna alta bir statusbar veya başka bir şey koyup o alan da açılan her mdichild pencerenin ismi veya bir imajını göstermek istiyorum, Örneğin windows daki açılan her uygulamann altta başlat çubuğunda göründüğü gibi, oraya tıkladığım da ilgili pencerenin aktif edilmesini istiyorum yardımcı olabilecek var mı acaba

Saygılar.

Main form status barında mdichild isimlerini görüntüleme - mrmarman - 15-12-2024

Üçü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;

Cvp: Main form status barında mdichild isimlerini görüntüleme - nevzatc - 15-12-2024

(15-12-2024, Saat: 14:50)mrmarman Adlı Kullanıcıdan Alıntı: Üçü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.




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;

Elinize emeğinize sağlık Üstadım, tam aradığım şey üstelik bileşensiz olması ayrı bir güzellik, müteşekkirim.