Skip to content

Commit c67b5a5

Browse files
author
pyscripter
committed
1 parent 7670cd8 commit c67b5a5

File tree

6 files changed

+224
-160
lines changed

6 files changed

+224
-160
lines changed

PythonForDelphi/Components/Sources/Core/Definition.Inc

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -275,9 +275,14 @@
275275
// Misc
276276
/////////////////////////////////////////////////////////////////////////////
277277

278+
{$IFDEF DELPHI2010_OR_HIGHER}
279+
{$DEFINE USESYSTEMDISPINVOKE} //Might work with earlier versions as well
280+
{$ENDIF}
281+
278282
{$IFDEF FPC}
279283
{$MODE DELPHI}
280284
{$IFDEF CPU64}
281285
{$DEFINE CPUX64}
282286
{$ENDIF CPU64}
287+
{$DEFINE USESYSTEMDISPINVOKE}
283288
{$ENDIF FPC}

PythonForDelphi/Components/Sources/Core/PythonEngine.pas

Lines changed: 102 additions & 105 deletions
Large diffs are not rendered by default.

PythonForDelphi/Components/Sources/Core/VarPyth.pas

Lines changed: 96 additions & 45 deletions
Original file line numberDiff line numberDiff line change
@@ -104,7 +104,7 @@ function BuiltinModule : Variant; // return the builtin module
104104
function SysModule : Variant; // return the builtin module 'sys'
105105
function DatetimeModule : Variant; // return the builtin module 'datetime'
106106
function Import( const AModule : AnsiString ) : Variant; // import a Python module and return the module object.
107-
function len(const AValue : Variant ) : Integer; // return the length of a Python collection.
107+
function len(const AValue : Variant ) : NativeInt; // return the length of a Python collection.
108108
function _type(const AValue : Variant ) : Variant; // return the type object of a Python object.
109109
function iter(const AValue : Variant ) : Variant; // return an iterator for the container AValue. You can call the 'next' method of the iterator until you catch the EPyStopIteration exception.
110110

