+ TDataModule en InitInheritedComponent erbij voor Delphi 6 compatibility

fcl/inc/classes.inc

@@ -72,9 +72,14 @@ var
 { TBasicAction implementation }
 {$i action.inc}
 
+{ TDataModule implementation }
+{$i dm.inc}
+
 { Class and component registration routines }
 {$I cregist.inc}
 
+
+
 { Interface related stuff }
 {$ifdef HASINTF}
 {$I intf.inc}
@@ -266,42 +271,58 @@ begin
   Result := True;
 end;
 
+Type
+  TInitHandler = Class(TObject)
+    AHandler : TInitComponentHandler;
+    AClass : TComponentClass;
+  end;
+  
+Var  
+  InitHandlerList : TList;
+   
+procedure RegisterInitComponentHandler(ComponentClass: TComponentClass;   Handler: TInitComponentHandler);
+
+Var
+  I : Integer;
+  H: TInitHandler;
+  
+begin
+  If (InitHandlerList=Nil) then
+    InitHandlerList:=TList.Create;
+  H:=TInitHandler.Create;
+  H.Aclass:=ComponentClass;
+  H.AHandler:=Handler;
+  With InitHandlerList do
+    begin
+    I:=0;
+    While (I<Count) and not H.AClass.InheritsFrom(TInitHandler(Items[i]).AClass) do 
+      Inc(I);
+    If I=Count then
+      InitHandlerList.Add(H)
+    else
+      InitHandlerList.Insert(I,H);
+    end;  
+end;
 
 function InitInheritedComponent(Instance: TComponent; RootAncestor: TClass): Boolean;
 
-  function DoInitClass(ClassType: TClass): Boolean;
+Var
-  begin
+  I : Integer;
-    Result := False;
-    if (ClassType <> TComponent) and (ClassType <> RootAncestor) then
-    begin
-      { Init the parent class first }
-      Result := DoInitClass(ClassType.ClassParent);
-
-      { !!!: This would work only on Win32, how should we do this multiplatform?
-      Result := InternalReadComponentRes(ClassType.ClassName,
-        FindResourceHInstance(FindClassHInstance(ClassType)), Instance)
-        or Result;}
-      Result := False;
-    end;
-  end;
 
 begin
-  {!!!: GlobalNameSpace.BeginWrite;
+  I:=0;
-  try}
+  Result:=False;
-    if (Instance.ComponentState * [csLoading, csInline]) = [] then
+  With InitHandlerList do
     begin
-      BeginGlobalLoading;
+    I:=0;
-      try
+    // Instance is the normally the lowest one, so that one should be used when searching.
-        Result := DoInitClass(Instance.ClassType);
+    While Not result and (I<Count) do
-        NotifyGlobalLoading;
+      begin
-      finally
+      If (Instance.InheritsFrom(TInitHandler(Items[i]).AClass)) then 
-        EndGlobalLoading;
+        Result:=TInitHandler(Items[i]).AHandler(Instance,RootAncestor);  
+      Inc(I);
       end;
-    end else
+    end;  
-      Result := DoInitClass(Instance.ClassType);
-  {finally
-    GlobalNameSpace.EndWrite;
-  end;}
 end;
 
 
@@ -1146,6 +1167,7 @@ end;
 
 procedure CommonInit;
 begin
+  InitHandlerList:=Nil;
   IntConstList := TThreadList.Create;
   GlobalFixupList := TThreadList.Create;
   ClassList := TThreadList.Create;
@@ -1174,6 +1196,8 @@ begin
   ComponentPages.Free;
   {!!!: GlobalNameSpace.Free;
   GlobalNameSpace := nil;}
+  InitHandlerList.Free;
+  InitHandlerList:=Nil;
 end;
 
 
