diff --git a/components/tdi/Demo/TDIDemo.lpi b/components/tdi/Demo/TDIDemo.lpi
index 766f69113..c4fd5f979 100644
--- a/components/tdi/Demo/TDIDemo.lpi
+++ b/components/tdi/Demo/TDIDemo.lpi
@@ -86,6 +86,9 @@
+
+
+
diff --git a/components/tdi/Demo/TDIDemo.lpr b/components/tdi/Demo/TDIDemo.lpr
index 74d28c6e7..c56704619 100644
--- a/components/tdi/Demo/TDIDemo.lpr
+++ b/components/tdi/Demo/TDIDemo.lpr
@@ -7,13 +7,20 @@ uses
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
- Forms, uMainForm, uForm2
+ Forms, uMainForm, uForm2, sysutils
{ you can add units after this };
{$R *.res}
+var
+ HeapTraceFile : String ;
begin
- RequireDerivedFormResource := True;
+
+ HeapTraceFile := ExtractFilePath(ParamStr(0))+ 'heaptrclog.trc' ;
+ DeleteFile( HeapTraceFile );
+ SetHeapTraceOutput( HeapTraceFile );
+
+ RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TfMainForm, fMainForm) ;
Application.CreateForm(TForm2, Form2) ;
diff --git a/components/tdi/Demo/TDIDemo.lps b/components/tdi/Demo/TDIDemo.lps
index c14fd3295..75fa5a3c9 100644
--- a/components/tdi/Demo/TDIDemo.lps
+++ b/components/tdi/Demo/TDIDemo.lps
@@ -4,15 +4,17 @@
-
+
+
-
-
-
+
+
+
+
@@ -23,7 +25,7 @@
-
+
@@ -32,10 +34,13 @@
+
-
-
-
+
+
+
+
+
@@ -44,11 +49,11 @@
-
+
-
-
-
+
+
+
@@ -58,62 +63,56 @@
-
-
-
-
+
+
+
-
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
-
-
-
+
+
+
@@ -122,41 +121,41 @@
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
+
-
-
+
+
-
-
-
+
+
+
@@ -167,243 +166,225 @@
-
+
-
-
+
+
-
-
+
-
-
-
+
+
-
-
-
-
-
+
+
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
-
-
+
+
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
-
-
+
+
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
-
-
+
+
+
+
+
-
-
-
+
+
+
-
-
-
-
-
+
+
+
+
+
-
-
-
+
+
+
-
-
+
+
-
-
+
+
@@ -412,91 +393,93 @@
-
-
-
+
+
+
-
-
+
+
-
-
+
+
-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
+
+
-
-
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
@@ -505,282 +488,337 @@
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
-
-
+
+
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/tdi/Demo/uform1.lfm b/components/tdi/Demo/uform1.lfm
index d157724da..55003794c 100644
--- a/components/tdi/Demo/uform1.lfm
+++ b/components/tdi/Demo/uform1.lfm
@@ -20,9 +20,9 @@ object Form1: TForm1
LCLVersion = '1.1'
object bClose: TButton
Left = 392
- Height = 27
+ Height = 25
Top = 216
- Width = 70
+ Width = 86
AutoSize = True
Caption = 'Close Form'
OnClick = bCloseClick
@@ -30,7 +30,7 @@ object Form1: TForm1
end
object Edit1: TEdit
Left = 24
- Height = 25
+ Height = 23
Top = 62
Width = 82
TabOrder = 0
@@ -38,11 +38,12 @@ object Form1: TForm1
end
object Edit2: TEdit
Left = 24
- Height = 25
+ Height = 23
Top = 104
Width = 82
OnExit = Edit2Exit
TabOrder = 1
+ Text = 'e'
end
object Label1: TLabel
Left = 144
@@ -54,10 +55,10 @@ object Form1: TForm1
object Label2: TLabel
AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter
- Left = 74
- Height = 39
+ Left = 98
+ Height = 31
Top = 16
- Width = 353
+ Width = 305
Alignment = taCenter
Caption = 'This Form has Max Constraints.'#13#10'It will be centralized on Tab Sheet if it is smaller than it'
Font.Style = [fsBold]
@@ -68,9 +69,9 @@ object Form1: TForm1
AnchorSideTop.Control = bClose
AnchorSideTop.Side = asrCenter
Left = 32
- Height = 52
- Top = 203
- Width = 323
+ Height = 46
+ Top = 205
+ Width = 324
Caption = 'You can Close or Hide your Forms the same way you used to.'#13#10'No Special method is necessary. TDINotebook will detect by '#13#10'internal Notification and Close the Tab Sheet'
ParentColor = False
end
@@ -78,9 +79,9 @@ object Form1: TForm1
AnchorSideLeft.Control = bClose
AnchorSideLeft.Side = asrCenter
Left = 394
- Height = 27
+ Height = 25
Top = 159
- Width = 66
+ Width = 82
AutoSize = True
Caption = 'Hide Form'
OnClick = bHideClick
@@ -90,9 +91,9 @@ object Form1: TForm1
AnchorSideTop.Control = bHide
AnchorSideTop.Side = asrCenter
Left = 16
- Height = 18
+ Height = 16
Top = 163
- Width = 409
+ Width = 364
Caption = 'But, If you Hide the Form, is better you have a way to Show it again :)'
Font.Color = clRed
ParentColor = False
@@ -104,7 +105,7 @@ object Form1: TForm1
AnchorSideTop.Side = asrCenter
Left = 120
Height = 16
- Top = 66
+ Top = 65
Width = 106
Caption = 'This is a regular Edit'
ParentColor = False
@@ -113,9 +114,9 @@ object Form1: TForm1
AnchorSideTop.Control = Edit2
AnchorSideTop.Side = asrCenter
Left = 120
- Height = 52
- Top = 90
- Width = 344
+ Height = 46
+ Top = 92
+ Width = 347
Caption = 'This Edit has a OnExit Validation, who doesn''t allow Page Change'#13#10' if this Edit is empty, and the focus is on it... '#13#10'This can be disabled changing the property "VerifyIfCanChange"'
ParentColor = False
end
@@ -124,10 +125,10 @@ object Form1: TForm1
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Side = asrBottom
AnchorSideBottom.Control = bClose
- Left = 371
+ Left = 379
Height = 16
Top = 194
- Width = 113
+ Width = 112
Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 6
Caption = 'This Form use caFree'
@@ -137,10 +138,10 @@ object Form1: TForm1
AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Side = asrCenter
- Left = 33
+ Left = 35
Height = 16
Top = 264
- Width = 434
+ Width = 431
Caption = 'This Form demonstrate that TDINotebook respects your OnCloseQuery Validation'
ParentColor = False
end
diff --git a/components/tdi/Demo/umainform.lfm b/components/tdi/Demo/umainform.lfm
index cc5210ec9..6eebbe47c 100644
--- a/components/tdi/Demo/umainform.lfm
+++ b/components/tdi/Demo/umainform.lfm
@@ -165,6 +165,18 @@ object fMainForm: TfMainForm
TabOrder = 2
Value = 1
end
+ object Button1: TButton
+ AnchorSideTop.Control = pBottom
+ AnchorSideTop.Side = asrCenter
+ Left = 304
+ Height = 25
+ Top = 13
+ Width = 85
+ AutoSize = True
+ Caption = 'Free Form2'
+ OnClick = Button1Click
+ TabOrder = 3
+ end
end
object mEvents: TMemo
Left = 584
diff --git a/components/tdi/Demo/umainform.pas b/components/tdi/Demo/umainform.pas
index 297124c7e..3ffa5e899 100644
--- a/components/tdi/Demo/umainform.pas
+++ b/components/tdi/Demo/umainform.pas
@@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
- ComCtrls, Buttons, StdCtrls, ExtCtrls, Spin, TDIClass , types, IpHtml;
+ ComCtrls, Buttons, StdCtrls, ExtCtrls, Spin, TDIClass, IpHtml;
type
@@ -14,6 +14,7 @@ type
TfMainForm = class(TForm)
bToggleLog : TButton ;
+ Button1 : TButton ;
cbxBackgroundCorner : TComboBox ;
Image1 : TImage ;
ImageList1 : TImageList ;
@@ -36,6 +37,7 @@ type
tsFixed : TTabSheet ;
TDINoteBook1 : TTDINoteBook ;
procedure bToggleLogClick(Sender : TObject) ;
+ procedure Button1Click(Sender : TObject) ;
procedure cbxBackgroundCornerChange(Sender : TObject) ;
procedure FormClose(Sender : TObject ; var CloseAction : TCloseAction) ;
procedure FormCloseQuery(Sender : TObject ; var CanClose : boolean) ;
@@ -91,6 +93,8 @@ end;
procedure TfMainForm.MenuItem3Click(Sender : TObject) ;
begin
+ if not Assigned( Form2 ) then
+ Form2 := TForm2.Create(Self);
Form2.Show;
end;
@@ -109,6 +113,12 @@ begin
bToggleLog.Caption := '< Show Log' ;
end;
+procedure TfMainForm.Button1Click(Sender : TObject) ;
+begin
+ Form2.Free;
+ Form2 := nil;
+end;
+
procedure TfMainForm.FormClose(Sender : TObject ; var CloseAction : TCloseAction
) ;
begin
@@ -133,7 +143,9 @@ end;
procedure TfMainForm.miForm2Click(Sender : TObject) ;
begin
- TDINoteBook1.ShowFormInNewPage( Form2, 4 );
+ if not Assigned( Form2 ) then
+ Form2 := TForm2.Create(Self);
+ TDINoteBook1.ShowFormInPage( Form2, 4 );
end;
procedure TfMainForm.seFixedPagesChange(Sender : TObject) ;
diff --git a/components/tdi/tdiclass.pas b/components/tdi/tdiclass.pas
index 4d3727954..26ed6735b 100644
--- a/components/tdi/tdiclass.pas
+++ b/components/tdi/tdiclass.pas
@@ -6,7 +6,10 @@ interface
uses
Classes, SysUtils, Forms, Controls, ComCtrls, ExtCtrls, Menus,
- ExtendedNotebook, Buttons, Graphics ;
+ ExtendedNotebook, Buttons, Graphics, LMessages ;
+
+const
+ TDIM_CLOSEPAGE = LM_INTERFACELAST + 500;
type
@@ -75,6 +78,7 @@ type
public
constructor Create(TheOwner: TComponent ); override;
+ destructor Destroy ; override;
procedure RestoreLastFocusedControl ;
@@ -139,6 +143,8 @@ type
procedure Loaded; override;
procedure RemovePage(Index: Integer); override;
+ procedure msg_ClosePage(var Msg: TLMessage); message TDIM_CLOSEPAGE;
+
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
@@ -150,7 +156,7 @@ type
procedure DoCloseTabClicked(APage: TCustomPage); override;
procedure CreateFormInNewPage( AFormClass: TFormClass; ImageIndex : Integer = -1 ) ;
- procedure ShowFormInNewPage( AForm: TForm; ImageIndex : Integer = -1 );
+ procedure ShowFormInPage( AForm: TForm; ImageIndex : Integer = -1 );
Function FindFormInPages( AForm: TForm): Integer ;
Function CanCloseAllPages: Boolean ;
@@ -223,6 +229,8 @@ begin
FCloseAllTabs.Free;
FCloseTab.Free;
FTabsMenu.Free;
+ FNextTab.Free;
+ FPreviousTab.Free;
inherited Destroy;
end ;
@@ -239,6 +247,11 @@ begin
fsLastActiveControl := nil ;
end ;
+destructor TTDIPage.Destroy ;
+begin
+ inherited Destroy ;
+end ;
+
procedure TTDIPage.RestoreLastFocusedControl ;
begin
if Assigned( fsLastActiveControl ) then
@@ -284,7 +297,6 @@ begin
// Change Form Parent to the Page //
fsFormInPage.Parent := Self;
- //fsFormInPage.FreeNotification(Self); // This cause a SIGSEGV, when Form is Closed from inside
// Show the Form //
fsFormInPage.Visible := True ;
@@ -339,6 +351,8 @@ end ;
procedure TTDIPage.OnFormClose(Sender : TObject ; var CloseAction : TCloseAction
) ;
+var
+ Msg: TLMessage;
begin
if Assigned( fsFormOldCloseEvent ) then
fsFormOldCloseEvent( Sender, CloseAction );
@@ -348,9 +362,13 @@ begin
fsFormInPage := nil;
- // This will force this page be killed by TTDINoteBook.Notification();
if Assigned( Parent ) then
- Parent.RemoveComponent( Self );
+ begin
+ Msg.msg := TDIM_CLOSEPAGE;
+ Msg.lParam := PageIndex;
+
+ Parent.Dispatch( Msg );
+ end ;
end ;
procedure TTDIPage.SaveFormProperties ;
@@ -652,12 +670,12 @@ procedure TTDINoteBook.CreateFormInNewPage(AFormClass : TFormClass ;
Var
NewForm : TForm ;
begin
- NewForm := AFormClass.Create(nil);
+ NewForm := AFormClass.Create(Application);
- ShowFormInNewPage( NewForm, ImageIndex );
+ ShowFormInPage( NewForm, ImageIndex );
end ;
-procedure TTDINoteBook.ShowFormInNewPage(AForm : TForm ; ImageIndex : Integer) ;
+procedure TTDINoteBook.ShowFormInPage(AForm : TForm ; ImageIndex : Integer) ;
Var
NewPage : TTDIPage ;
AlreadyExistingPage : Integer ;
@@ -910,7 +928,7 @@ begin
if FNextMenuItem <> nil then
with FNextMenuItem do
begin
- Enabled := (PageCount > 0);
+ Enabled := (PageCount > 1);
Caption := TDIActions.NextTab.Caption;
Visible := TDIActions.NextTab.Visible;
ImageIndex := TDIActions.NextTab.ImageIndex;
@@ -919,7 +937,7 @@ begin
if FPreviousMenuItem <> nil then
with FPreviousMenuItem do
begin
- Enabled := (PageCount > 0);
+ Enabled := (PageCount > 1);
Caption := TDIActions.PreviousTab.Caption;
Visible := TDIActions.PreviousTab.Visible;
ImageIndex := TDIActions.PreviousTab.ImageIndex;
@@ -1017,35 +1035,26 @@ end ;
procedure TTDINoteBook.RemovePage(Index : Integer) ;
Var
CanRemovePage : Boolean ;
- LastPageCount : Integer ;
+ APage : TTabSheet;
begin
- CanRemovePage := True;
+ CanRemovePage := True;
FIsRemovingAPage := True;
-
+ APage := Pages[Index] ;
try
if ([csDesigning, csDestroying] * ComponentState = []) then
- if Pages[Index] is TTDIPage then
- with TTDIPage(Pages[Index]) do
+ if APage is TTDIPage then
+ with TTDIPage(APage) do
begin
if Assigned( FormInPage ) then
begin
- { // This code is ok, but calls CloseQuery twice //
- CanRemovePage := FormInPage.CloseQuery ;
- if CanRemovePage then
- FormInPage.Close ;
- }
- LastPageCount := PageCount;
+ CanRemovePage := False;
FormInPage.Close ;
- CanRemovePage := (LastPageCount = PageCount ) and // Page wasn't removed by Notification ?
- ( (not Assigned(FormInPage)) or // Form Isn't valid ?
- ( not FormInPage.Showing ) // Form is not showing ?
- );
end ;
end ;
if CanRemovePage then
begin
- inherited RemovePage(Index) ;
+ inherited RemovePage(APage.PageIndex) ;
if PageCount < 1 then // On this case, DoChange is not fired //
CheckInterface;
@@ -1055,6 +1064,11 @@ begin
end ;
end ;
+procedure TTDINoteBook.msg_ClosePage(var Msg : TLMessage) ;
+begin
+ RemovePage( Msg.lParam );
+end ;
+
procedure TTDINoteBook.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
var
@@ -1118,10 +1132,7 @@ begin
else if ([csDesigning, csDestroying] * ComponentState <> []) then
else if (AComponent is TForm) then
- RemoveInvalidPages
-
- else if (AComponent is TTDIPage) and (not FIsRemovingAPage) then
- RemovePage( TTDIPage( AComponent ).PageIndex ) ;
+ RemoveInvalidPages ;
end ;
end ;