Tab based Form error segmentation.

[BSaidus]

Hello.
I'm trying to test a application based on Tabsheet (Tab Forms)                                                                                                               
So : I have the problem of segmentation error when I want to close the form on the tab.
After Clicking on the button on embeded form
here is the code for form 1 : the main form

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
9.   StdCtrls, ComCtrls, Menus;
10.  
11. type
12.  
13.   { TForm1 }
14.  
15.   TForm1 = class(TForm)
16.     Bevel1: TBevel;
17.     Button1: TButton;
18.     Button2: TButton;
19.     MenuItem1: TMenuItem;
20.     PageControl1: TPageControl;
21.     Panel1: TPanel;
22.     PopupMenu1: TPopupMenu;
23.     procedure Button1Click(Sender: TObject);
24.     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
25.     procedure MenuItem1Click(Sender: TObject);
26.   private
27.  
28.   public
29.  
30.   end;
31.  
32. var
33.   Form1: TForm1;
34.   tb: TTabSheet;
35.  
36. implementation
37.  
38. uses
39.   unit2;
40.  
41. {$R *.lfm}
42.  
43. { TForm1 }
44.  
45. procedure TForm1.Button1Click(Sender: TObject);
46. begin
47.  
48.   if tb <> nil then begin
49.     Exit;
50.   end;
51.  
52.   tb := TTabSheet.Create( nil );
53.   with tb do begin
54.     PageControl := PageControl;
55.     Parent      := PageControl1;
56.     TabVisible:= true;
57.   end;
58.   with TForm2.Create( tb ) do begin
59.     Parent := tb ;
60.     Visible:=true;
61.   end;
62.   PageControl1.ActivePage := tb;
63.  
64. end;
65.  
66. procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
67. var
68.   tb1:TTabSheet;
69.   I: Integer;
70. begin
71.  
72.   tb1 := nil ;
73.   for I:=0 to PageControl1.PageCount-1 do begin
74.     Application.ProcessMessages;
75.     tb1 := PageControl1.ActivePage;
76.     if tb1<>nil then FreeAndNil(tb1);
77.   end;
78.  
79. end;
80.  
81. procedure TForm1.MenuItem1Click(Sender: TObject);
82. var
83.   tb1:TTabSheet;
84. begin
85.   tb1 := nil ;
86.   tb1 := PageControl1.ActivePage;
87.   if tb1<>nil then
88.     FreeAndNil(tb1);
89. end;
90.  
91. end.
92.  
93.  

and the code of the second one wich is to display on tabsheet.

Code: Pascal  [Select][+][-]

1. unit Unit2;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, db, FileUtil, ZConnection, ZDataset, vte_dbgrid, Forms,
9.   Controls, Graphics, Dialogs, Grids, Menus, DBGrids, StdCtrls,
10.   ComCtrls;
11.  
12. type
13.  
14.   { TForm2 }
15.  
16.   TForm2 = class(TForm)
17.     Button1 : TButton;
18.     DataSource1 : TDataSource;
19.     VirtualDBGrid1 : TVirtualDBGrid;
20.     ZConnection1 : TZConnection;
21.     ZTable1 : TZTable;
22.     procedure Button1Click(Sender : TObject);
23.   private
24.  
25.   public
26.  
27.   end;
28.  
29. var
30.   Form2: TForm2;
31.  
32. implementation
33.  
34. uses
35.   unit1;
36.  
37. {$R *.lfm}
38.  
39. { TForm2 }
40.  
41. procedure TForm2.Button1Click(Sender : TObject);
42. begin
43.  
44.   if tb <> nil then begin
45.     Hide;
46.     Close;
47.     FreeAndNil( tb );
48.   end;
49. end;
50.  
51. end.
52.  
53.  
54.  
55.  

[howardpc]

Get rid of Form2 altogether.
Instead, add a datamodule containing a datasource, a TZConnection, and a TZTable, and set their properties and hook them up correctly.
Add the datamodule unit to the uses of your main Form1 unit.

Then add code something like the following to your TForm1 class:

Code: Pascal  [Select][+][-]

