Skip to content
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.

Commit a1ae2f4

Browse files
pyscripterpyscripter
committedOct 4, 2023
Partial backport from the Embarcadero fork.
1 parent fa65e38 commit a1ae2f4

33 files changed

+4123
-575
lines changed
 

‎Packages/Delphi/Delphi 10.4+/Python.dpk

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
package Python;
2+
23
{$R *.res}
34
{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
45
{$ALIGN 8}
@@ -48,6 +49,7 @@ contains
4849
WrapDelphiWindows in '..\..\..\Source\WrapDelphiWindows.pas',
4950
WrapFireDAC in '..\..\..\Source\WrapFireDAC.pas',
5051
WrapActions in '..\..\..\Source\WrapActions.pas',
51-
WrapDelphiDataBind in '..\..\..\Source\WrapDelphiDataBind.pas';
52+
WrapDelphiDataBind in '..\..\..\Source\WrapDelphiDataBind.pas',
53+
WrapDelphiImageList in '..\..\..\Source\WrapDelphiImageList.pas';
5254

5355
end.

‎Packages/Delphi/Delphi 10.4+/Python.dproj

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -177,6 +177,7 @@
177177
<DCCReference Include="..\..\..\Source\WrapFireDAC.pas"/>
178178
<DCCReference Include="..\..\..\Source\WrapActions.pas"/>
179179
<DCCReference Include="..\..\..\Source\WrapDelphiDataBind.pas"/>
180+
<DCCReference Include="..\..\..\Source\WrapDelphiImageList.pas"/>
180181
<BuildConfiguration Include="Base">
181182
<Key>Base</Key>
182183
</BuildConfiguration>

‎Packages/Delphi/Delphi 10.4+/PythonFmx.dpk

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -59,6 +59,7 @@ contains
5959
WrapFmxStdCtrls in '..\..\..\Source\fmx\WrapFmxStdCtrls.pas',
6060
WrapFmxStyles in '..\..\..\Source\fmx\WrapFmxStyles.pas',
6161
WrapFmxTypes in '..\..\..\Source\fmx\WrapFmxTypes.pas',
62-
WrapFmxDateTime in '..\..\..\Source\fmx\WrapFmxDateTime.pas';
62+
WrapFmxDateTime in '..\..\..\Source\fmx\WrapFmxDateTime.pas',
63+
WrapFmxImgList in '..\..\..\Source\fmx\WrapFmxImgList.pas';
6364

6465
end.

‎Packages/Delphi/Delphi 10.4+/PythonVcl.dpk

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -55,6 +55,7 @@ contains
5555
WrapVclStdCtrls in '..\..\..\Source\vcl\WrapVclStdCtrls.pas',
5656
WrapVclWinXCtrls in '..\..\..\Source\vcl\WrapVclWinXCtrls.pas',
5757
WrapVclThemes in '..\..\..\Source\vcl\WrapVclThemes.pas',
58-
WrapVclMedia in '..\..\..\Source\vcl\WrapVclMedia.pas';
58+
WrapVclMedia in '..\..\..\Source\vcl\WrapVclMedia.pas',
59+
WrapVclImgList in '..\..\..\Source\vcl\WrapVclImgList.pas';
5960

6061
end.

‎Packages/Delphi/Delphi 10.4+/PythonVcl.dproj

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -118,6 +118,7 @@
118118
<DCCReference Include="..\..\..\Source\vcl\WrapVclWinXCtrls.pas"/>
119119
<DCCReference Include="..\..\..\Source\vcl\WrapVclThemes.pas"/>
120120
<DCCReference Include="..\..\..\Source\vcl\WrapVclMedia.pas"/>
121+
<DCCReference Include="..\..\..\Source\vcl\WrapVclImgList.pas"/>
121122
<BuildConfiguration Include="Base">
122123
<Key>Base</Key>
123124
</BuildConfiguration>

‎Source/WrapDelphi.pas

Lines changed: 182 additions & 33 deletions
Large diffs are not rendered by default.

‎Source/WrapDelphiImageList.pas

Lines changed: 78 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,78 @@
1+
(**************************************************************************)
2+
(* This unit is part of the Python for Delphi (P4D) library *)
3+
(* Project home: https://github.com/pyscripter/python4delphi *)
4+
(* *)
5+
(* Project Maintainer: PyScripter (pyscripter@gmail.com) *)
6+
(* Original Authors: Dr. Dietmar Budelsky (dbudelsky@web.de) *)
7+
(* Morgan Martinet (https://github.com/mmm-experts) *)
8+
(* Core developer: Lucas Belo (lucas.belo@live.com) *)
9+
(* Contributors: See contributors.md at project home *)
10+
(* *)
11+
(* LICENCE and Copyright: MIT (see project home) *)
12+
(**************************************************************************)
13+
{$I Definition.Inc}
14+
15+
unit WrapDelphiImageList;
16+
17+
interface
18+
19+
uses
20+
System.Classes, System.SysUtils, System.ImageList,
21+
PythonEngine, WrapDelphi, WrapDelphiClasses;
22+
23+
type
24+
TPyDelphiBaseImageList = class (TPyDelphiComponent)
25+
private
26+
function GetDelphiObject: TBaseImageList;
27+
procedure SetDelphiObject(const Value: TBaseImageList);
28+
public
29+
class function DelphiObjectClass : TClass; override;
30+
// Properties
31+
property DelphiObject: TBaseImageList read GetDelphiObject write SetDelphiObject;
32+
end;
33+
34+
implementation
35+
36+
{ Register the wrappers, the globals and the constants }
37+
type
38+
TImageListRegistration = class(TRegisteredUnit)
39+
public
40+
function Name : string; override;
41+
procedure RegisterWrappers(APyDelphiWrapper : TPyDelphiWrapper); override;
42+
end;
43+
44+
{ TImageListRegistration }
45+
46+
function TImageListRegistration.Name: string;
47+
begin
48+
Result := 'ImageList';
49+
end;
50+
51+
procedure TImageListRegistration.RegisterWrappers(
52+
APyDelphiWrapper: TPyDelphiWrapper);
53+
begin
54+
inherited;
55+
APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiBaseImageList);
56+
end;
57+
58+
{ TPyDelphiBaseImageList }
59+
60+
class function TPyDelphiBaseImageList.DelphiObjectClass: TClass;
61+
begin
62+
Result := TBaseImageList;
63+
end;
64+
65+
function TPyDelphiBaseImageList.GetDelphiObject: TBaseImageList;
66+
begin
67+
Result := TBaseImageList(inherited DelphiObject);
68+
end;
69+
70+
procedure TPyDelphiBaseImageList.SetDelphiObject(const Value: TBaseImageList);
71+
begin
72+
inherited DelphiObject := Value;
73+
end;
74+
75+
initialization
76+
RegisteredUnits.Add(TImageListRegistration.Create());
77+
78+
end.

‎Source/fmx/WrapDelphiFmx.pas

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -28,6 +28,7 @@ implementation
2828
WrapFmxDataBind,
2929
{$ENDIF LINUX}
3030
WrapFmxTypes,
31+
WrapFmxImgList,
3132
WrapFmxControls,
3233
WrapFmxStdCtrls,
3334
WrapFmxEdit,

‎Source/fmx/WrapFmxActnList.pas

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@
1212
(**************************************************************************)
1313

1414
{$I ..\Definition.Inc}
15+
1516
unit WrapFmxActnList;
1617

1718
interface

‎Source/fmx/WrapFmxColors.pas

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,8 @@
1111
(* LICENCE and Copyright: MIT (see project home) *)
1212
(**************************************************************************)
1313

14+
{$I ..\Definition.Inc}
15+
1416
unit WrapFmxColors;
1517

1618
interface

‎Source/fmx/WrapFmxDataBind.pas

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,8 @@
1111
(* LICENCE and Copyright: MIT (see project home) *)
1212
(**************************************************************************)
1313

14+
{$I ..\Definition.Inc}
15+
1416
unit WrapFmxDataBind;
1517

1618
interface

‎Source/fmx/WrapFmxDateTime.pas

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,8 @@
1111
(* LICENCE and Copyright: MIT (see project home) *)
1212
(**************************************************************************)
1313

14+
{$I ..\Definition.Inc}
15+
1416
unit WrapFmxDateTime;
1517

1618
interface

‎Source/fmx/WrapFmxDialogs.pas

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,6 @@ interface
2121
FMX.Dialogs, FMX.DialogService,
2222
WrapDelphi, WrapFmxTypes, PythonEngine;
2323

24-
2524
type
2625
TPyDelphiOpenDialog = class(TPyDelphiFmxObject)
2726
private

‎Source/fmx/WrapFmxEdit.pas

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,6 @@ interface
2121
FMX.Edit, FMX.SearchBox, FMX.ComboEdit, FMX.EditBox, FMX.SpinBox, FMX.NumberBox,
2222
PythonEngine, WrapFmxTypes, WrapFmxControls;
2323

24-
2524
type
2625
TPyDelphiCustomEdit = class(TPyDelphiPresentedControl)
2726
private

‎Source/fmx/WrapFmxGrids.pas

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,8 @@
1111
(* LICENCE and Copyright: MIT (see project home) *)
1212
(**************************************************************************)
1313

14+
{$I ..\Definition.Inc}
15+
1416
unit WrapFmxGrids;
1517

1618
interface

‎Source/fmx/WrapFmxImgList.pas

Lines changed: 276 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,276 @@
1+
(**************************************************************************)
2+
(* This unit is part of the Python for Delphi (P4D) library *)
3+
(* Project home: https://github.com/pyscripter/python4delphi *)
4+
(* *)
5+
(* Project Maintainer: PyScripter (pyscripter@gmail.com) *)
6+
(* Original Authors: Dr. Dietmar Budelsky (dbudelsky@web.de) *)
7+
(* Morgan Martinet (https://github.com/mmm-experts) *)
8+
(* Core developer: Lucas Belo (lucas.belo@live.com) *)
9+
(* Contributors: See contributors.md at project home *)
10+
(* *)
11+
(* LICENCE and Copyright: MIT (see project home) *)
12+
(**************************************************************************)
13+
14+
{$I ..\Definition.Inc}
15+
16+
unit WrapFmxImgList;
17+
18+
interface
19+
20+
uses
21+
System.Classes, System.SysUtils, FMX.ImgList,
22+
PythonEngine, WrapDelphi, WrapDelphiImageList;
23+
24+
type
25+
TPyDelphiCustomImageList = class (TPyDelphiBaseImageList)
26+
private
27+
function GetDelphiObject: TCustomImageList;
28+
procedure SetDelphiObject(const Value: TCustomImageList);
29+
protected
30+
function BitmapItemByName_Wrapper(AArgs: PPyObject): PPyObject; cdecl;
31+
function BestSize_Wrapper(AArgs: PPyObject): PPyObject; cdecl;
32+
function AddOrSet_Wrapper(AArgs: PPyObject): PPyObject; cdecl;
33+
public
34+
class function DelphiObjectClass : TClass; override;
35+
class procedure RegisterMethods(PythonType: TPythonType); override;
36+
// Properties
37+
property DelphiObject: TCustomImageList read GetDelphiObject write SetDelphiObject;
38+
end;
39+
40+
TPyDelphiImageList = class (TPyDelphiCustomImageList)
41+
private
42+
function GetDelphiObject: TImageList;
43+
procedure SetDelphiObject(const Value: TImageList);
44+
public
45+
class function DelphiObjectClass : TClass; override;
46+
// Properties
47+
property DelphiObject: TImageList read GetDelphiObject write SetDelphiObject;
48+
end;
49+
50+
implementation
51+
52+
uses
53+
System.Types,
54+
FMX.MultiResBitmap,
55+
WrapDelphiTypes,
56+
WrapFmxTypes, System.UITypes;
57+
58+
{ Register the wrappers, the globals and the constants }
59+
type
60+
TFmxImageListRegistration = class(TRegisteredUnit)
61+
public
62+
function Name : string; override;
63+
procedure RegisterWrappers(APyDelphiWrapper : TPyDelphiWrapper); override;
64+
end;
65+
66+
{ TFmxImageListRegistration }
67+
68+
function TFmxImageListRegistration.Name: string;
69+
begin
70+
Result := 'FmxImageList';
71+
end;
72+
73+
procedure TFmxImageListRegistration.RegisterWrappers(
74+
APyDelphiWrapper: TPyDelphiWrapper);
75+
begin
76+
inherited;
77+
APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiCustomImageList);
78+
APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiImageList);
79+
end;
80+
81+
{ TPyDelphiCustomImageList }
82+
83+
function TPyDelphiCustomImageList.AddOrSet_Wrapper(AArgs: PPyObject): PPyObject;
84+
var
85+
LPySourceName: PPyObject;
86+
LPyScales: PPyObject;
87+
LPyFileNames: PPyObject;
88+
89+
LSourceName: string;
90+
LScales: array of single;
91+
LFileNames: array of string;
92+
LTransparentColor: integer;
93+
LWidth: integer;
94+
LHeight: integer;
95+
I: integer;
96+
begin
97+
Adjust(@Self);
98+
LTransparentColor := TColors.SysNone;
99+
LWidth := 0;
100+
LHeight := 0;
101+
if GetPythonEngine().PyArg_ParseTuple(AArgs, 'OOO|iii:AddOrSet',
102+
@LPySourceName, @LPyScales, @LPyFileNames, @LTransparentColor, @LWidth, @LHeight) <> 0 then
103+
begin
104+
if not CheckStrAttribute(LPySourceName, 'SourceName', LSourceName) then
105+
Exit(nil);
106+
107+
if not GetPythonEngine().PyList_Check(LPyScales) then
108+
Exit(nil);
109+
110+
if not GetPythonEngine().PyList_Check(LPyFileNames) then
111+
Exit(nil);
112+
113+
SetLength(LScales, PythonType.Engine.PyList_Size(LPyScales));
114+
for I := 0 to GetPythonEngine().PyList_Size(LPyScales) - 1 do
115+
LScales[I] := GetPythonEngine().PyFloat_AsDouble(
116+
GetPythonEngine().PyList_GetItem(LPyScales, I));
117+
118+
SetLength(LFileNames, PythonType.Engine.PyList_Size(LPyFileNames));
119+
for I := 0 to GetPythonEngine().PyList_Size(LPyFileNames) - 1 do
120+
LFileNames[I] := GetPythonEngine.PyUnicodeAsString(
121+
GetPythonEngine().PyList_GetItem(LPyFileNames, I));
122+
123+
Result := GetPythonEngine().PyLong_FromLong(
124+
DelphiObject.AddOrSet(LSourceName, LScales, LFileNames, LTransparentColor, LWidth, LHeight));
125+
end else
126+
Result := nil;
127+
end;
128+
129+
function TPyDelphiCustomImageList.BestSize_Wrapper(AArgs: PPyObject): PPyObject;
130+
131+
procedure Append(const AList, AItem: PPyObject; const AIx: integer);
132+
begin
133+
with GetPythonEngine() do begin
134+
PyTuple_SetItem(AList, AIx, AItem);
135+
Py_XDecRef(AItem);
136+
end;
137+
end;
138+
139+
var
140+
LPySize: PPyObject;
141+
LIndex: integer;
142+
LSize: TSize;
143+
LSizeF: TSizeF;
144+
begin
145+
//Signatures:
146+
//function BestSize(const Index: Integer; var Size: TSize): Boolean; overload;
147+
//function BestSize(const Index: Integer; var Size: TSizeF): Boolean; overload;
148+
149+
// We adjust the transmitted self argument
150+
Adjust(@Self);
151+
if GetPythonEngine().PyArg_ParseTuple(AArgs, 'iO:BestSize', @LIndex, @LPySize) <> 0 then begin
152+
if (CheckSizeAttribute(LPySize, 'Size', LSize) or
153+
(CheckSizeFAttribute(LPySize, 'Size', LSizeF))) then
154+
begin
155+
if not CheckIndex(LIndex, DelphiObject.Count) then
156+
Exit(nil);
157+
158+
Result := GetPythonEngine().PyTuple_New(2);
159+
160+
if CheckSizeAttribute(LPySize, 'Size', LSize) then begin
161+
Append(Result, GetPythonEngine().PyBool_FromLong(
162+
Ord(DelphiObject.BestSize(LIndex, LSize))), 0);
163+
Append(Result, WrapSize(PyDelphiWrapper, LSize), 1);
164+
end
165+
else
166+
if CheckSizeFAttribute(LPySize, 'Size', LSizeF) then begin
167+
Append(Result, GetPythonEngine().PyBool_FromLong(
168+
Ord(DelphiObject.BestSize(LIndex, LSizeF))), 0);
169+
Append(Result, WrapSizeF(PyDelphiWrapper, LSizeF), 1);
170+
end;
171+
end else
172+
Result := nil;
173+
end else
174+
Result := nil;
175+
end;
176+
177+
function TPyDelphiCustomImageList.BitmapItemByName_Wrapper(
178+
AArgs: PPyObject): PPyObject;
179+
180+
procedure Append(const AList, AItem: PPyObject; const AIx: integer);
181+
begin
182+
with GetPythonEngine() do begin
183+
PyTuple_SetItem(AList, AIx, AItem);
184+
Py_XDecRef(AItem);
185+
end;
186+
end;
187+
188+
var
189+
LPyName: PPyObject;
190+
LPyItem: PPyObject;
191+
LPySize: PPyObject;
192+
LName: string;
193+
LItem: TCustomBitmapItem;
194+
LSize: TSize;
195+
begin
196+
//Signature:
197+
//function BitmapItemByName(const Name: string; var Item: TCustomBitmapItem; var Size: TSize): Boolean;
198+
199+
// We adjust the transmitted self argument
200+
Adjust(@Self);
201+
if GetPythonEngine().PyArg_ParseTuple(AArgs, 'OOO:BitmapItemByName', @LPyName, @LPyItem, @LPySize) <> 0 then begin
202+
if CheckStrAttribute(LPyName, 'Name', LName)
203+
and CheckObjAttribute(LPyItem, 'Item', TCustomBitmapItem, TObject(LItem))
204+
and CheckSizeAttribute(LPySize, 'Size', LSize) then
205+
begin
206+
Result := GetPythonEngine().PyTuple_New(3);
207+
Append(Result, GetPythonEngine().PyBool_FromLong(
208+
Ord(DelphiObject.BitmapItemByName(LName, LItem, LSize))), 0);
209+
Append(Result, PyDelphiWrapper.Wrap(LItem), 1);
210+
Append(Result, WrapSize(PyDelphiWrapper, LSize), 2);
211+
end else
212+
Result := nil;
213+
end else
214+
Result := nil;
215+
end;
216+
217+
class function TPyDelphiCustomImageList.DelphiObjectClass: TClass;
218+
begin
219+
Result := TCustomImageList;
220+
end;
221+
222+
function TPyDelphiCustomImageList.GetDelphiObject: TCustomImageList;
223+
begin
224+
Result := TCustomImageList(inherited DelphiObject);
225+
end;
226+
227+
class procedure TPyDelphiCustomImageList.RegisterMethods(
228+
PythonType: TPythonType);
229+
begin
230+
inherited;
231+
PythonType.AddMethod('BitmapItemByName',
232+
@TPyDelphiCustomImageList.BitmapItemByName_Wrapper,
233+
'TCustomImageList.BitmapItemByName()'#10 +
234+
'Tries to find, in the source collection, the bitmap item specified by name.');
235+
236+
PythonType.AddMethod('BestSize',
237+
@TPyDelphiCustomImageList.BestSize_Wrapper,
238+
'TCustomImageList.BestSize()'#10 +
239+
'Tries to find, in the source collection, the bitmap item specified by name. ' +
240+
'This method trying to determine the maximum size of layer, which less than input size. '+
241+
'If TLayer.MultiResBitmap has multiple images for different scales, then the search is performed among all images.');
242+
243+
PythonType.AddMethod('AddOrSet',
244+
@TPyDelphiCustomImageList.AddOrSet_Wrapper,
245+
'TCustomImageList.AddOrSet()'#10 +
246+
'Adds or replaces several files in the source collection, ' +
247+
'and adds the item to the destination collection if it does not exist.');
248+
end;
249+
250+
procedure TPyDelphiCustomImageList.SetDelphiObject(
251+
const Value: TCustomImageList);
252+
begin
253+
inherited DelphiObject := Value;
254+
end;
255+
256+
{ TPyDelphiImageList }
257+
258+
class function TPyDelphiImageList.DelphiObjectClass: TClass;
259+
begin
260+
Result := TImageList;
261+
end;
262+
263+
function TPyDelphiImageList.GetDelphiObject: TImageList;
264+
begin
265+
Result := TImageList(inherited DelphiObject);
266+
end;
267+
268+
procedure TPyDelphiImageList.SetDelphiObject(const Value: TImageList);
269+
begin
270+
inherited DelphiObject := Value;
271+
end;
272+
273+
initialization
274+
RegisteredUnits.Add(TFmxImageListRegistration.Create());
275+
276+
end.

‎Source/fmx/WrapFmxListView.pas

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,8 @@
1111
(* LICENCE and Copyright: MIT (see project home) *)
1212
(**************************************************************************)
1313

14+
{$I ..\Definition.Inc}
15+
1416
unit WrapFmxListView;
1517

1618
interface

‎Source/fmx/WrapFmxMedia.pas

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@
1212
(**************************************************************************)
1313

1414
{$I ..\Definition.Inc}
15+
1516
unit WrapFmxMedia;
1617

1718
interface

‎Source/fmx/WrapFmxMemo.pas

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,8 @@
1111
(* LICENCE and Copyright: MIT (see project home) *)
1212
(**************************************************************************)
1313

14+
{$I ..\Definition.Inc}
15+
1416
unit WrapFmxMemo;
1517

1618
interface

‎Source/fmx/WrapFmxScrollBox.pas

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,8 @@
1111
(* LICENCE and Copyright: MIT (see project home) *)
1212
(**************************************************************************)
1313

14+
{$I ..\Definition.Inc}
15+
1416
unit WrapFmxScrollBox;
1517

1618
interface

‎Source/fmx/WrapFmxStdActns.pas

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@
1212
(**************************************************************************)
1313

1414
{$I ..\Definition.Inc}
15+
1516
unit WrapFmxStdActns;
1617

1718
interface

‎Source/fmx/WrapFmxStyles.pas

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@
1212
(**************************************************************************)
1313

1414
{$I ..\Definition.Inc}
15+
1516
unit WrapFmxStyles;
1617

1718
interface

‎Source/fmx/WrapFmxTypes.pas

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@
1212
(**************************************************************************)
1313

1414
{$I ..\Definition.Inc}
15+
1516
unit WrapFmxTypes;
1617

1718
interface

‎Source/vcl/WrapDelphiVCL.pas

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -28,6 +28,7 @@ implementation
2828
WrapDelphiWindows,
2929
WrapDelphiDataBind,
3030
WrapActions,
31+
WrapVclImgList,
3132
WrapVclControls,
3233
WrapVclGraphics,
3334
WrapVclForms,

‎Source/vcl/WrapVclComCtrls.pas

Lines changed: 3276 additions & 532 deletions
Large diffs are not rendered by default.

‎Source/vcl/WrapVclControls.pas

Lines changed: 175 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,8 @@ interface
2525
Vcl.Controls,
2626
PythonEngine,
2727
WrapDelphi,
28-
WrapDelphiClasses;
28+
WrapDelphiClasses,
29+
WrapVclImgList;
2930

3031
type
3132
{
@@ -137,6 +138,45 @@ TPyDelphiCustomControl = class (TPyDelphiControl)
137138
property DelphiObject: TCustomControl read GetDelphiObject write SetDelphiObject;
138139
end;
139140

141+
TPyDelphiCustomListControl = class (TPyDelphiWinControl)
142+
private
143+
function GetDelphiObject: TCustomListControl;
144+
procedure SetDelphiObject(const Value: TCustomListControl);
145+
protected
146+
public
147+
class function DelphiObjectClass : TClass; override;
148+
property DelphiObject: TCustomListControl read GetDelphiObject write SetDelphiObject;
149+
end;
150+
151+
TPyDelphiCustomMultiListControl = class (TPyDelphiCustomListControl)
152+
private
153+
function GetDelphiObject: TCustomMultiSelectListControl;
154+
procedure SetDelphiObject(const Value: TCustomMultiSelectListControl);
155+
protected
156+
public
157+
class function DelphiObjectClass : TClass; override;
158+
property DelphiObject: TCustomMultiSelectListControl read GetDelphiObject write SetDelphiObject;
159+
end;
160+
161+
TPyDelphiDragImageList = class (TPyDelphiCustomImageList)
162+
private
163+
function GetDelphiObject: TDragImageList;
164+
procedure SetDelphiObject(const Value: TDragImageList);
165+
public
166+
class function DelphiObjectClass : TClass; override;
167+
// Properties
168+
property DelphiObject: TDragImageList read GetDelphiObject write SetDelphiObject;
169+
end;
170+
171+
TPyDelphiImageList = class (TPyDelphiDragImageList)
172+
private
173+
function GetDelphiObject: TImageList;
174+
procedure SetDelphiObject(const Value: TImageList);
175+
public
176+
class function DelphiObjectClass : TClass; override;
177+
// Properties
178+
property DelphiObject: TImageList read GetDelphiObject write SetDelphiObject;
179+
end;
140180

141181
{ TKeyPressEvent wrapper }
142182
TKeyPressEventHandler = class(TEventHandler)
@@ -178,6 +218,15 @@ TMouseMoveEventHandler = class(TEventHandler)
178218
class function GetTypeInfo : PTypeInfo; override;
179219
end;
180220

221+
TContextPopupEventHandler = class(TEventHandler)
222+
protected
223+
procedure DoEvent(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
224+
public
225+
constructor Create(PyDelphiWrapper : TPyDelphiWrapper; Component : TObject;
226+
PropertyInfo : PPropInfo; Callable : PPyObject); override;
227+
class function GetTypeInfo : PTypeInfo; override;
228+
end;
229+
181230
implementation
182231

183232
uses
@@ -222,12 +271,18 @@ procedure TControlsRegistration.RegisterWrappers(APyDelphiWrapper: TPyDelphiWrap
222271
APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiControl);
223272
APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiWinControl);
224273
APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiCustomControl);
274+
APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiCustomListControl);
275+
APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiCustomMultiListControl);
276+
APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiDragImageList);
277+
APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiImageList);
225278

