Skip to content

Commit 94e247c

Browse files
committed
FMX TImageList wrapper
1 parent 5eafc3b commit 94e247c

File tree

2 files changed

+208
-1
lines changed

2 files changed

+208
-1
lines changed

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.

Source/fmx/WrapFMXImgList.pas

Lines changed: 206 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,206 @@
1+
{$I Definition.Inc}
2+
3+
unit WrapFMXImgList;
4+
5+
interface
6+
7+
uses
8+
System.Classes, System.SysUtils, FMX.ImgList,
9+
PythonEngine, WrapDelphi, WrapDelphiImageList;
10+
11+
type
12+
TPyDelphiCustomImageList = class (TPyDelphiBaseImageList)
13+
private
14+
function GetDelphiObject: TCustomImageList;
15+
procedure SetDelphiObject(const Value: TCustomImageList);
16+
protected
17+
function BitmapItemByName_Wrapper(AArgs: PPyObject): PPyObject; cdecl;
18+
function BestSize_Wrapper(AArgs: PPyObject): PPyObject; cdecl;
19+
public
20+
class function DelphiObjectClass : TClass; override;
21+
class procedure RegisterMethods(PythonType: TPythonType); override;
22+
// Properties
23+
property DelphiObject: TCustomImageList read GetDelphiObject write SetDelphiObject;
24+
end;
25+
26+
TPyDelphiImageList = class (TPyDelphiCustomImageList)
27+
private
28+
function GetDelphiObject: TImageList;
29+
procedure SetDelphiObject(const Value: TImageList);
30+
public
31+
class function DelphiObjectClass : TClass; override;
32+
// Properties
33+
property DelphiObject: TImageList read GetDelphiObject write SetDelphiObject;
34+
end;
35+
36+
implementation
37+
38+
uses
39+
System.Types,
40+
FMX.MultiResBitmap,
41+
WrapDelphiTypes,
42+
WrapFmxTypes;
43+
44+
{ Register the wrappers, the globals and the constants }
45+
type
46+
TFmxImageListRegistration = class(TRegisteredUnit)
47+
public
48+
function Name : string; override;
49+
procedure RegisterWrappers(APyDelphiWrapper : TPyDelphiWrapper); override;
50+
end;
51+
52+
{ TFmxImageListRegistration }
53+
54+
function TFmxImageListRegistration.Name: string;
55+
begin
56+
Result := 'FmxImageList';
57+
end;
58+
59+
procedure TFmxImageListRegistration.RegisterWrappers(
60+
APyDelphiWrapper: TPyDelphiWrapper);
61+
begin
62+
inherited;
63+
APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiCustomImageList);
64+
APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiImageList);
65+
end;
66+
67+
{ TPyDelphiCustomImageList }
68+
69+
function TPyDelphiCustomImageList.BestSize_Wrapper(AArgs: PPyObject): PPyObject;
70+
71+
procedure Append(const AList, AItem: PPyObject; const AIx: integer);
72+
begin
73+
with GetPythonEngine() do begin
74+
PyTuple_SetItem(AList, AIx, AItem);
75+
Py_XDecRef(AItem);
76+
end;
77+
end;
78+
79+
var
80+
LPyIndex: PPyObject;
81+
LPySize: PPyObject;
82+
LIndex: integer;
83+
LSize: TSize;
84+
LSizeF: TSizeF;
85+
begin
86+
//Signatures:
87+
//function BestSize(const Index: Integer; var Size: TSize): Boolean; overload;
88+
//function BestSize(const Index: Integer; var Size: TSizeF): Boolean; overload;
89+
90+
// We adjust the transmitted self argument
91+
Adjust(@Self);
92+
if GetPythonEngine().PyArg_ParseTuple(AArgs, 'iO:BestSize', @LPyIndex, @LPySize) <> 0 then begin
93+
if CheckIntAttribute(LPyIndex, 'Index', LIndex)
94+
and (CheckSizeAttribute(LPySize, 'Size', LSize)
95+
or
96+
(CheckSizeFAttribute(LPySize, 'Size', LSizeF))) then
97+
begin
98+
if not CheckIndex(LIndex, DelphiObject.Count) then
99+
Exit(nil);
100+
101+
Result := GetPythonEngine().PyTuple_New(2);
102+
103+
if CheckSizeAttribute(LPySize, 'Size', LSize) then begin
104+
Append(Result, GetPythonEngine().PyBool_FromLong(
105+
Ord(DelphiObject.BestSize(LIndex, LSize))), 0);
106+
Append(Result, WrapSize(PyDelphiWrapper, LSize), 1);
107+
end
108+
else
109+
if CheckSizeFAttribute(LPySize, 'Size', LSizeF) then begin
110+
Append(Result, GetPythonEngine().PyBool_FromLong(
111+
Ord(DelphiObject.BestSize(LIndex, LSizeF))), 0);
112+
Append(Result, WrapSizeF(PyDelphiWrapper, LSizeF), 1);
113+
end;
114+
end else
115+
Result := nil;
116+
end else
117+
Result := nil;
118+
end;
119+
120+
function TPyDelphiCustomImageList.BitmapItemByName_Wrapper(
121+
AArgs: PPyObject): PPyObject;
122+
123+
procedure Append(const AList, AItem: PPyObject; const AIx: integer);
124+
begin
125+
with GetPythonEngine() do begin
126+
PyTuple_SetItem(AList, AIx, AItem);
127+
Py_XDecRef(AItem);
128+
end;
129+
end;
130+
131+
var
132+
LPyName: PPyObject;
133+
LPyItem: PPyObject;
134+
LPySize: PPyObject;
135+
LName: string;
136+
LItem: TCustomBitmapItem;
137+
LSize: TSize;
138+
begin
139+
//Signature:
140+
//function BitmapItemByName(const Name: string; var Item: TCustomBitmapItem; var Size: TSize): Boolean;
141+
142+
// We adjust the transmitted self argument
143+
Adjust(@Self);
144+
if GetPythonEngine().PyArg_ParseTuple(AArgs, 'sOO:BitmapItemByName', @LPyName, @LPyItem, @LPySize) <> 0 then begin
145+
if CheckStrAttribute(LPyName, 'Name', LName)
146+
and CheckObjAttribute(LPyItem, 'Item', TCustomBitmapItem, TObject(LItem))
147+
and CheckSizeAttribute(LPySize, 'Size', LSize) then
148+
begin
149+
Result := GetPythonEngine().PyTuple_New(3);
150+
Append(Result, GetPythonEngine().PyBool_FromLong(
151+
Ord(DelphiObject.BitmapItemByName(LName, LItem, LSize))), 0);
152+
Append(Result, PyDelphiWrapper.Wrap(LItem), 1);
153+
Append(Result, WrapSize(PyDelphiWrapper, LSize), 2);
154+
end else
155+
Result := nil;
156+
end else
157+
Result := nil;
158+
end;
159+
160+
class function TPyDelphiCustomImageList.DelphiObjectClass: TClass;
161+
begin
162+
Result := TCustomImageList;
163+
end;
164+
165+
function TPyDelphiCustomImageList.GetDelphiObject: TCustomImageList;
166+
begin
167+
Result := TCustomImageList(inherited DelphiObject);
168+
end;
169+
170+
class procedure TPyDelphiCustomImageList.RegisterMethods(
171+
PythonType: TPythonType);
172+
begin
173+
inherited;
174+
PythonType.AddMethod('BitmapItemByName',
175+
@TPyDelphiCustomImageList.BitmapItemByName_Wrapper,
176+
'TCustomImageList.BitmapItemByName()'#10 +
177+
'Tries to find, in the source collection, the bitmap item specified by name.');
178+
end;
179+
180+
procedure TPyDelphiCustomImageList.SetDelphiObject(
181+
const Value: TCustomImageList);
182+
begin
183+
inherited DelphiObject := Value;
184+
end;
185+
186+
{ TPyDelphiImageList }
187+
188+
class function TPyDelphiImageList.DelphiObjectClass: TClass;
189+
begin
190+
Result := TImageList;
191+
end;
192+
193+
function TPyDelphiImageList.GetDelphiObject: TImageList;
194+
begin
195+
Result := TImageList(inherited DelphiObject);
196+
end;
197+
198+
procedure TPyDelphiImageList.SetDelphiObject(const Value: TImageList);
199+
begin
200+
inherited DelphiObject := Value;
201+
end;
202+
203+
initialization
204+
RegisteredUnits.Add(TFmxImageListRegistration.Create());
205+
206+
end.

0 commit comments

Comments
 (0)