1. unit mainDynamicTabsheet;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   SysUtils, Forms, Controls, ComCtrls, Menus, DBGrids, uDataModule;
9.  
10. type
11.  
12.   { TForm1 }
13.  
14.   TForm1 = class(TForm)
15.     AddTabsheetMenuItem: TMenuItem;
16.     PageControl1: TPageControl;
17.     PopupMenu1: TPopupMenu;
18.     procedure AddTabsheetMenuItemClick(Sender: TObject);
19.   private
20.     TableTabsheet: TTabSheet;
21.     TabSheetGrid: TDBGrid; // you would want a TDBVirtualGrid here with the appropriate Zeos unit in the uses clause
22.     procedure ShowTableTabsheet(const aCaption: string);
23.   public
24.   end;
25.  
26. var
27.   Form1: TForm1;
28.  
29. implementation
30.  
31. {$R *.lfm}
32.  
33. { TForm1 }
34.  
35. procedure TForm1.AddTabsheetMenuItemClick(Sender: TObject);
36. begin
37.   ShowTableTabsheet('Your caption goes here');
38.   if Assigned(DataModule1.DataSource1.DataSet) then
39.     DataModule1.DataSource1.DataSet.Active:=True;
40. end;
41.  
42. procedure TForm1.ShowTableTabsheet(const aCaption: string);
43. begin
44.   if (TableTabsheet = nil) then begin
45.     TableTabsheet:=PageControl1.AddTabSheet;
46.     with TableTabsheet do begin
47.       Caption:=aCaption;
48.       TabSheetGrid:=TDBGrid.Create(TableTabsheet); // TDBVirtualGrid.Create in your case
49.       TabSheetGrid.Align:=alClient;
50.       TabSheetGrid.DataSource:=DataModule1.DataSource1;
51.       TabSheetGrid.Parent:=TableTabsheet;
52.     end;
53.   end;
54. end;
55.  
56. end.  

[BSaidus]

Hi !
After some modification for the code IT WORKS on DELPHI 7 therefor I suspect a BUG in LCL 

here is the new code:

For main unit.

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
9.   StdCtrls, ComCtrls,
10.  
11.   unit2;
12.  
13. type
14.  
15.   { TForm1 }
16.  
17.   TForm1 = class(TForm)
18.     Bevel1 : TBevel;
19.     Button1 : TButton;
20.     Button2 : TButton;
21.     CheckBox1 : TCheckBox;
22.     PageControl1 : TPageControl;
23.     Panel1 : TPanel;
24.     Panel2 : TPanel;
25.     procedure Button1Click(Sender : TObject);
26.     procedure Button2Click(Sender : TObject);
27.     procedure FormCreate(Sender : TObject);
28.   private
29.     { private declarations }
30.   public
31.     fr: TForm2;
32.     tb: TTabSheet ;
33.     procedure do_click(Sender: TObject );
34.     { public declarations }
35.   end;
36.  
37. var
38.   Form1 : TForm1;
39.  
40. implementation
41.  
42. {$R *.lfm}
43.  
44. { TForm1 }
45.  
46. procedure TForm1.FormCreate(Sender : TObject);
47. begin
48.   tb := Nil ;
49.   fr := nil;
50. end;
51.  
52. procedure TForm1.do_click(Sender : TObject);
53. begin
54.  
55.   if fr=nil then Exit;
56.   fr.Close;
57.   FreeAndNil(fr);
58.   if tb <> nil then
59.     FreeAndNil(tb);
60.  
61. end;
62.  
63. procedure TForm1.Button1Click(Sender : TObject);
64. begin
65.  
66.   if tb<>nil then Exit;
67.  
68.   tb := TTabSheet.Create( nil );
69.   with tb do begin
70.     PageControl := PageControl1;
71.     Parent := PageControl1;
72.     TabVisible := true;
73.   end;
74.  
75.   fr := TForm2.Create(tb);
76.   with fr do begin
77.     Parent := tb;
78.     Visible := true;
79.     BitBtn1.OnClick := @do_click;
80.   end;
81.  
82.  
83. end;
84.  
85. procedure TForm1.Button2Click(Sender : TObject);
86. begin
87.   do_click(nil);
88. end;
89.  
90. end.
91.  
92.  

code for unit2

Code: Pascal  [Select][+][-]

1. unit Unit2;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, DBGrids,
9.   ExtCtrls, Buttons, StdCtrls, ComCtrls;
10.  
11. type
12.  
13.   { TForm2 }
14.  
15.   TForm2 = class(TForm)
16.     Bevel1 : TBevel;
17.     BitBtn1 : TBitBtn;
18.     DBGrid1 : TDBGrid;
19.     Edit1 : TEdit;
20.     Panel1 : TPanel;
21.   private
22.     { private declarations }
23.   public
24.     { public declarations }
25.   end;
26.  
27. var
28.   Form2 : TForm2;
29.  
30. implementation
31.  
32. {$R *.lfm}
33.  
34. end.
35.  
36.  

[balazsszekely]

The main issue is that you free form2 from inside it's own event. It might work in delphi but is still wrong. There is more then one workaround for this problem, I choose the lazy man solution(see attachment). Please note this is not the ideal one, you should create an event in form2 then free the tabsheet when the event is triggered.

[BSaidus]

Thanks @GetMem
I'll try to do that !

OOOOOOOffff !!
Don't know what to do really ! 

[balazsszekely]

OOOOOOOffff !!
Don't know what to do really ! 

Sorry for the late response, I was busy with something else. Please try the attached demo.

[BSaidus]

thank very much @GetMem

[balazsszekely]

@BSaidus
You're welcome. There is small memory leak in my example. If tb/fr is assigned, you must free them when you close form1.

[BSaidus]

@BSaidus
You're welcome. There is small memory leak in my example. If tb/fr is assigned, you must free them when you close form1.

Oh yes !! I've allready did that !!