226279
APyDelphiWrapper.EventHandlers.RegisterHandler(TKeyPressEventHandler);
227280
APyDelphiWrapper.EventHandlers.RegisterHandler(TKeyEventHandler);
228281

229282
APyDelphiWrapper.EventHandlers.RegisterHandler(TMouseEventHandler);
230283
APyDelphiWrapper.EventHandlers.RegisterHandler(TMouseMoveEventHandler);
284+
285+
APyDelphiWrapper.EventHandlers.RegisterHandler(TContextPopupEventHandler);
231286
end;
232287

233288
{ TPyDelphiControl }
@@ -880,6 +935,125 @@ class function TMouseMoveEventHandler.GetTypeInfo: PTypeInfo;
880935
Result := System.TypeInfo(TMouseMoveEvent);
881936
end;
882937

938+
{ TPyDelphiCustomListControl }
939+
940+
class function TPyDelphiCustomListControl.DelphiObjectClass: TClass;
941+
begin
942+
Result := TCustomListControl;
943+
end;
944+
945+
function TPyDelphiCustomListControl.GetDelphiObject: TCustomListControl;
946+
begin
947+
Result := TCustomListControl(inherited DelphiObject);
948+
end;
949+
950+
procedure TPyDelphiCustomListControl.SetDelphiObject(
951+
const Value: TCustomListControl);
952+
begin
953+
inherited DelphiObject := Value;
954+
end;
955+
956+
{ TPyDelphiCustomMultiListControl }
957+
958+
class function TPyDelphiCustomMultiListControl.DelphiObjectClass: TClass;
959+
begin
960+
Result := TCustomMultiSelectListControl;
961+
end;
962+
963+
function TPyDelphiCustomMultiListControl.GetDelphiObject: TCustomMultiSelectListControl;
964+
begin
965+
Result := TCustomMultiSelectListControl(inherited DelphiObject);
966+
end;
967+
968+
procedure TPyDelphiCustomMultiListControl.SetDelphiObject(
969+
const Value: TCustomMultiSelectListControl);
970+
begin
971+
inherited DelphiObject := Value;
972+
end;
973+
974+
{ TContextPopupEventHandler }
975+
976+
constructor TContextPopupEventHandler.Create(PyDelphiWrapper: TPyDelphiWrapper;
977+
Component: TObject; PropertyInfo: PPropInfo; Callable: PPyObject);
978+
var
979+
LMethod : TMethod;
980+
begin
981+
inherited;
982+
LMethod.Code := @TContextPopupEventHandler.DoEvent;
983+
LMethod.Data := Self;
984+
SetMethodProp(Component, PropertyInfo, LMethod);
985+
end;
986+
987+
class function TContextPopupEventHandler.GetTypeInfo: PTypeInfo;
988+
begin
989+
Result := System.TypeInfo(TContextPopupEvent);
990+
end;
991+
992+
993+
procedure TContextPopupEventHandler.DoEvent(Sender: TObject; MousePos: TPoint;
994+
var Handled: Boolean);
995+
var
996+
LPyObject, LPyMousePos, LPyTuple, LPyResult, LPyHandled: PPyObject;
997+
LVarParam: TPyDelphiVarParameter;
998+
begin
999+
Assert(Assigned(PyDelphiWrapper));
1000+
if Assigned(Callable) and PythonOK() then
1001+
with GetPythonEngine() do begin
1002+
LPyObject := PyDelphiWrapper.Wrap(Sender);
1003+
LPyMousePos := WrapPoint(PyDelphiWrapper, MousePos);
1004+
LPyHandled := CreateVarParam(PyDelphiWrapper, Handled);
1005+
LVarParam := PythonToDelphi(LPyHandled) as TPyDelphiVarParameter;
1006+
LPyTuple := PyTuple_New(3);
1007+
PyTuple_SetItem(LPyTuple, 0, LPyObject);
1008+
PyTuple_SetItem(LPyTuple, 1, LPyMousePos);
1009+
PyTuple_SetItem(LPyTuple, 2, LPyHandled);
1010+
try
1011+
LPyResult := PyObject_CallObject(Callable, LPyTuple);
1012+
if Assigned(LPyResult) then begin
1013+
Py_DECREF(LPyResult);
1014+
Handled := PyObject_IsTrue(LVarParam.Value) = 1;
1015+
end;
1016+
finally
1017+
Py_DECREF(LPyTuple);
1018+
end;
1019+
CheckError();
1020+
end;
1021+
end;
1022+
1023+
{ TPyDelphiDragImageList }
1024+
1025+
class function TPyDelphiDragImageList.DelphiObjectClass: TClass;
1026+
begin
1027+
Result := TDragImageList;
1028+
end;
1029+
1030+
function TPyDelphiDragImageList.GetDelphiObject: TDragImageList;
1031+
begin
1032+
Result := TDragImageList(inherited DelphiObject);
1033+
end;
1034+
1035+
procedure TPyDelphiDragImageList.SetDelphiObject(const Value: TDragImageList);
1036+
begin
1037+
inherited DelphiObject := Value;
1038+
end;
1039+
1040+
{ TPyDelphiImageList }
1041+
1042+
class function TPyDelphiImageList.DelphiObjectClass: TClass;
1043+
begin
1044+
Result := TImageList;
1045+
end;
1046+
1047+
function TPyDelphiImageList.GetDelphiObject: TImageList;
1048+
begin
1049+
Result := TImageList(inherited DelphiObject);
1050+
end;
1051+
1052+
procedure TPyDelphiImageList.SetDelphiObject(const Value: TImageList);
1053+
begin
1054+
inherited DelphiObject := Value;
1055+
end;
1056+
8831057
initialization
8841058
RegisteredUnits.Add(TControlsRegistration.Create);
8851059
end.

