Fechar Form dentro de TabSheet

procedure TForm3.TabSheet1Hide(Sender: TObject);
var I: Integer;
begin
   for I := 0 to Pred(TabSheet1.ComponentCount) do begin
     if TabSheet1.Components[I] is TForm then
        TForm(TabSheet1.Components[I]).Free;
   end;
end;

type TForm3 = class(TForm) PageControl1: TPageControl; TabSheet1: TTabSheet; TabSheet2: TTabSheet; TabSheet3: TTabSheet; BitBtn1: TBitBtn; procedure BitBtn1Click(Sender: TObject); procedure TabSheet1Hide(Sender: TObject); ..... ..... [color=darkblue:8032897a14] procedure tsHide(Sender: TObject);[/color:8032897a14] private { Private declarations } Form: TForm; public { Public declarations } end;

procedure TForm3.tsHide(Sender: TObject);
var I: Integer;
begin
   for I := 0 to Pred(TTabSheet(Sender).ComponentCount) do begin
     if TTabSheet1(Sender).Components[I] is TForm then
        TForm(TTabSheet1(Sender).Components[I]).Free;
   end;
end;

Olá Pessoal, essa técnica de TDI é muito legal, aqui na empresa nos desenvolvemos um componente q funciona muito bem, vou colocar o código ai pra vcs.

esquence MDI, é muito trabalhoso isso, e a aplicação fica horrivel !

[code:1:a2f1902ab2]

unit SFormTabSet;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, Tabs, ComCtrls, Contnrs;

type

TSFormTabSet = class;

TFormInfo = class
private
FForm: TForm;
FFormTabSet: TSFormTabSet;
FTabIndex: Integer;
FFormClose: TCloseEvent;
procedure setForm(AForm: TForm);
procedure setFormTabSet(AFormTabSet: TSFormTabSet);
protected
procedure formClose(Sender: TObject; var Action: TCloseAction);
public
constructor Create(var AForm: TForm; AFormTabSet: TSFormTabSet);
procedure createTab;
function getForm: TForm;
function getFormTabSet: TSFormTabSet;
function getTabIndex: Integer;
procedure setTabIndex(const Value: Integer);
end;

TBackgroundImage = class(TImage)
public
constructor Create(AOwner: TComponent); override;
end;

TSFormTabSet = class(TCustomPanel)
private
FTabSet: TTabSet;
FDockPanel: TPanel;
FBackgroundImage: TBackgroundImage;
FForms: TObjectList;
FBackgroundColor: TColor;
FImageList: TImageList;
FFormIndex: Integer;


procedure setBackgroundColor(const Value: TColor);
procedure setBackgroundImage(const Value: TBackgroundImage);
procedure createDockPanel;
procedure createFormList;
procedure createImage(Owner: TComponent);
procedure createTabSet;
function getFormIndex(var AForm: TForm): Integer; overload;

procedure tabSetChange(Sender: TObject; NewTab: Integer;
var AllowChange: Boolean);
protected
procedure DoAddDockClient(Client: TControl; const ARect: TRect); override;
function getTabSet: TTabSet;
function getDockPanel: TPanel;
function getBackgroundImage: TBackgroundImage;
function getForms: TObjectList;
function getBackgroundColor: TColor;
function getImageList: TImageList;
function getFormIndex: Integer; overload;
procedure setFormIndex(Index: Integer);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function addForm(AForm: TForm): Integer;
function getForm(Index: Integer): TForm;
procedure removeForm(Index: Integer); overload;
procedure removeForm(AForm: TForm); overload;
property DockManager;
published
property BackgroundImage: TBackgroundImage read FBackgroundImage write setBackgroundImage;
property Align;
property Alignment;
property Anchors;
property BiDiMode;
property BackgroundColor: TColor read FBackgroundColor
write setBackgroundColor;
property Constraints;
property Ctl3D;
property Enabled;
property ParentBiDiMode;
property ParentBackground;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnCanResize;
property OnClick;
property OnConstrainedResize;
property OnContextPopup;
property OnDockDrop;
property OnDockOver;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetSiteInfo;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnStartDock;
property OnStartDrag;
property OnUnDock;
end;

