Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly
Sign up
Appearance settings

Commit d45b048

Browse files
Merge pull request #321 from csmspl/feature/CreateVarParam-with-object
WrapDelphi.CreateVarParam with object - a small helpful overload
2 parents 35e45f1 + cc9411a commit d45b048

File tree

4 files changed

+329
-2
lines changed

4 files changed

+329
-2
lines changed

‎.gitignore‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@
33
*.dcu
44
*.obj
55
*.exe
6+
*.dll
67
*.bpl
78
*.bpi
89
*.dcp
@@ -46,3 +47,4 @@
4647
*.Patch
4748
*.#00
4849
*.pch
50+
/Tests/TestInsightSettings.ini

‎Source/WrapDelphi.pas‎

Lines changed: 12 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -875,7 +875,8 @@ TPyDelphiWrapper = class(TEngineClient, IFreeNotificationSubscriber)
875875
out AValue : TObject) : Boolean;
876876
function CheckCallableAttribute(AAttribute : PPyObject; const AAttributeName : string) : Boolean;
877877
function CheckEnum(const AEnumName : string; AValue, AMinValue, AMaxValue : Integer) : Boolean;
878-
function CreateVarParam(PyDelphiWrapper : TPyDelphiWrapper; const AValue : Variant) : PPyObject;
878+
function CreateVarParam(PyDelphiWrapper : TPyDelphiWrapper; const AValue : Variant) : PPyObject; overload;
879+
function CreateVarParam(PyDelphiWrapper : TPyDelphiWrapper; AObject: TObject) : PPyObject; overload;
879880
function SetToPython(ATypeInfo: PTypeInfo; AValue : Integer) : PPyObject; overload;
880881
function SetToPython(APropInfo: PPropInfo; AValue : Integer) : PPyObject; overload;
881882
function SetToPython(AInstance: TObject; APropInfo: PPropInfo) : PPyObject; overload;
@@ -1304,6 +1305,16 @@ function CreateVarParam(PyDelphiWrapper : TPyDelphiWrapper; const AValue : Varia
13041305
GetPythonEngine.Py_DECREF(tmp);
13051306
end;
13061307

1308+
function CreateVarParam(PyDelphiWrapper : TPyDelphiWrapper; AObject: TObject) : PPyObject;
1309+
var
1310+
tmp: PPyObject;
1311+
begin
1312+
Result := PyDelphiWrapper.VarParamType.CreateInstance;
1313+
tmp := PyDelphiWrapper.Wrap(AObject);
1314+
(PythonToDelphi(Result) as TPyDelphiVarParameter).Value := tmp;
1315+
GetPythonEngine.Py_DECREF(tmp);
1316+
end;
1317+
13071318
function SupportsFreeNotification(AObject : TObject) : Boolean;
13081319
var
13091320
_FreeNotification : IFreeNotification;

‎Tests/P4DTests.dpr‎

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6,17 +6,21 @@ program P4DTests;
66
{$APPTYPE CONSOLE}
77
{$ENDIF}{$STRONGLINKTYPES ON}
88
uses
9+
{$IFDEF FASTMM4}
10+
FastMM4,
11+
{$ENDIF}
912
System.SysUtils,
1013
{$IFDEF TESTINSIGHT}
1114
TestInsight.DUnitX,
12-
{$ENDIF}
15+
{$ENDIF}
1316
DUnitX.Loggers.Console,
1417
DUnitX.Loggers.Xml.NUnit,
1518
DUnitX.StackTrace.Jcl,
1619
DUnitX.TestFramework,
1720
MethodCallBackTest in 'MethodCallBackTest.pas',
1821
VarPythTest in 'VarPythTest.pas',
1922
WrapDelphiTest in 'WrapDelphiTest.pas',
23+
WrapDelphiEventHandlerTest in 'WrapDelphiEventHandlerTest.pas',
2024
NumberServicesTest in 'NumberServicesTest.pas';
2125

2226
var

‎Tests/WrapDelphiEventHandlerTest.pas‎

Lines changed: 310 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,310 @@
1+
unit WrapDelphiEventHandlerTest;
2+
3+
interface
4+
5+
uses
6+
Types,
7+
DUnitX.TestFramework,
8+
PythonEngine,
9+
WrapDelphi, System.Classes;
10+
11+
type
12+
TTestGetObjectEvent = procedure(Sender: TObject; var AObject: TObject) of object;
13+
TTestGetValueEvent = procedure(Sender: TObject; var AValue: Double) of object;
14+
15+
TTest = class(TComponent)
16+
private
17+
FObject: TObject;
18+
FValue: Double;
19+
FOnGetObject: TTestGetObjectEvent;
20+
FOnGetValue: TTestGetValueEvent;
21+
22+
ProcessCalled: Boolean;
23+
24+
public
25+
procedure Process;
26+
27+
published
28+
property OnGetObject: TTestGetObjectEvent read FOnGetObject write FOnGetObject;
29+
property OnGetValue: TTestGetValueEvent read FOnGetValue write FOnGetValue;
30+
end;
31+
32+
33+
[TestFixture]
34+
TTestWrapDelphiEventHandlers = class(TObject)
35+
private
36+
PythonEngine: TPythonEngine;
37+
DelphiModule: TPythonModule;
38+
DelphiWrapper: TPyDelphiWrapper;
39+
40+
public
41+
[SetupFixture]
42+
procedure SetupFixture;
43+
44+
[TearDownFixture]
45+
procedure TearDownFixture;
46+
47+
[Test]
48+
procedure TestProcessWithValue;
49+
[Test]
50+
procedure TestProcessWithObject;
51+
end;
52+
53+
implementation
54+
55+
uses
56+
TypInfo;
57+
58+
type
59+
TTestRegistration = class(TRegisteredUnit)
60+
public
61+
function Name: string; override;
62+
procedure RegisterWrappers(APyDelphiWrapper: TPyDelphiWrapper); override;
63+
end;
64+
65+
TTestGetValueEventHandler = class(TEventHandler)
66+
protected
67+
procedure DoEvent(Sender: TObject; var Value: Double);
68+
public
69+
constructor Create(PyDelphiWrapper: TPyDelphiWrapper; Component: TObject;
70+
PropertyInfo: PPropInfo; Callable: PPyObject); override;
71+
class function GetTypeInfo: PTypeInfo; override;
72+
end;
73+
74+
TTestGetObjectEventHandler = class(TEventHandler)
75+
protected
76+
procedure DoEvent(Sender: TObject; var Obj: TObject);
77+
78+
public
79+
constructor Create(PyDelphiWrapper: TPyDelphiWrapper; Component: TObject;
80+
PropertyInfo: PPropInfo; Callable: PPyObject); override;
81+
class function GetTypeInfo: PTypeInfo; override;
82+
end;
83+
84+
85+
{ TTestRegistration }
86+
87+
function TTestRegistration.Name: string;
88+
begin
89+
Result := 'Test';
90+
end;
91+
92+
procedure TTestRegistration.RegisterWrappers(APyDelphiWrapper: TPyDelphiWrapper);
93+
begin
94+
inherited;
95+
APyDelphiWrapper.EventHandlers.RegisterHandler(TTestGetValueEventHandler);
96+
APyDelphiWrapper.EventHandlers.RegisterHandler(TTestGetObjectEventHandler);
97+
end;
98+
99+
100+
{ TTestGetValueEventHandler }
101+
102+
constructor TTestGetValueEventHandler.Create(PyDelphiWrapper: TPyDelphiWrapper; Component: TObject;
103+
PropertyInfo: PPropInfo; Callable: PPyObject);
104+
var
105+
Method: TMethod;
106+
begin
107+
inherited;
108+
Method.Code := @TTestGetValueEventHandler.DoEvent;
109+
Method.Data := Self;
110+
SetMethodProp(Component, PropertyInfo, Method);
111+
end;
112+
113+
procedure TTestGetValueEventHandler.DoEvent(Sender: TObject; var Value: Double);
114+
var
115+
PySender: PPyObject;
116+
PyValue: PPyObject;
117+
PyArgs: PPyObject;
118+
PyResult: PPyObject;
119+
PyValueVarParam: TPyDelphiVarParameter;
120+
begin
121+
if not Assigned(PyDelphiWrapper) or not Assigned(Callable) or not PythonOk then
122+
Exit;
123+
with PyDelphiWrapper.Engine do
124+
begin
125+
PySender := PyDelphiWrapper.Wrap(Sender);
126+
PyValue := CreateVarParam(PyDelphiWrapper, Value);
127+
PyValueVarParam := PythonToDelphi(PyValue) as TPyDelphiVarParameter;
128+
PyArgs := PyTuple_New(2);
129+
PyTuple_SetItem(PyArgs, 0, PySender);
130+
PyTuple_SetItem(PyArgs, 1, PyValue);
131+
try
132+
PyResult := PyObject_CallObject(Callable, PyArgs);
133+
if Assigned(PyResult) then
134+
begin
135+
Py_XDECREF(PyResult);
136+
Value := PyObjectAsVariant(PyValueVarParam.Value);
137+
end;
138+
finally
139+
Py_DECREF(PyArgs)
140+
end;
141+
CheckError;
142+
end;
143+
end;
144+
145+
class function TTestGetValueEventHandler.GetTypeInfo: PTypeInfo;
146+
begin
147+
Result := System.TypeInfo(TTestGetValueEvent);
148+
end;
149+
150+
151+
{ TTestGetObjectEventHandler }
152+
153+
constructor TTestGetObjectEventHandler.Create(PyDelphiWrapper: TPyDelphiWrapper; Component: TObject;
154+
PropertyInfo: PPropInfo; Callable: PPyObject);
155+
var
156+
Method: TMethod;
157+
begin
158+
inherited;
159+
Method.Code := @TTestGetObjectEventHandler.DoEvent;
160+
Method.Data := Self;
161+
SetMethodProp(Component, PropertyInfo, Method);
162+
end;
163+
164+
procedure TTestGetObjectEventHandler.DoEvent(Sender: TObject; var Obj: TObject);
165+
var
166+
PySender: PPyObject;
167+
PyObj: PPyObject;
168+
PyArgs: PPyObject;
169+
PyResult: PPyObject;
170+
PyObjVarParam: TPyDelphiVarParameter;
171+
begin
172+
if not Assigned(PyDelphiWrapper) or not Assigned(Callable) or not PythonOk then
173+
Exit;
174+
with PyDelphiWrapper.Engine do
175+
begin
176+
PySender := PyDelphiWrapper.Wrap(Sender);
177+
PyObj := CreateVarParam(PyDelphiWrapper, Obj);
178+
PyObjVarParam := PythonToDelphi(PyObj) as TPyDelphiVarParameter;
179+
PyArgs := PyTuple_New(2);
180+
PyTuple_SetItem(PyArgs, 0, PySender);
181+
PyTuple_SetItem(PyArgs, 1, PyObj);
182+
try
183+
PyResult := PyObject_CallObject(Callable, PyArgs);
184+
if Assigned(PyResult) then
185+
begin
186+
Py_XDECREF(PyResult);
187+
Obj := (PythonToDelphi(PyObjVarParam.Value) as TPyDelphiObject).DelphiObject;
188+
end;
189+
finally
190+
Py_DECREF(PyArgs)
191+
end;
192+
CheckError;
193+
end;
194+
end;
195+
196+
class function TTestGetObjectEventHandler.GetTypeInfo: PTypeInfo;
197+
begin
198+
Result := System.TypeInfo(TTestGetObjectEvent);
199+
end;
200+
201+
202+
{ TTest }
203+
204+
procedure TTest.Process;
205+
begin
206+
ProcessCalled := True;
207+
if Assigned(FOnGetObject) then
208+
FOnGetObject(Self, FObject);
209+
if Assigned(FOnGetValue) then
210+
FOnGetValue(Self, FValue);
211+
end;
212+
213+
214+
{ TTestWrapDelphiEventHandlers }
215+
216+
procedure TTestWrapDelphiEventHandlers.SetupFixture;
217+
begin
218+
PythonEngine := TPythonEngine.Create(nil);
219+
PythonEngine.Name := 'PythonEngine';
220+
PythonEngine.AutoLoad := False;
221+
PythonEngine.FatalAbort := True;
222+
PythonEngine.FatalMsgDlg := True;
223+
PythonEngine.UseLastKnownVersion := True;
224+
PythonEngine.AutoFinalize := True;
225+
PythonEngine.InitThreads := True;
226+
PythonEngine.PyFlags := [pfInteractive];
227+
DelphiModule := TPythonModule.Create(nil);
228+
229+
DelphiModule.Name := 'DelphiModule';
230+
DelphiModule.Engine := PythonEngine;
231+
DelphiModule.ModuleName := 'delphi';
232+
233+
DelphiWrapper := TPyDelphiWrapper.Create(nil);
234+
235+
DelphiWrapper.Name := 'PyDelphiWrapper';
236+
DelphiWrapper.Engine := PythonEngine;
237+
DelphiWrapper.Module := DelphiModule;
238+
239+
PythonEngine.LoadDll;
240+
end;
241+
242+
procedure TTestWrapDelphiEventHandlers.TearDownFixture;
243+
begin
244+
PythonEngine.Free;
245+
DelphiWrapper.Free;
246+
DelphiModule.Free;
247+
end;
248+
249+
procedure TTestWrapDelphiEventHandlers.TestProcessWithValue;
250+
var
251+
Test: TTest;
252+
pyTest: PPyObject;
253+
begin
254+
Test := TTest.Create(nil);
255+
try
256+
pyTest := DelphiWrapper.Wrap(Test);
257+
DelphiModule.SetVar('test', pyTest);
258+
PythonEngine.Py_DECREF(pyTest);
259+
PythonEngine.ExecString(
260+
'import delphi' + LF +
261+
'' + LF +
262+
'def MyOnGetValue(sender, value):' + LF +
263+
' value.Value = 3.14' + LF +
264+
'' + LF +
265+
'delphi.test.OnGetValue = MyOnGetValue' + LF +
266+
'delphi.test.Process()' + LF +
267+
''
268+
);
269+
Assert.IsTrue(Test.ProcessCalled);
270+
Assert.AreEqual(Test.FValue, 3.14);
271+
finally
272+
Test.Free;
273+
end;
274+
end;
275+
276+
277+
procedure TTestWrapDelphiEventHandlers.TestProcessWithObject;
278+
var
279+
Test: TTest;
280+
pyTest: PPyObject;
281+
begin
282+
Test := TTest.Create(nil);
283+
try
284+
pyTest := DelphiWrapper.Wrap(Test);
285+
DelphiModule.SetVar('test', pyTest);
286+
PythonEngine.Py_DECREF(pyTest);
287+
PythonEngine.ExecString(
288+
'import delphi' + LF +
289+
'' + LF +
290+
'def MyOnGetObject(sender, value):' + LF +
291+
' value.Value = sender' + LF +
292+
'' + LF +
293+
'delphi.test.OnGetObject = MyOnGetObject' + LF +
294+
'delphi.test.Process()' + LF +
295+
''
296+
);
297+
Assert.IsTrue(Test.ProcessCalled);
298+
Assert.AreSame(Test, Test.FObject);
299+
finally
300+
Test.Free;
301+
end;
302+
end;
303+
304+
initialization
305+
306+
RegisteredUnits.Add(TTestRegistration.Create);
307+
308+
TDUnitX.RegisterTestFixture(TTestWrapDelphiEventHandlers);
309+
310+
end.

0 commit comments

Comments
(0)

AltStyle によって変換されたページ (->オリジナル) /