‎Source/vcl/WrapVclDialogs.pas

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -77,13 +77,13 @@ implementation
7777
{ Global Functions }
7878
function ShowMessage_Wrapper(pself, args: PPyObject): PPyObject; cdecl;
7979
var
80-
LMsg: PAnsiChar;
80+
LPyMsg: PPyObject;
8181
begin
8282
with GetPythonEngine do
8383
begin
84-
if PyArg_ParseTuple(args, 's:ShowMessage', @LMsg) <> 0 then
84+
if PyArg_ParseTuple(args, 'O:ShowMessage', @LPyMsg) <> 0 then
8585
begin
86-
ShowMessage(string(LMsg));
86+
ShowMessage(PyObjectAsString(LPyMsg));
8787
Result := GetPythonEngine.ReturnNone;
8888
end else
8989
Result := nil;

‎Source/vcl/WrapVclForms.pas

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1414,7 +1414,7 @@ class procedure TPyDelphiMonitor.RegisterGetSets(PythonType: TPythonType);
14141414
AddGetSet('Handle', @TPyDelphiMonitor.Get_Handle, nil,
14151415
'Indicates the Windows handle for the monitor.', nil);
14161416
AddGetSet('MonitorNum', @TPyDelphiMonitor.Get_MonitorNum, nil,
1417-
'Specifies the index of the monitor in the global screen object’s Monitors list.', nil);
1417+
'Specifies the index of the monitor in the global screen object''s Monitors list.', nil);
14181418
AddGetSet('Left', @TPyDelphiMonitor.Get_Left, nil,
14191419
'Indicates the logical position of the left edge of the monitor.', nil);
14201420
AddGetSet('Height', @TPyDelphiMonitor.Get_Height, nil,

‎Source/vcl/WrapVclGraphics.pas

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -51,6 +51,8 @@ TPyDelphiGraphic = class(TPyDelphiPersistent)
5151
function Set_Transparent( AValue : PPyObject; AContext : Pointer) : integer; cdecl;
5252
function Set_Width( AValue : PPyObject; AContext : Pointer) : integer; cdecl;
5353
public
54+
constructor CreateWith(APythonType: TPythonType; args: PPyObject); override;
55+
5456
class function DelphiObjectClass : TClass; override;
5557
class procedure RegisterGetSets( PythonType : TPythonType ); override;
5658
class procedure RegisterMethods( PythonType : TPythonType ); override;
@@ -101,6 +103,8 @@ TPyDelphiBitmap = class(TPyDelphiGraphic)
101103
function Set_TransparentColor( AValue : PPyObject; AContext : Pointer) : Integer; cdecl;
102104
function Set_TransparentMode( AValue : PPyObject; AContext : Pointer) : Integer; cdecl;
103105
public
106+
constructor CreateWith(APythonType: TPythonType; args: PPyObject); override;
107+
104108
class function DelphiObjectClass : TClass; override;
105109
class procedure RegisterGetSets( PythonType : TPythonType ); override;
106110
class procedure RegisterMethods( PythonType : TPythonType ); override;
@@ -375,6 +379,13 @@ procedure TGraphicsRegistration.RegisterWrappers(APyDelphiWrapper: TPyDelphiWrap
375379

376380
{ TPyDelphiGraphic }
377381

382+
constructor TPyDelphiGraphic.CreateWith(APythonType: TPythonType;
383+
args: PPyObject);
384+
begin
385+
inherited;
386+
DelphiObject := TGraphicClass(DelphiObjectClass()).Create();
387+
end;
388+
378389
class function TPyDelphiGraphic.DelphiObjectClass: TClass;
379390
begin
380391
Result := TGraphic;
@@ -708,6 +719,16 @@ function TPyDelphiGraphic.Set_Width(AValue: PPyObject;
708719

709720
{ TPyDelphiBitmap }
710721

722+
constructor TPyDelphiBitmap.CreateWith(APythonType: TPythonType;
723+
args: PPyObject);
724+
var
725+
LWidth, LHeight : Integer;
726+
begin
727+
inherited;
728+
if APythonType.Engine.PyArg_ParseTuple(args, 'ii:Create', @LWidth, @LHeight) <> 0 then
729+
DelphiObject.SetSize(LWidth, LHeight);
730+
end;
731+
711732
class function TPyDelphiBitmap.DelphiObjectClass: TClass;
712733
begin
713734
Result := TBitmap;

‎Source/vcl/WrapVclImgList.pas

Lines changed: 78 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,78 @@
1+
(**************************************************************************)
2+
(* This unit is part of the Python for Delphi (P4D) library *)
3+
(* Project home: https://github.com/pyscripter/python4delphi *)
4+
(* *)
5+
(* Project Maintainer: PyScripter (pyscripter@gmail.com) *)
6+
(* Original Authors: Dr. Dietmar Budelsky (dbudelsky@web.de) *)
7+
(* Morgan Martinet (https://github.com/mmm-experts) *)
8+
(* Core developer: Lucas Belo (lucas.belo@live.com) *)
9+
(* Contributors: See contributors.md at project home *)
10+
(* *)
11+
(* LICENCE and Copyright: MIT (see project home) *)
12+
(**************************************************************************)
13+
{$I ..\Definition.Inc}
14+
15+
unit WrapVclImgList;
16+
17+
interface
18+
19+
uses
20+
System.Classes, System.SysUtils, Vcl.ImgList,
21+
PythonEngine, WrapDelphi, WrapDelphiImageList;
22+
23+
type
24+
TPyDelphiCustomImageList = class (TPyDelphiBaseImageList)
25+
private
26+
function GetDelphiObject: TCustomImageList;
27+
procedure SetDelphiObject(const Value: TCustomImageList);
28+
public
29+
class function DelphiObjectClass : TClass; override;
30+
// Properties
31+
property DelphiObject: TCustomImageList read GetDelphiObject write SetDelphiObject;
32+
end;
33+
34+
implementation
35+
36+
{ Register the wrappers, the globals and the constants }
37+
type
38+
TVclImageListRegistration = class(TRegisteredUnit)
39+
public
40+
function Name : string; override;
41+
procedure RegisterWrappers(APyDelphiWrapper : TPyDelphiWrapper); override;
42+
end;
43+
44+
{ TVclImageListRegistration }
45+
46+
function TVclImageListRegistration.Name: string;
47+
begin
48+
Result := 'VclImageList';
49+
end;
50+
51+
procedure TVclImageListRegistration.RegisterWrappers(
52+
APyDelphiWrapper: TPyDelphiWrapper);
53+
begin
54+
inherited;
55+
APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiCustomImageList);
56+
end;
57+
58+
{ TPyDelphiCustomImageList }
59+
60+
class function TPyDelphiCustomImageList.DelphiObjectClass: TClass;
61+
begin
62+
Result := TCustomImageList;
63+
end;
64+
65+
function TPyDelphiCustomImageList.GetDelphiObject: TCustomImageList;
66+
begin
67+
Result := TCustomImageList(inherited DelphiObject);
68+
end;
69+
70+
procedure TPyDelphiCustomImageList.SetDelphiObject(const Value: TCustomImageList);
71+
begin
72+
inherited DelphiObject := Value;
73+
end;
74+
75+
initialization
76+
RegisteredUnits.Add(TVclImageListRegistration.Create());
77+
78+
end.

‎Source/vcl/WrapVclMedia.pas

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@
1212
(**************************************************************************)
1313

1414
{$I ..\Definition.Inc}
15+
1516
unit WrapVclMedia;
1617

1718
interface

‎Source/vcl/WrapVclThemes.pas

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@
1212
(**************************************************************************)
1313

1414
{$I ..\Definition.Inc}
15+
1516
unit WrapVclThemes;
1617

1718
interface

‎Source/vcl/WrapVclWinXCtrls.pas

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@
1212
(**************************************************************************)
1313

1414
{$I ..\Definition.Inc}
15+
1516
unit WrapVclWinXCtrls;
1617

1718
interface

0 commit comments

Comments
 (0)
Please sign in to comment.