@@ -107,6 +107,8 @@ TPyDelphiComponent = class (TPyDelphiPersistent)
107
107
function CreateComponent (AOwner : TComponent) : TComponent; virtual ;
108
108
procedure SubscribeToFreeNotification ; override;
109
109
procedure UnSubscribeToFreeNotification ; override;
110
+ function InternalReadComponent (const AResFile: string;
111
+ const AInstance: TComponent): boolean; virtual ;
110
112
// Exposed Methods
111
113
function GetParentComponent_Wrapper (args : PPyObject) : PPyObject; cdecl;
112
114
function HasParent_Wrapper (args : PPyObject) : PPyObject; cdecl;
@@ -242,7 +244,20 @@ TPyDelphiBasicAction = class (TPyDelphiComponent)
242
244
implementation
243
245
244
246
uses
245
- TypInfo;
247
+ TypInfo, System.IOUtils, System.Rtti;
248
+
249
+ type
250
+ TPyReader = class (TReader)
251
+ private
252
+ FPyObject: TPyDelphiObject;
253
+ FInstance: TComponent;
254
+ procedure DoFind (Reader: TReader; const ClassName: string; var ComponentClass: TComponentClass);
255
+ protected
256
+ procedure SetName (Component: TComponent; var Name : string); override;
257
+ function FindMethod (Root: TComponent; const AMethodName: string): Pointer; override;
258
+ public
259
+ constructor Create(APyObject: TPyDelphiObject; Stream: TStream; BufSize: Integer);
260
+ end ;
246
261
247
262
{ Register the wrappers, the globals and the constants }
248
263
type
@@ -877,6 +892,65 @@ function TPyDelphiComponent.HasParent_Wrapper(args: PPyObject): PPyObject;
877
892
end ;
878
893
end ;
879
894
895
+ function TPyDelphiComponent.InternalReadComponent (const AResFile: string;
896
+ const AInstance: TComponent): boolean;
897
+
898
+ procedure ReadRootComponent (const AStream: TStream);
899
+ begin
900
+ AStream.Position := 0 ;
901
+ var LReader := TPyReader.Create(Self, AStream, 4096 );
902
+ try
903
+ LReader.ReadRootComponent(DelphiObject);
904
+ finally
905
+ LReader.Free;
906
+ end ;
907
+ end ;
908
+
909
+ function HasValidSignature (const AStream: TStream): boolean;
910
+ const
911
+ FilerSignature: UInt32 = $30465054 ; // ($54, $50, $46, $30) 'TPF0'
912
+ var
913
+ LSignature: UInt32;
914
+ begin
915
+ AStream.Position := 0 ;
916
+ var LReader := TReader.Create(AStream, AStream.Size);
917
+ try
918
+ LReader.Read(LSignature, SizeOf(LSignature));
919
+ Result := (LSignature = FilerSignature);
920
+ AStream.Position := 0 ;
921
+ finally
922
+ LReader.Free();
923
+ end ;
924
+ end ;
925
+
926
+ begin
927
+ if AResFile.IsEmpty or not TFile.Exists(AResFile) then
928
+ Exit(false);
929
+
930
+ var LInput := TFileStream.Create(AResFile, fmOpenRead);
931
+ try
932
+ // The current form file is a valid binary file
933
+ if HasValidSignature(LInput) then
934
+ ReadRootComponent(LInput)
935
+ else begin
936
+ var LOutput := TMemoryStream.Create();
937
+ try
938
+ // we assume the form file is a text file, then we try to get the bin info
939
+ ObjectTextToBinary(LInput, LOutput);
940
+ if HasValidSignature(LOutput) then
941
+ ReadRootComponent(LOutput)
942
+ else
943
+ Exit(false);
944
+ finally
945
+ LOutput.Free();
946
+ end ;
947
+ end ;
948
+ finally
949
+ LInput.Free();
950
+ end ;
951
+ Result := true;
952
+ end ;
953
+
880
954
function TPyDelphiComponent.GetAttrO (key: PPyObject): PPyObject;
881
955
Var
882
956
Component: TComponent;
@@ -1575,6 +1649,102 @@ function TPyDelphiStrings.Set_Text(AValue: PPyObject;
1575
1649
end ;
1576
1650
end ;
1577
1651
1652
+ { TPyReader }
1653
+
1654
+ constructor TPyReader.Create(APyObject: TPyDelphiObject; Stream: TStream;
1655
+ BufSize: Integer);
1656
+ begin
1657
+ inherited Create(Stream, BufSize);
1658
+ OnFindComponentClass := DoFind;
1659
+ FPyObject := APyObject;
1660
+ FInstance := APyObject.DelphiObject as TComponent;
1661
+ end ;
1662
+
1663
+ procedure TPyReader.DoFind (Reader: TReader; const ClassName: string;
1664
+ var ComponentClass: TComponentClass);
1665
+ var
1666
+ LClass: TClass;
1667
+ LCtx: TRttiContext;
1668
+ LType: TRttiType;
1669
+ begin
1670
+ LClass := GetClass(ClassName);
1671
+ if Assigned(LClass) and (LClass.InheritsFrom(TComponent)) then begin
1672
+ ComponentClass := TComponentClass(LClass);
1673
+ Exit;
1674
+ end ;
1675
+
1676
+ LCtx := TRttiContext.Create();
1677
+ try
1678
+ for LType in LCtx.GetTypes() do
1679
+ begin
1680
+ if LType.IsInstance and LType.Name .EndsWith(ClassName) then begin
1681
+ if LType.AsInstance.MetaclassType.InheritsFrom(TComponent) then begin
1682
+ ComponentClass := TComponentClass(LType.AsInstance.MetaclassType);
1683
+ Break;
1684
+ end ;
1685
+ end ;
1686
+ end ;
1687
+ finally
1688
+ LCtx.Free();
1689
+ end ;
1690
+ end ;
1691
+
1692
+ function TPyReader.FindMethod (Root: TComponent;
1693
+ const AMethodName: string): Pointer;
1694
+ var
1695
+ LPyMethodName: PPyObject;
1696
+ LPyPropName: PPyObject;
1697
+ LCallable: PPyObject;
1698
+ begin
1699
+ Result := nil ;
1700
+ if Assigned(GetPropInfo(FInstance, PropName)) then begin
1701
+ with GetPythonEngine() do begin
1702
+ LPyMethodName := PyUnicodeFromString(AMethodName);
1703
+ try
1704
+ LCallable := FPyObject.GetAttrO(LPyMethodName);
1705
+ try
1706
+ if not Assigned(LCallable) then
1707
+ Exit();
1708
+
1709
+ LPyPropName := PyUnicodeFromString(PropName);
1710
+ try
1711
+ PyObject_SetAttr(FPyObject.Wrap(FInstance), LPyPropName, LCallable);
1712
+
1713
+ if PyErr_Occurred <> nil then
1714
+ CheckError(false);
1715
+ finally
1716
+ Py_XDecRef(LPyPropName);
1717
+ end ;
1718
+ finally
1719
+ Py_XDecRef(LCallable);
1720
+ end ;
1721
+ finally
1722
+ Py_XDecRef(LPyMethodName);
1723
+ end ;
1724
+ end ;
1725
+ end ;
1726
+ end ;
1727
+
1728
+ procedure TPyReader.SetName (Component: TComponent; var Name : string);
1729
+ var
1730
+ LPyKey: PPyObject;
1731
+ begin
1732
+ inherited ;
1733
+ with GetPythonEngine() do begin
1734
+ LPyKey := PyUnicodeFromString(Name );
1735
+ try
1736
+ PyObject_GenericSetAttr(
1737
+ FPyObject.GetSelf(), LPyKey, FPyObject.Wrap(Component));
1738
+
1739
+ if PyErr_Occurred <> nil then
1740
+ CheckError(false);
1741
+ finally
1742
+ Py_XDecRef(LPyKey);
1743
+ end ;
1744
+ end ;
1745
+ FInstance := Component;
1746
+ end ;
1747
+
1578
1748
initialization
1579
1749
RegisteredUnits.Add(TClassesRegistration.Create);
1580
1750
end .
0 commit comments