Browse Source

* Add StreamOriginalFormat to ObjectTextToBinary

Michaël Van Canneyt 1 year ago
parent
commit
a9b8fb0f05
2 changed files with 44 additions and 0 deletions
  1. 42 0
      rtl/objpas/classes/classes.inc
  2. 2 0
      rtl/objpas/classes/classesh.inc

+ 42 - 0
rtl/objpas/classes/classes.inc

@@ -1649,6 +1649,37 @@ begin
   end;
 end;
 
+function ReadComponentDeltaRes(Instance: TComponent; const DeltaCandidates: array of string; const Proc: TGetStreamProc): TComponent;
+
+var
+  H:TFPResourceHandle;
+  HInst: THandle;
+  RootName, Delta, ResName: string;
+  S: TStream;
+  
+begin
+  S:=nil;
+  if (Instance=Nil) or (Proc=Nil) then
+    Raise EArgumentNilException.Create(SArgumentNil);
+  HInst:=HInstance;
+  Result:=Instance;
+  RootName:=Instance.ClassType.ClassName;
+  for Delta in DeltaCandidates do
+    begin
+    ResName:=RootName+'_'+Delta;
+    H:=System.FindResource(HInst,ResName,RT_RCDATA);
+    if PtrInt(H)<>0 then
+      try
+        S:=TResourceStream.Create(HInst,ResName,PChar(RT_RCDATA));
+        Proc(S);
+        Exit;
+      finally
+        S.Free;
+      end;
+    end;
+end;
+
+
 
 Function FindNestedComponent(Root : TComponent; APath : String; CStyle : Boolean = True) : TComponent;
 
@@ -1828,6 +1859,7 @@ begin
 end;
 
 procedure ObjectBinaryToText(Input, Output: TStream; Encoding: TObjectTextEncoding);
+
 var
   Version: TBinaryObjectReader.TBOVersion;
 
@@ -2285,6 +2317,16 @@ begin
 end;
 
 procedure ObjectTextToBinary(Input, Output: TStream);
+
+var
+  Fmt : TStreamOriginalFormat;
+
+begin
+  ObjectTextToBinary(Input,Output,Fmt);
+end;
+
+procedure ObjectTextToBinary(Input, Output: TStream; var Format: TStreamOriginalFormat);
+
 var
   parser: TParser;
   Version: TBinaryObjectReader.TBOVersion;

+ 2 - 0
rtl/objpas/classes/classesh.inc

@@ -2867,6 +2867,7 @@ function FindGlobalComponent(const Name: string): TComponent;
 function IsUniqueGlobalComponentName(const aName: string): Boolean;
 
 function InitInheritedComponent(Instance: TComponent; RootAncestor: TClass): Boolean;
+function ReadComponentDeltaRes(Instance: TComponent; const DeltaCandidates: array of string; const Proc: TGetStreamProc): TComponent;
 function InitComponentRes(const ResName: string; Instance: TComponent): Boolean;
 function ReadComponentRes(const ResName: string; Instance: TComponent): TComponent;
 function ReadComponentResEx(HInstance: THandle; const ResName: string): TComponent;
@@ -2901,6 +2902,7 @@ type
 
 procedure ObjectBinaryToText(Input, Output: TStream; Encoding: TObjectTextEncoding);
 procedure ObjectBinaryToText(Input, Output: TStream);
+procedure ObjectTextToBinary(Input, Output: TStream; var Format: TStreamOriginalFormat);
 procedure ObjectTextToBinary(Input, Output: TStream);
 
 procedure ObjectResourceToText(Input, Output: TStream);