@@ -134,14 +134,21 @@ TPythonVariantType = class(TInvokeableVariantType, IVarInstanceReference)
134134
function VarDataToPythonObject( AVarData : TVarData ) : PPyObject;
135135
procedure PythonObjectToVarData( var Dest : TVarData; AObject : PPyObject; APythonAtomCompatible : Boolean );
136136
procedure PyhonVarDataCreate( var Dest : TVarData; AObject : PPyObject );
137+
{$IFNDEF USESYSTEMDISPINVOKE}
137138
procedure DoDispInvoke(Dest: PVarData; const Source: TVarData;
138139
CallDesc: PCallDesc; Params: Pointer); virtual;
140+
function GetPropertyWithArg(var Dest: TVarData; const V: TVarData;
141+
const AName: AnsiString; AArg : TVarData): Boolean; virtual;
142+
{$ENDIF USESYSTEMDISPINVOKE}
143+
{$IFNDEF FPC}
144+
function FixupIdent(const AText: string): string; override;
145+
{$ENDIF FPC}
139146
{$IFDEF FPC}
140147
procedure VarDataClear(var Dest: TVarData);
141148
procedure VarDataCopyNoInd(var Dest: TVarData; const Source: TVarData);
142149
procedure VarDataCastTo(var Dest: TVarData; const Source: TVarData;
143150
const AVarType: TVarType); overload;
144-
{$ENDIF}
151+
{$ENDIF FPC}
145152
public
146153
procedure Clear(var V: TVarData); override;
147154
function IsClear(const V: TVarData): Boolean; override;
@@ -162,8 +169,6 @@ TPythonVariantType = class(TInvokeableVariantType, IVarInstanceReference)
162169
const Arguments: TVarDataArray): Boolean; override;
163170
function GetProperty(var Dest: TVarData; const V: TVarData;
164171
const AName: string): Boolean; override;
165-
function GetPropertyWithArg(var Dest: TVarData; const V: TVarData;
166-
const AName: AnsiString; AArg : TVarData): Boolean; virtual;
167172
function SetProperty(const V: TVarData; const AName: string;
168173
const Value: TVarData): Boolean; override;
169174
procedure DispInvoke(Dest: PVarData; const Source: TVarData;
@@ -680,7 +685,7 @@ function Import( const AModule : AnsiString ) : Variant;
680685
end; // of with
681686
end;
682687

683-
function GetObjectLength(AObject: PPyObject): Integer;
688+
function GetObjectLength(AObject: PPyObject): NativeInt;
684689
begin
685690
with GetPythonEngine do
686691
begin
@@ -691,7 +696,7 @@ function GetObjectLength(AObject: PPyObject): Integer;
691696
end;
692697

693698
// returns the length of a Python collection.
694-
function len(const AValue : Variant ) : Integer;
699+
function len(const AValue : Variant ) : NativeInt;
695700
begin
696701
if VarIsPython(AValue) then
697702
Result := GetObjectLength( ExtractPythonObjectFrom(AValue) )
@@ -891,7 +896,49 @@ procedure SetClearVarToEmptyParam(var V: TVarData);
891896
{$ENDIF}
892897
end;
893898

894-
// Note that DispInvoke has a different interface in Kylix2 only!
899+
const
900+
CDoMethod = $01;
901+
CPropertyGet = $02;
902+
CPropertySet = $04;
903+
904+
{$IFDEF USESYSTEMDISPINVOKE}
905+
procedure TPythonVariantType.DispInvoke(Dest: PVarData;
906+
const Source: TVarData; CallDesc: PCallDesc; Params: Pointer);
907+
908+
procedure GetNamedParams;
909+
var
910+
LNamePtr: PAnsiChar;
911+
LNamedArgStart : Integer; //arg position of 1st named argument (if any)
912+
I : integer;
913+
begin
914+
LNamePtr := PAnsiChar(@CallDesc^.ArgTypes[CallDesc^.ArgCount]);
915+
LNamedArgStart := CallDesc^.ArgCount - CallDesc^.NamedArgCount;
916+
SetLength(fNamedParams, CallDesc^.NamedArgCount);
917+
// Skip function Name
918+
for I := 0 to CallDesc^.NamedArgCount - 1 do begin
919+
LNamePtr := LNamePtr + Succ(StrLen(LNamePtr));
920+
fNamedParams[I].Index := I+LNamedArgStart;
921+
fNamedParams[I].Name := AnsiString(LNamePtr);
922+
end;
923+
end;
924+
925+
Var
926+
NewCallDesc : TCallDesc;
927+
begin
928+
if CallDesc^.NamedArgCount > 0 then GetNamedParams;
929+
try
930+
if (CallDesc^.CallType = CPropertyGet) and (CallDesc^.ArgCount = 1) then begin
931+
NewCallDesc := CallDesc^;
932+
NewCallDesc.CallType := CDoMethod;
933+
inherited DispInvoke(Dest, Source, @NewCallDesc, Params);
934+
end else
935+
inherited;
936+
finally
937+
if CallDesc^.NamedArgCount > 0 then SetLength(fNamedParams, 0);
938+
end;
939+
end;
940+
941+
{$ELSE USESYSTEMDISPINVOKE}
895942
procedure TPythonVariantType.DispInvoke(Dest: PVarData;
896943
const Source: TVarData; CallDesc: PCallDesc; Params: Pointer);
897944
begin
@@ -907,10 +954,6 @@ TStringDesc = record
907954
BStr: WideString;
908955
PStr: PAnsiString;
909956
end;
910-
const
911-
CDoMethod = $01;
912-
CPropertyGet = $02;
913-
CPropertySet = $04;
914957
var
915958
LArguments: TVarDataArray;
916959
LStrings: array of TStringDesc;
@@ -1148,6 +1191,41 @@ TStringDesc = record
11481191
end;
11491192
end;
11501193

1194+
function TPythonVariantType.GetPropertyWithArg(var Dest: TVarData;
1195+
const V: TVarData; const AName: AnsiString; AArg: TVarData): Boolean;
1196+
var
1197+
_prop, _result : PPyObject;
1198+
begin
1199+
with GetPythonEngine do
1200+
begin
1201+
_result := nil;
1202+
_prop := PyObject_GetAttrString(TPythonVarData(V).VPython.PyObject, PAnsiChar(AName));
1203+
CheckError;
1204+
if Assigned(_prop) then
1205+
begin
1206+
// here we check only sequences, as Delphi does not allow a type different from Integer
1207+
// to be used within brackets.
1208+
// But you can still access a dictionary with parenthesis, like: myObj.MyDict('MyKey')
1209+
// Note that we can't use the brackets on a Python variant that contains a list,
1210+
// because Delphi thinks it's a variant array, whereas it is not, of course!
1211+
// So: myList[0] won't work, but myObj.MyList[0] will!!!
1212+
if PySequence_Check(_prop) <> 0 then
1213+
begin
1214+
_result := PySequence_GetItem(_prop, Variant(AArg));
1215+
CheckError;
1216+
end; // of if
1217+
end; // of if
1218+
Result := Assigned(_result);
1219+
if Result then
1220+
try
1221+
PythonObjectToVarData(Dest, _result, TPythonVarData(V).VPython.PythonAtomCompatible);
1222+
finally
1223+
Py_XDecRef(_prop);
1224+
end; // of try
1225+
end; // of with
1226+
end;
1227+
{$ENDIF USESYSTEMDISPINVOKE}
1228+
11511229
function TPythonVariantType.DoFunction(var Dest: TVarData;
11521230
const V: TVarData; const AName: string;
11531231
const Arguments: TVarDataArray): Boolean;
@@ -1478,6 +1556,13 @@ function TPythonVariantType.EvalPython(const V: TVarData;
14781556
end; // of with
14791557
end;
14801558

1559+
{$IFNDEF FPC}
1560+
function TPythonVariantType.FixupIdent(const AText: string): string;
1561+
begin
1562+
Result := AText;
1563+
end;
1564+
{$ENDIF FPC}
1565+
14811566
function TPythonVariantType.GetInstance(const V: TVarData): TObject;
14821567
begin
14831568
Result := TPythonVarData(V).VPython;
@@ -1558,40 +1643,6 @@ function TPythonVariantType.GetProperty(var Dest: TVarData;
15581643
end; // of with
15591644
end;
15601645

1561-
function TPythonVariantType.GetPropertyWithArg(var Dest: TVarData;
1562-
const V: TVarData; const AName: AnsiString; AArg: TVarData): Boolean;
1563-
var
1564-
_prop, _result : PPyObject;
1565-
begin
1566-
with GetPythonEngine do
1567-
begin
1568-
_result := nil;
1569-
_prop := PyObject_GetAttrString(TPythonVarData(V).VPython.PyObject, PAnsiChar(AName));
1570-
CheckError;
1571-
if Assigned(_prop) then
1572-
begin
1573-
// here we check only sequences, as Delphi does not allow a type different from Integer
1574-
// to be used within brackets.
1575-
// But you can still access a dictionary with parenthesis, like: myObj.MyDict('MyKey')
1576-
// Note that we can't use the brackets on a Python variant that contains a list,
1577-
// because Delphi thinks it's a variant array, whereas it is not, of course!
1578-
// So: myList[0] won't work, but myObj.MyList[0] will!!!
1579-
if PySequence_Check(_prop) <> 0 then
1580-
begin
1581-
_result := PySequence_GetItem(_prop, Variant(AArg));
1582-
CheckError;
1583-
end; // of if
1584-
end; // of if
1585-
Result := Assigned(_result);
1586-
if Result then
1587-
try
1588-
PythonObjectToVarData(Dest, _result, TPythonVarData(V).VPython.PythonAtomCompatible);
1589-
finally
1590-
Py_XDecRef(_prop);
1591-
end; // of try
1592-
end; // of with
1593-
end;
1594-
15951646
function TPythonVariantType.IsClear(const V: TVarData): Boolean;
15961647
begin
15971648
Result := (TPythonVarData(V).VPython = nil) or

PythonForDelphi/Demos/Demo25/VarPythUnitTest.dpr

Lines changed: 0 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,3 @@
1-
// JCL_DEBUG_EXPERT_GENERATEJDBG OFF
2-
// JCL_DEBUG_EXPERT_INSERTJDBG OFF
3-
// JCL_DEBUG_EXPERT_DELETEMAPFILE OFF
41
program VarPythUnitTest;
52

63
uses

PythonForDelphi/Demos/Demo25/VarPythUnitTest.dproj

Lines changed: 21 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22
<PropertyGroup>
33
<ProjectGuid>{F6960501-E313-4232-96B9-EA62FB351D5E}</ProjectGuid>
44
<MainSource>VarPythUnitTest.dpr</MainSource>
5-
<Config Condition="'$(Config)'==''">Debug</Config>
5+
<Config Condition="'$(Config)'==''">Release</Config>
66
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
77
<ProjectVersion>13.4</ProjectVersion>
88
<FrameworkType>VCL</FrameworkType>
@@ -24,8 +24,14 @@
2424
<CfgParent>Base</CfgParent>
2525
<Base>true</Base>
2626
</PropertyGroup>
27+
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
28+
<Cfg_2_Win32>true</Cfg_2_Win32>
29+
<CfgParent>Cfg_2</CfgParent>
30+
<Cfg_2>true</Cfg_2>
31+
<Base>true</Base>
32+
</PropertyGroup>
2733
<PropertyGroup Condition="'$(Base)'!=''">
28-
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace)</DCC_Namespace>
34+
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win;$(DCC_Namespace)</DCC_Namespace>
2935
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
3036
<VerInfo_Locale>1033</VerInfo_Locale>
3137
<DCC_DependencyCheckOutputName>VarPythUnitTest.exe</DCC_DependencyCheckOutputName>
@@ -41,26 +47,29 @@
4147
<PropertyGroup Condition="'$(Cfg_2)'!=''">
4248
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
4349
</PropertyGroup>
50+
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
51+
<Manifest_File>None</Manifest_File>
52+
</PropertyGroup>
4453
<ItemGroup>
45-
<DelphiCompile Include="VarPythUnitTest.dpr">
54+
<DelphiCompile Include="$(MainSource)">
4655
<MainSource>MainSource</MainSource>
4756
</DelphiCompile>
4857
<DCCReference Include="fmMain.pas">
4958
<Form>TMain</Form>
5059
</DCCReference>
51-
<BuildConfiguration Include="Base">
52-
<Key>Base</Key>
53-
</BuildConfiguration>
5460
<BuildConfiguration Include="Debug">
5561
<Key>Cfg_2</Key>
5662
<CfgParent>Base</CfgParent>
5763
</BuildConfiguration>
64+
<BuildConfiguration Include="Base">
65+
<Key>Base</Key>
66+
</BuildConfiguration>
5867
<BuildConfiguration Include="Release">
5968
<Key>Cfg_1</Key>
6069
<CfgParent>Base</CfgParent>
6170
</BuildConfiguration>
6271
</ItemGroup>
63-
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
72+
<Import Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')" Project="$(BDS)\Bin\CodeGear.Delphi.Targets"/>
6473
<ProjectExtensions>
6574
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
6675
<Borland.ProjectType>VCLApplication</Borland.ProjectType>
@@ -101,6 +110,10 @@
101110
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
102111
<VersionInfoKeys Name="Comments"/>
103112
</VersionInfoKeys>
113+
<Excluded_Packages>
114+
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k160.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
115+
<Excluded_Packages Name="$(BDSBIN)\dclofficexp160.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
116+
</Excluded_Packages>
104117
</Delphi.Personality>
105118
<Platforms>
106119
<Platform value="Win64">False</Platform>
@@ -109,4 +122,5 @@
109122
</BorlandProject>
110123
<ProjectFileVersion>12</ProjectFileVersion>
111124
</ProjectExtensions>
125+
<Import Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')" Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj"/>
112126
</Project>
-1.9 KB
Binary file not shown.

0 commit comments

Comments
 (0)