implementation

{ TSFormTabSet }

function TSFormTabSet.addForm(AForm: TForm): Integer;
var
FormInfo: TFormInfo;
formIndex: Integer;
begin
Result := -1;
if getFormIndex >= 0 then
TFormInfo(getForms[getFormIndex&93;).getForm.Hide;
formIndex := getFormIndex(AForm);
if formIndex >= 0 then
begin
getTabSet.TabIndex := TFormInfo(getForms&91;formIndex&93;).getTabIndex;
AForm.Show;
Abort;
end
else
begin
if Align <> alClient then
Align := alClient;
FormInfo := TFormInfo.Create(AForm, Self);
FormInfo.createTab;
FormInfo.getForm.Position := poDesigned;
FormInfo.getForm.Top := 0;
FormInfo.getForm.Left := 0;
FormInfo.getForm.Show;
Result := getForms.Add(FormInfo);
setFormIndex(Result);
end;
end;


constructor TSFormTabSet.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
createTabSet;
createDockPanel;
createImage(getDockPanel);
createFormList;

BevelOuter := bvNone;
Height := getTabSet.Height + 1;
setBackgroundColor(clWhite);
setFormIndex(-1);

end;

procedure TSFormTabSet.createDockPanel;
begin
FDockPanel := TPanel.Create(Self);
FDockPanel.Parent := Self;
FDockPanel.Color := clWhite;
FDockPanel.BevelOuter := bvNone;
FDockPanel.Height := 0;
FDockPanel.AutoSize := True;
FDockPanel.Align := alClient;
end;

procedure TSFormTabSet.createFormList;
begin
FForms := TObjectList.Create;
end;

procedure TSFormTabSet.createImage(Owner: TComponent);
begin
FBackgroundImage := TBackgroundImage.Create(Owner);
FBackgroundImage.Parent := TWinControl(Owner);
FBackgroundImage.Align := alClient;
end;

procedure TSFormTabSet.createTabSet;
begin
FTabSet := TTabSet.Create(Self);
FTabSet.Parent := Self;
FTabSet.Align := alTop;
FTabSet.DitherBackground := False;
FTabSet.SelectedColor := getBackgroundColor;
FTabSet.Font.Name := ´Tahoma´;
FTabSet.Height := FTabSet.TabHeight + 2;
FTabSet.OnChange := tabSetChange;
end;

destructor TSFormTabSet.Destroy;
begin
if Assigned(FForms) then
begin
FForms.Clear;
FForms.Free;
end;
inherited;
end;

procedure TSFormTabSet.DoAddDockClient(Client: TControl; const ARect: TRect);
begin
Abort;
end;

function TSFormTabSet.getBackgroundColor: TColor;
begin
Result := FBackgroundColor;
end;

function TSFormTabSet.getBackgroundImage: TBackgroundImage;
begin
Result := FBackgroundImage;
end;

function TSFormTabSet.getDockPanel: TPanel;
begin
Result := FDockPanel;
end;

function TSFormTabSet.getForm(Index: Integer): TForm;
begin
Result := TFormInfo(getForms[Index&93;).getForm;
end;

function TSFormTabSet.getFormIndex: Integer;
begin
Result := FFormIndex;
end;

function TSFormTabSet.getForms: TObjectList;
begin
Result := FForms;
end;

function TSFormTabSet.getImageList: TImageList;
begin
Result := FImageList;
end;

function TSFormTabSet.getTabSet: TTabSet;
begin
Result := FTabSet;
end;

function TSFormTabSet.getFormIndex(var AForm: TForm): Integer;
var
i: Integer;
FormInfo: TFormInfo;
begin
Result := -1;
for i := 0 to (getForms.Count - 1) do
begin
FormInfo := TFormInfo(getForms[i&93;);
if (FormInfo.getForm = AForm) then
begin
Result := i;
Break;
end;
end;
end;

procedure TSFormTabSet.removeForm(Index: Integer);
var
itemIndex, i: Integer;
begin
itemIndex := TFormInfo(getForms&91;Index&93;).getTabIndex;
getForms.Delete(Index);
getTabSet.Tabs.Delete(itemIndex);
for i := 0 to (getForms.Count - 1) do
begin
if TFormInfo(getForms&91;i&93;).getTabIndex > itemIndex then
TFormInfo(getForms&91;i&93;).setTabIndex(
TFormInfo(getForms&91;i&93;).getTabIndex - 1);
end;

if (itemIndex = 0) and (getTabSet.Tabs.Count > 0) then
getTabSet.TabIndex := itemIndex
else
getTabSet.TabIndex := Pred(itemIndex);

if (Index = 0) and (getForms.Count > 0) then
setFormIndex(Index)
else
setFormIndex(Pred(Index));

if getFormIndex >= 0 then
TFormInfo(getForms[getFormIndex&93;).getForm.Show;
end;

procedure TSFormTabSet.removeForm(AForm: TForm);
var
i: Integer;
begin
for i := 0 to (getForms.Count - 1) do
begin
if TFormInfo(getForms&91;i&93;).getForm = AForm then
begin
removeForm(i);
Break;
end;
end;
end;

procedure TSFormTabSet.setBackgroundColor(const Value: TColor);
begin
if FBackgroundColor <> Value then
begin
FBackgroundColor := Value;
getDockPanel.Color := getBackgroundColor;
getTabSet.SelectedColor := getBackgroundColor;
end;
end;

procedure TSFormTabSet.setBackgroundImage(const Value: TBackgroundImage);
begin
FBackgroundImage.Assign(Value);
end;

procedure TSFormTabSet.setFormIndex(Index: Integer);
begin
FFormIndex := Index;
end;

procedure TSFormTabSet.tabSetChange(Sender: TObject; NewTab: Integer;
var AllowChange: Boolean);
var
i: Integer;
FormInfo: TFormInfo;
begin
for i := 0 to (getForms.Count - 1) do
begin
FormInfo := TFormInfo(getForms[i&93;);
if FormInfo.getTabIndex = NewTab then
begin
TFormInfo(getForms&91;getFormIndex&93;).getForm.Hide;
FormInfo.getForm.Show;
setFormIndex(i);
end;
end;
end;

{ TFormInfo }

constructor TFormInfo.Create(var AForm: TForm; AFormTabSet: TSFormTabSet);
begin
setForm(AForm);
FFormClose := AForm.OnClose;
AForm.OnClose := formClose;
setFormTabSet(AFormTabSet);
setTabIndex(-1);
end;

procedure TFormInfo.createTab;
begin
if getTabIndex = -1 then
begin
setTabIndex(getFormTabSet.getTabSet.Tabs.Add(FForm.Caption));
getFormTabSet.getTabSet.TabIndex := getTabIndex;
end;
getForm.ManualDock(FFormTabSet.getDockPanel);
end;

procedure TFormInfo.formClose(Sender: TObject; var Action: TCloseAction);
begin
if Assigned(FFormClose) then
FFormClose(Sender, Action);
if Action <> caNone then
begin
if Sender is TForm then
begin
getFormTabSet.removeForm(TForm(Sender));
TForm(Sender).OnClose := FFormClose;
end;
end;
end;

function TFormInfo.getForm: TForm;
begin
Result := FForm;
end;

function TFormInfo.getFormTabSet: TSFormTabSet;
begin
Result := FFormTabSet;
end;

function TFormInfo.getTabIndex: Integer;
begin
Result := FTabIndex;
end;

procedure TFormInfo.setForm(AForm: TForm);
begin
FForm := AForm;
end;

procedure TFormInfo.setFormTabSet(AFormTabSet: TSFormTabSet);
begin
FFormTabSet := AFormTabSet;
end;

procedure TFormInfo.setTabIndex(const Value: Integer);
begin
FTabIndex := Value;
end;

{ TBackgroundImage }

constructor TBackgroundImage.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
SetSubComponent(True);
end;

end.

[/code:1:a2f1902ab2]

Enviei antes de escrever, gostei desta ideia, sei que o post é antigo, por isso queria saber se voces ainda usam este modelo TDI ou não deu certo, se sim, como usar este componente.

Obrigado