@@ -1191,7 +1215,10 @@ end;
 
 {
   $Log$
-  Revision 1.12  2003-04-19 14:29:25  michael
+  Revision 1.13  2003-06-04 15:27:24  michael
+  + TDataModule en InitInheritedComponent erbij voor Delphi 6 compatibility
+
+  Revision 1.12  2003/04/19 14:29:25  michael
   + Fix from Mattias Gaertner, closes memory leak
 
   Revision 1.11  2002/12/02 12:04:07  sg

fcl/inc/classesh.inc

@@ -1353,6 +1353,58 @@ type
   end;
 {$endif HASINTF}
 
+{ ---------------------------------------------------------------------
+    TDatamodule support
+  ---------------------------------------------------------------------}
+  TDataModule = class(TComponent)
+  private
+    FDPos: TPoint;
+    FDSize: TPoint;
+    FOnCreate: TNotifyEvent;
+    FOnDestroy: TNotifyEvent;
+    FOldOrder : Boolean;
+    Procedure ReadT(Reader: TReader);
+    Procedure WriteT(Writer: TWriter);
+    Procedure ReadL(Reader: TReader);
+    Procedure WriteL(Writer: TWriter);
+    Procedure ReadW(Reader: TReader);
+    Procedure WriteW(Writer: TWriter);
+    Procedure ReadH(Reader: TReader);
+    Procedure WriteH(Writer: TWriter);
+  protected
+    Procedure DoCreate; virtual;
+    Procedure DoDestroy; virtual;
+    Procedure DefineProperties(Filer: TFiler); override;
+    Procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
+    Function HandleCreateException: Boolean; virtual;
+    Procedure ReadState(Reader: TReader); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    Constructor CreateNew(AOwner: TComponent); 
+    Constructor CreateNew(AOwner: TComponent; CreateMode: Integer); virtual;
+    destructor Destroy; override;
+    Procedure AfterConstruction; override;
+    Procedure BeforeDestruction; override;
+    property DesignOffset: TPoint read FDPos write FDPos;
+    property DesignSize: TPoint read FDSize write FDSize;
+  published
+    property OnCreate: TNotifyEvent read FOnCreate write FOnCreate;
+    property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
+    property OldCreateOrder: Boolean read FOldOrder write FOldOrder;
+  end;
+  
+var 
+  // IDE hooks for TDatamodule support. 
+  AddDataModule              : procedure (DataModule: TDataModule) of object;
+  RemoveDataModule           : procedure (DataModule: TDataModule) of object;
+  ApplicationHandleException : procedure (Sender: TObject) of object;
+  ApplicationShowException   : procedure (E: Exception) of object;
+
+{ ---------------------------------------------------------------------
+    General streaming and registration routines
+  ---------------------------------------------------------------------}
+  
+
 var
   RegisterComponentsProc: procedure(const Page: string;
     ComponentClasses: array of TComponentClass);
@@ -1403,6 +1455,7 @@ type
   TIdentToInt = function(const Ident: string; var Int: Longint): Boolean;
   TIntToIdent = function(Int: Longint; var Ident: string): Boolean;
   TFindGlobalComponent = function(const Name: string): TComponent;
+  TInitComponentHandler = function(Instance: TComponent; RootAncestor : TClass): boolean;
 
 var
   MainThreadID: THandle;
@@ -1419,6 +1472,7 @@ function ReadComponentRes(const ResName: string; Instance: TComponent): TCompone
 function ReadComponentResEx(HInstance: THandle; const ResName: string): TComponent;
 function ReadComponentResFile(const FileName: string; Instance: TComponent): TComponent;
 procedure WriteComponentResFile(const FileName: string; Instance: TComponent);
+procedure RegisterInitComponentHandler(ComponentClass: TComponentClass;   Handler: TInitComponentHandler);
 
 procedure GlobalFixupReferences;
 procedure GetFixupReferenceNames(Root: TComponent; Names: TStrings);
@@ -1450,7 +1504,10 @@ function LineStart(Buffer, BufPos: PChar): PChar;
 
 {
   $Log$
-  Revision 1.23  2002-10-14 19:46:50  peter
+  Revision 1.24  2003-06-04 15:27:24  michael
+  + TDataModule en InitInheritedComponent erbij voor Delphi 6 compatibility
+
+  Revision 1.23  2002/10/14 19:46:50  peter
     * use FPC_THREADING define for removing thread dependent code
 
   Revision 1.22  2002/09/07 15:15:24  peter