Skip to content

Commit e4e481a

Browse files
committed
Merged from downstream.
1 parent 8bef49b commit e4e481a

18 files changed

+2727
-22
lines changed

Packages/Delphi/Delphi 10.4+/Python.dpk

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -34,7 +34,9 @@ requires
3434
dbrtl,
3535
FireDAC,
3636
FireDACCommonDriver,
37-
FireDACCommon;
37+
FireDACCommon,
38+
bindengine,
39+
bindcomp;
3840

3941
contains
4042
MethodCallBack in '..\..\..\Source\MethodCallBack.pas',
@@ -46,6 +48,7 @@ contains
4648
WrapDelphiTypes in '..\..\..\Source\WrapDelphiTypes.pas',
4749
WrapDelphiWindows in '..\..\..\Source\WrapDelphiWindows.pas',
4850
WrapFireDAC in '..\..\..\Source\WrapFireDAC.pas',
49-
WrapActions in '..\..\..\Source\WrapActions.pas';
51+
WrapActions in '..\..\..\Source\WrapActions.pas',
52+
WrapDelphiDataBind in '..\..\..\Source\WrapDelphiDataBind.pas';
5053

5154
end.

Packages/Delphi/Delphi 10.4+/PythonFmx.dpk

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -53,6 +53,10 @@ contains
5353
WrapFmxListBox in '..\..\..\Source\fmx\WrapFmxListBox.pas',
5454
WrapFmxMedia in '..\..\..\Source\fmx\WrapFmxMedia.pas',
5555
WrapFmxMenus in '..\..\..\Source\fmx\WrapFmxMenus.pas',
56-
WrapFmxStyles in '..\..\..\Source\fmx\WrapFmxStyles.pas';
56+
WrapFmxStyles in '..\..\..\Source\fmx\WrapFmxStyles.pas',
57+
WrapFmxMemo in '..\..\..\Source\fmx\WrapFmxMemo.pas',
58+
WrapFmxColors in '..\..\..\Source\fmx\WrapFmxColors.pas',
59+
WrapFmxListView in '..\..\..\Source\fmx\WrapFmxListView.pas',
60+
WrapFmxDataBind in '..\..\..\Source\fmx\WrapFmxDataBind.pas';
5761

5862
end.

Source/WrapDelphi.pas

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -921,8 +921,8 @@ implementation
921921
rs_NotPublished = 'Event handling is available only for published properties';
922922
rs_ExpectedObject = 'Expected a Pascal object';
923923
rs_ExpectedRecord = 'Expected a Pascal record';
924-
rs_ExpectedInterface = 'Expected a Pascal interface';
925924
rs_ExpectedClass = 'Expected a Pascal class';
925+
rs_ExpectedInterface = 'Expected a Pascal interface';
926926
rs_InvalidClass = 'Invalid class';
927927
rs_ErrEventNotReg = 'No Registered EventHandler for events of type "%s';
928928
rs_ErrEventNoSuport = 'Class %s does not support events because it must '+

Source/WrapDelphiClasses.pas

Lines changed: 171 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -107,6 +107,8 @@ TPyDelphiComponent = class (TPyDelphiPersistent)
107107
function CreateComponent(AOwner : TComponent) : TComponent; virtual;
108108
procedure SubscribeToFreeNotification; override;
109109
procedure UnSubscribeToFreeNotification; override;
110+
function InternalReadComponent(const AResFile: string;
111+
const AInstance: TComponent): boolean; virtual;
110112
// Exposed Methods
111113
function GetParentComponent_Wrapper(args : PPyObject) : PPyObject; cdecl;
112114
function HasParent_Wrapper(args : PPyObject) : PPyObject; cdecl;
@@ -242,7 +244,20 @@ TPyDelphiBasicAction = class (TPyDelphiComponent)
242244
implementation
243245

244246
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;
246261

247262
{ Register the wrappers, the globals and the constants }
248263
type
@@ -877,6 +892,65 @@ function TPyDelphiComponent.HasParent_Wrapper(args: PPyObject): PPyObject;
877892
end;
878893
end;
879894

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+
880954
function TPyDelphiComponent.GetAttrO(key: PPyObject): PPyObject;
881955
Var
882956
Component: TComponent;
@@ -1575,6 +1649,102 @@ function TPyDelphiStrings.Set_Text(AValue: PPyObject;
15751649
end;
15761650
end;
15771651

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+
15781748
initialization
15791749
RegisteredUnits.Add(TClassesRegistration.Create);
15801750
end.

0 commit comments

Comments
 (0)