git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2408 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/tdi/Demo/TDIDemo.lpi

@@ -86,6 +86,9 @@
       <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
     <Linking>
+      <Debugging>
+        <UseHeaptrc Value="True"/>
+      </Debugging>
       <Options>
         <Win32>
           <GraphicApplication Value="True"/>

components/tdi/Demo/TDIDemo.lpr

@@ -7,12 +7,19 @@ 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
+
+   HeapTraceFile := ExtractFilePath(ParamStr(0))+ 'heaptrclog.trc' ;
+   DeleteFile( HeapTraceFile );
+   SetHeapTraceOutput( HeapTraceFile );
+
    RequireDerivedFormResource := True;
   Application.Initialize;
   Application.CreateForm(TfMainForm, fMainForm) ;

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
+    Left = 98
-    Height = 39
+    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
+    Height = 46
-    Top = 203
+    Top = 205
-    Width = 323
+    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
+    Height = 46
-    Top = 90
+    Top = 92
-    Width = 344
+    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

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

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) ;

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;
   FIsRemovingAPage := True;
-
+  APage            := Pages[Index] ;
   try
     if ([csDesigning, csDestroying] * ComponentState = []) then
-      if Pages[Index] is TTDIPage then
+      if APage is TTDIPage then
-        with TTDIPage(Pages[Index]) do
+        with TTDIPage(APage) do
         begin
           if Assigned( FormInPage ) then
           begin
-            { // This code is ok, but calls CloseQuery twice //
+            CanRemovePage := False;
-             CanRemovePage := FormInPage.CloseQuery ;
-             if CanRemovePage then
             FormInPage.Close ;
-            }
-            LastPageCount := PageCount;
-            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
+       RemoveInvalidPages ;
-
-     else if (AComponent is TTDIPage) and (not FIsRemovingAPage) then
-        RemovePage( TTDIPage( AComponent ).PageIndex ) ;
   end ;
 end ;