* Delta stream support

rtl/objpas/classes/classes.inc

@@ -1462,6 +1462,8 @@ function DefaultInitHandler(Instance: TComponent; RootAncestor: TClass): Boolean
     try
 {$endif}
       result:=doinit(Instance.ClassType);
+      if Result then 
+        Instance.ReadDeltaState;
 {$ifdef FPC_HAS_FEATURE_THREADING}
     finally
       GlobalNameSpace.EndWrite;

rtl/objpas/classes/classesh.inc

@@ -1808,6 +1808,8 @@ type
   TReadWriteStringPropertyEvent = procedure(Sender:TObject;
     const Instance: TPersistent; PropInfo: PPropInfo;
     var Content:string) of object;
+  TGetStreamProc = procedure (const S: TStream) of object;
+  TGetDeltaStreamsEvent = procedure (Sender: TObject; Proc: TGetStreamProc; var Handled: Boolean) of object;
 
 
   { TReader }
@@ -1888,6 +1890,7 @@ type
     procedure ReadListBegin;
     procedure ReadListEnd;
     function ReadRootComponent(ARoot: TComponent): TComponent;
+    function ReadComponentDeltaRes(Instance: TComponent; const DeltaCandidates: array of Ansistring; const Proc: TGetStreamProc): TComponent;
     function ReadVariant: Variant;
     procedure ReadSignature;
     function ReadString: RawBytestring;
@@ -2382,6 +2385,7 @@ type
 
   TBasicAction = class;
   
+
   { TComponent }
 
   TComponent = class(TPersistent,IUnknown,IInterfaceComponentReference)
@@ -2395,6 +2399,7 @@ type
     FVCLComObject: Pointer;
     FComponentState: TComponentState;
     FDObservers : TObservers;
+    FOnGetDeltaStreams: TGetDeltaStreamsEvent;
     function GetComObject: IUnknown;
     function GetComponent(AIndex: Integer): TComponent;
     function GetComponentCount: Integer;
@@ -2411,6 +2416,9 @@ type
     procedure WriteTop(Writer: TWriter);
   protected
     FComponentStyle: TComponentStyle;
+    procedure GetDeltaStreams(aProc: TGetStreamProc); virtual;
+    procedure ReadDeltaStream(const S: TStream);
+    procedure ReadDeltaState; virtual;
     procedure ChangeName(const NewName: TComponentName);
     procedure DefineProperties(Filer: TFiler); override;
     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); dynamic;
@@ -2488,6 +2496,7 @@ type
     property Owner: TComponent read FOwner;
     property VCLComObject: Pointer read FVCLComObject write FVCLComObject;
     Property Observers : TObservers Read GetObservers;
+    property OnGetDeltaStreams: TGetDeltaStreamsEvent read FOnGetDeltaStreams write FOnGetDeltaStreams;    
   published
     property Name: TComponentName read FName write SetName stored False;
     property Tag: PtrInt read FTag write FTag default 0;
@@ -2811,7 +2820,6 @@ type
   TIntToIdent = function(Int: Longint; var Ident: string): Boolean;
   TFindGlobalComponent = function(const Name: string): TComponent;
   TInitComponentHandler = function(Instance: TComponent; RootAncestor : TClass): boolean;
-  TGetStreamProc = procedure (const S: TStream) of object;
 
 var
   MainThreadID: TThreadID;

rtl/objpas/classes/compon.inc

@@ -730,3 +730,33 @@ begin
   else
     Result := E_NOTIMPL;
 end;
+
+{ Delta stream support }
+
+
+procedure TComponent.GetDeltaStreams(aProc: TGetStreamProc); 
+
+begin
+  // To be implemented by descendants
+end;
+
+procedure TComponent.ReadDeltaStream(const S: TStream);
+begin
+  S.ReadComponent(Self);
+end;
+
+procedure TComponent.ReadDeltaState;
+
+var
+  Done : boolean;
+  
+begin
+  if (csDesigning in ComponentState) then
+    exit;
+  Done:=False;
+  if Assigned(FOnGetDeltaStreams) then
+    FOnGetDeltaStreams(Self,@ReadDeltaStream,Done);  
+  if not Done then
+    GetDeltaStreams(@ReadDeltaStream);
+end;
+

rtl/objpas/classes/reader.inc

@@ -1889,6 +1889,35 @@ begin
       raise EClassNotFound.CreateFmt(SNoFieldOfClassIn, [AClassName, Root.ClassName]);
 end;
 
+function TReader.ReadComponentDeltaRes(Instance: TComponent; const DeltaCandidates: array of Ansistring; const Proc: TGetStreamProc): TComponent;
+
+var
+  ResHandle: THandle;
+  RootName, Delta, DeltaName: AnsiString;
+  S: TStream;
+  
+begin
+  if (Instance=nil) or not Assigned(Proc) then
+    Raise EArgumentNilException.Create(SArgumentNil);
+  Result:=Instance;
+  RootName:=Instance.ClassName;
+  for Delta in DeltaCandidates do
+     begin
+     DeltaName:=RootName+'_'+Delta;
+     // No module support yet
+     ResHandle:=FindResource(Nilhandle,PAnsiChar(DeltaName), PAnsiChar(RT_RCDATA));
+     if ResHandle<>NilHandle then
+       Break;
+     end;
+  if ResHandle=NilHandle then 
+    exit;     
+  S:=TResourceStream.Create(NilHandle,DeltaName, PChar(RT_RCDATA));
+  try
+    Proc(S);
+  finally
+    S.Free;
+  end;
+end;
     
 { TAbstractObjectReader }