From c7b3aa701fbb23760ddd26ea7ef0cfa8660d31eb Mon Sep 17 00:00:00 2001 From: Lucas Moura Belo Date: Wed, 16 Dec 2020 10:02:36 -0300 Subject: [PATCH 01/14] Giving access to the position property of a control --- Source/fmx/WrapFmxControls.pas | 25 +++++++ Source/fmx/WrapFmxTypes.pas | 118 +++++++++++++++++++++++++++++++++ 2 files changed, 143 insertions(+) diff --git a/Source/fmx/WrapFmxControls.pas b/Source/fmx/WrapFmxControls.pas index fcc70861..e3853c5c 100644 --- a/Source/fmx/WrapFmxControls.pas +++ b/Source/fmx/WrapFmxControls.pas @@ -37,8 +37,10 @@ TPyDelphiControl = class (TPyDelphiFmxObject) function Get_Controls(AContext: Pointer): PPyObject; cdecl; function Get_IsFocused( AContext : Pointer) : PPyObject; cdecl; function Get_ParentControl( AContext : Pointer) : PPyObject; cdecl; + function Get_Position(AContext: Pointer): PPyObject; cdecl; // Property Setters function Set_Visible(AValue: PPyObject; AContext: Pointer): integer; cdecl; + function Set_Position(AValue: PPyObject; AContext: Pointer): integer; cdecl; public class function DelphiObjectClass : TClass; override; class procedure RegisterGetSets( PythonType : TPythonType ); override; @@ -161,6 +163,12 @@ function TPyDelphiControl.Get_ParentControl(AContext: Pointer): PPyObject; Result := Wrap(DelphiObject.ParentControl); end; +function TPyDelphiControl.Get_Position(AContext: Pointer): PPyObject; +begin + Adjust(@Self); + Result := Wrap(DelphiObject.Position); +end; + function TPyDelphiControl.Get_Visible(AContext: Pointer): PPyObject; begin Adjust(@Self); @@ -178,6 +186,8 @@ class procedure TPyDelphiControl.RegisterGetSets(PythonType: TPythonType); 'Returns an iterator over contained controls', nil); PythonType.AddGetSet('IsFocused', @TPyDelphiControl.Get_IsFocused, nil, 'Determines whether the control has input focus.', nil); + PythonType.AddGetSet('Position', @TPyDelphiControl.Get_Position, @TPyDelphiControl.Set_Position, + 'Returns an access to the position of the control inside its parent', nil); end; class procedure TPyDelphiControl.RegisterMethods(PythonType: TPythonType); @@ -304,6 +314,21 @@ function TPyDelphiControl.SetFocus_Wrapper(args: PPyObject): PPyObject; end; end; +function TPyDelphiControl.Set_Position(AValue: PPyObject; + AContext: Pointer): integer; +var + LValue: TObject; +begin + Adjust(@Self); + if CheckObjAttribute(AValue, 'Position', TPosition, LValue) then + begin + DelphiObject.Position := TPosition(LValue); + Result := 0; + end + else + Result := -1; +end; + function TPyDelphiControl.Set_Visible(AValue: PPyObject; AContext: Pointer): integer; var diff --git a/Source/fmx/WrapFmxTypes.pas b/Source/fmx/WrapFmxTypes.pas index 3d9ddf50..e54d14fe 100644 --- a/Source/fmx/WrapFmxTypes.pas +++ b/Source/fmx/WrapFmxTypes.pas @@ -51,6 +51,27 @@ TPyDelphiFmxObject = class(TPyDelphiComponent) property DelphiObject: TFmxObject read GetDelphiObject write SetDelphiObject; end; + TPyDelphiPosition = class(TPyDelphiPersistent) + private + function GetDelphiObject: TPosition; + procedure SetDelphiObject(const Value: TPosition); + protected + //Exposed Getters + function Get_X(Acontext: Pointer): PPyObject; cdecl; + function Get_Y(Acontext: Pointer): PPyObject; cdecl; + function Get_Point(Acontext: Pointer): PPyObject; cdecl; + //Exposed Setters + function Set_X(AValue: PPyObject; AContext: Pointer): integer; cdecl; + function Set_Y(AValue: PPyObject; AContext: Pointer): integer; cdecl; + function Set_Point(AValue: PPyObject; AContext: Pointer): integer; cdecl; + public + class function DelphiObjectClass: TClass; override; + class procedure RegisterMethods(PythonType: TPythonType); override; + class procedure RegisterGetSets(PythonType: TPythonType); override; + // Properties + property DelphiObject: TPosition read GetDelphiObject write SetDelphiObject; + end; + {Helper functions} function WrapPointF(APyDelphiWrapper: TPyDelphiWrapper; const APoint : TPointF) : PPyObject; function CheckPointFAttribute(AAttribute : PPyObject; const AAttributeName : string; out AValue : TPointF) : Boolean; @@ -186,6 +207,7 @@ procedure TTypesRegistration.RegisterWrappers( inherited; APyDelphiWrapper.RegisterHelperType(TPyDelphiPointF); APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiFmxObject); + APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiPosition); end; { Helper functions } @@ -267,6 +289,102 @@ function TPyDelphiFmxObject.Set_Parent(AValue: PPyObject; Result := -1; end; +{ TPyDelphiPosition } + +class function TPyDelphiPosition.DelphiObjectClass: TClass; +begin + Result := TPosition; +end; + +function TPyDelphiPosition.GetDelphiObject: TPosition; +begin + Result := TPosition(inherited DelphiObject); +end; + +function TPyDelphiPosition.Get_Point(Acontext: Pointer): PPyObject; +begin + Adjust(@Self); + Result := WrapPointF(PyDelphiWrapper, DelphiObject.Point); +end; + +function TPyDelphiPosition.Get_X(Acontext: Pointer): PPyObject; +begin + Adjust(@Self); + Result := GetPythonEngine.PyFloat_FromDouble(DelphiObject.X); +end; + +function TPyDelphiPosition.Get_Y(Acontext: Pointer): PPyObject; +begin + Adjust(@Self); + Result := GetPythonEngine.PyFloat_FromDouble(DelphiObject.Y); +end; + +class procedure TPyDelphiPosition.RegisterGetSets(PythonType: TPythonType); +begin + inherited; + with PythonType do begin + AddGetSet('X', @TPyDelphiPosition.Get_X, @TPyDelphiPosition.Set_X, + 'Provides access to the X coordinate of a control inside its parent', nil); + AddGetSet('Y', @TPyDelphiPosition.Get_Y, @TPyDelphiPosition.Set_Y, + 'Provides access to the Y coordinate of a control inside its parent', nil); + AddGetSet('Point', @TPyDelphiPosition.Get_Point, @TPyDelphiPosition.Set_Point, + 'Provides access to the position of a control inside its parent', nil); + end; +end; + +class procedure TPyDelphiPosition.RegisterMethods(PythonType: TPythonType); +begin + inherited; +end; + +procedure TPyDelphiPosition.SetDelphiObject(const Value: TPosition); +begin + inherited DelphiObject := Value; +end; + +function TPyDelphiPosition.Set_Point(AValue: PPyObject; + AContext: Pointer): integer; +var + LValue: TPointF; +begin + Adjust(@Self); + if CheckPointFAttribute(AValue, 'Point', LValue) then + begin + DelphiObject.Point := LValue; + Result := 0; + end + else + Result := -1; +end; + +function TPyDelphiPosition.Set_X(AValue: PPyObject; AContext: Pointer): integer; +var + x: double; +begin + if CheckFloatAttribute(AValue, 'X', x) then + with GetPythonEngine do begin + Adjust(@Self); + DelphiObject.X := x; + Result := 0; + end + else + Result := -1; +end; + +function TPyDelphiPosition.Set_Y(AValue: PPyObject; AContext: Pointer): integer; +var + y: double; +begin + if CheckFloatAttribute(AValue, 'Y', y) then + with GetPythonEngine do begin + Adjust(@Self); + DelphiObject.Y := y; + Result := 0; + end + else + Result := -1; +end; + initialization RegisteredUnits.Add(TTypesRegistration.Create); From 3d866127d1efbe51623d69a2cc4f8bc4b31064f8 Mon Sep 17 00:00:00 2001 From: Lucas Moura Belo Date: Wed, 16 Dec 2020 10:32:53 -0300 Subject: [PATCH 02/14] Giving access to the StyleLookup of a StyledControl --- Source/fmx/WrapFmxControls.pas | 71 ++++++++++++++++++++++++++++++++-- 1 file changed, 67 insertions(+), 4 deletions(-) diff --git a/Source/fmx/WrapFmxControls.pas b/Source/fmx/WrapFmxControls.pas index e3853c5c..fc6a79ee 100644 --- a/Source/fmx/WrapFmxControls.pas +++ b/Source/fmx/WrapFmxControls.pas @@ -6,7 +6,7 @@ interface uses Classes, SysUtils, TypInfo, Types, - Fmx.Controls, + FMX.Types, FMX.Controls, PythonEngine, WrapDelphi, WrapDelphiClasses, WrapFmxTypes; type @@ -67,10 +67,25 @@ TControlsAccess = class(TContainerAccess) property Container : TControl read GetContainer; end; -implementation + TPyDelphiStyledControl = class(TPyDelphiControl) + private + function GetDelphiObject: TStyledControl; + procedure SetDelphiObject(const Value: TStyledControl); + protected + // Exposed Methods + // Property Getters + function Get_StyleLookup(AContext: Pointer): PPyObject; cdecl; + // Property Setters + function Set_StyleLookup(AValue: PPyObject; AContext: Pointer): integer; cdecl; + public + class function DelphiObjectClass: TClass; override; + class procedure RegisterGetSets(PythonType: TPythonType); override; + class procedure RegisterMethods(PythonType: TPythonType); override; + // Properties + property DelphiObject: TStyledControl read GetDelphiObject write SetDelphiObject; + end; -uses - FMX.Types; +implementation type { Register the wrappers, the globals and the constants } @@ -429,6 +444,54 @@ class function TControlsAccess.SupportsIndexOf: Boolean; Result := True; end; +{ TPyDelphiStyledControl } + +class function TPyDelphiStyledControl.DelphiObjectClass: TClass; +begin + Result := TStyledControl; +end; + +function TPyDelphiStyledControl.GetDelphiObject: TStyledControl; +begin + Result := TStyledControl(inherited DelphiObject); +end; + +function TPyDelphiStyledControl.Get_StyleLookup(AContext: Pointer): PPyObject; +begin + Adjust(@Self); + Result := GetPythonEngine.PyUnicodeFromString(DelphiObject.StyleLookup); +end; + +class procedure TPyDelphiStyledControl.RegisterGetSets(PythonType: TPythonType); +begin + inherited; +end; + +class procedure TPyDelphiStyledControl.RegisterMethods(PythonType: TPythonType); +begin + inherited; +end; + +procedure TPyDelphiStyledControl.SetDelphiObject(const Value: TStyledControl); +begin + inherited DelphiObject := Value; +end; + +function TPyDelphiStyledControl.Set_StyleLookup(AValue: PPyObject; + AContext: Pointer): integer; +var + LValue: string; +begin + if CheckStrAttribute(AValue, 'StyleLookup', LValue) then + with GetPythonEngine do begin + Adjust(@Self); + DelphiObject.StyleLookup := LValue; + Result := 0; + end + else + Result := -1; +end; + initialization RegisteredUnits.Add(TControlsRegistration.Create); From 3d5eace1258818d7f3ce2b701a155568b8a53f3b Mon Sep 17 00:00:00 2001 From: Lucas Moura Belo Date: Wed, 16 Dec 2020 10:36:26 -0300 Subject: [PATCH 03/14] Registering the getter and setter to the StyleLookup property of a StyledControl --- Source/fmx/WrapFmxControls.pas | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Source/fmx/WrapFmxControls.pas b/Source/fmx/WrapFmxControls.pas index fc6a79ee..49f1ae4c 100644 --- a/Source/fmx/WrapFmxControls.pas +++ b/Source/fmx/WrapFmxControls.pas @@ -465,6 +465,10 @@ function TPyDelphiStyledControl.Get_StyleLookup(AContext: Pointer): PPyObject; class procedure TPyDelphiStyledControl.RegisterGetSets(PythonType: TPythonType); begin inherited; + with PythonType do begin + AddGetSet('StyleLookup', @TPyDelphiStyledControl.Get_StyleLookup, @TPyDelphiStyledControl.Set_StyleLookup, + 'Provides access to the StyleLookup of a StyledControl', nil); + end; end; class procedure TPyDelphiStyledControl.RegisterMethods(PythonType: TPythonType); From 550e35f773c738ac251ae0a8b4798e0978326f70 Mon Sep 17 00:00:00 2001 From: Lucas Moura Belo Date: Wed, 16 Dec 2020 10:37:33 -0300 Subject: [PATCH 04/14] Registering the StyledControl wrapper --- Source/fmx/WrapFmxControls.pas | 1 + 1 file changed, 1 insertion(+) diff --git a/Source/fmx/WrapFmxControls.pas b/Source/fmx/WrapFmxControls.pas index 49f1ae4c..f06a7296 100644 --- a/Source/fmx/WrapFmxControls.pas +++ b/Source/fmx/WrapFmxControls.pas @@ -376,6 +376,7 @@ procedure TControlsRegistration.RegisterWrappers( begin inherited; APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiControl); + APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiStyledControl); end; { TControlsAccess } From f3fea964328b02d90d93a57e871f31541f2b4b7a Mon Sep 17 00:00:00 2001 From: Lucas Moura Belo Date: Wed, 16 Dec 2020 10:42:25 -0300 Subject: [PATCH 05/14] Giving access to the DefaultStyleLookupName of a StyledControl --- Source/fmx/WrapFmxControls.pas | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/Source/fmx/WrapFmxControls.pas b/Source/fmx/WrapFmxControls.pas index f06a7296..15a6b06f 100644 --- a/Source/fmx/WrapFmxControls.pas +++ b/Source/fmx/WrapFmxControls.pas @@ -74,6 +74,7 @@ TPyDelphiStyledControl = class(TPyDelphiControl) protected // Exposed Methods // Property Getters + function Get_DefaultStyleLookupName(AContext: Pointer): PPyObject; cdecl; function Get_StyleLookup(AContext: Pointer): PPyObject; cdecl; // Property Setters function Set_StyleLookup(AValue: PPyObject; AContext: Pointer): integer; cdecl; @@ -457,6 +458,13 @@ function TPyDelphiStyledControl.GetDelphiObject: TStyledControl; Result := TStyledControl(inherited DelphiObject); end; +function TPyDelphiStyledControl.Get_DefaultStyleLookupName( + AContext: Pointer): PPyObject; +begin + Adjust(@Self); + Result := GetPythonEngine.PyUnicodeFromString(DelphiObject.DefaultStyleLookupName); +end; + function TPyDelphiStyledControl.Get_StyleLookup(AContext: Pointer): PPyObject; begin Adjust(@Self); @@ -467,8 +475,10 @@ class procedure TPyDelphiStyledControl.RegisterGetSets(PythonType: TPythonType); begin inherited; with PythonType do begin + AddGetSet('DefaultStyleLookupName', @TPyDelphiStyledControl.Get_StyleLookup, nil, + 'Provides access to the default style lookup name of a StyledControl', nil); AddGetSet('StyleLookup', @TPyDelphiStyledControl.Get_StyleLookup, @TPyDelphiStyledControl.Set_StyleLookup, - 'Provides access to the StyleLookup of a StyledControl', nil); + 'Provides access to the style lookup of a StyledControl', nil); end; end; From e9ca298655ea681de813e70db12bc21a58cce097 Mon Sep 17 00:00:00 2001 From: Lucas Moura Belo Date: Wed, 16 Dec 2020 10:49:32 -0300 Subject: [PATCH 06/14] Giving acess to the AutoTranslate property of a StyledControl --- Source/fmx/WrapFmxControls.pas | 29 +++++++++++++++++++++++++++-- 1 file changed, 27 insertions(+), 2 deletions(-) diff --git a/Source/fmx/WrapFmxControls.pas b/Source/fmx/WrapFmxControls.pas index 15a6b06f..3622a7f8 100644 --- a/Source/fmx/WrapFmxControls.pas +++ b/Source/fmx/WrapFmxControls.pas @@ -76,8 +76,10 @@ TPyDelphiStyledControl = class(TPyDelphiControl) // Property Getters function Get_DefaultStyleLookupName(AContext: Pointer): PPyObject; cdecl; function Get_StyleLookup(AContext: Pointer): PPyObject; cdecl; + function Get_AutoTranslate(AContext: Pointer): PPyObject; cdecl; // Property Setters function Set_StyleLookup(AValue: PPyObject; AContext: Pointer): integer; cdecl; + function Set_AutoTranslate(AValue: PPyObject; AContext: Pointer): integer; cdecl; public class function DelphiObjectClass: TClass; override; class procedure RegisterGetSets(PythonType: TPythonType); override; @@ -458,6 +460,12 @@ function TPyDelphiStyledControl.GetDelphiObject: TStyledControl; Result := TStyledControl(inherited DelphiObject); end; +function TPyDelphiStyledControl.Get_AutoTranslate(AContext: Pointer): PPyObject; +begin + Adjust(@Self); + Result := GetPythonEngine.VariantAsPyObject(Self.DelphiObject.AutoTranslate); +end; + function TPyDelphiStyledControl.Get_DefaultStyleLookupName( AContext: Pointer): PPyObject; begin @@ -476,9 +484,11 @@ class procedure TPyDelphiStyledControl.RegisterGetSets(PythonType: TPythonType); inherited; with PythonType do begin AddGetSet('DefaultStyleLookupName', @TPyDelphiStyledControl.Get_StyleLookup, nil, - 'Provides access to the default style lookup name of a StyledControl', nil); + 'Returns a string with the name of the default style of this control', nil); AddGetSet('StyleLookup', @TPyDelphiStyledControl.Get_StyleLookup, @TPyDelphiStyledControl.Set_StyleLookup, - 'Provides access to the style lookup of a StyledControl', nil); + 'Specifies the name of the resource object to which the current TStyledControl is linked', nil); + AddGetSet('AutoTranslate', @TPyDelphiStyledControl.Get_AutoTranslate, @TPyDelphiStyledControl.Set_AutoTranslate, + 'Specifies whether the control''s text should be translated', nil); end; end; @@ -492,6 +502,21 @@ procedure TPyDelphiStyledControl.SetDelphiObject(const Value: TStyledControl); inherited DelphiObject := Value; end; +function TPyDelphiStyledControl.Set_AutoTranslate(AValue: PPyObject; + AContext: Pointer): integer; +var + LValue: Boolean; +begin + Adjust(@Self); + if CheckBoolAttribute(AValue, 'AutoTranslate', LValue) then + begin + DelphiObject.AutoTranslate := LValue; + Result := 0; + end + else + Result := -1; +end; + function TPyDelphiStyledControl.Set_StyleLookup(AValue: PPyObject; AContext: Pointer): integer; var From 773b3b89b1fcdfe600a881c8df840c8026bb442a Mon Sep 17 00:00:00 2001 From: Lucas Moura Belo Date: Wed, 16 Dec 2020 10:57:01 -0300 Subject: [PATCH 07/14] Giving access to the ApplyStyleLookup method of a StyledControl --- Source/fmx/WrapFmxControls.pas | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/Source/fmx/WrapFmxControls.pas b/Source/fmx/WrapFmxControls.pas index 3622a7f8..875ff89d 100644 --- a/Source/fmx/WrapFmxControls.pas +++ b/Source/fmx/WrapFmxControls.pas @@ -73,6 +73,7 @@ TPyDelphiStyledControl = class(TPyDelphiControl) procedure SetDelphiObject(const Value: TStyledControl); protected // Exposed Methods + function ApplyStyleLookup_Wrapper(args : PPyObject) : PPyObject; cdecl; // Property Getters function Get_DefaultStyleLookupName(AContext: Pointer): PPyObject; cdecl; function Get_StyleLookup(AContext: Pointer): PPyObject; cdecl; @@ -450,6 +451,19 @@ class function TControlsAccess.SupportsIndexOf: Boolean; { TPyDelphiStyledControl } +function TPyDelphiStyledControl.ApplyStyleLookup_Wrapper( + args: PPyObject): PPyObject; +begin + Adjust(@Self); + with GetPythonEngine do begin + if PyArg_ParseTuple( args, ':ApplyStyleLookup') <> 0 then begin + DelphiObject.ApplyStyleLookup; + Result := ReturnNone; + end else + Result := nil; + end; +end; + class function TPyDelphiStyledControl.DelphiObjectClass: TClass; begin Result := TStyledControl; @@ -495,6 +509,9 @@ class procedure TPyDelphiStyledControl.RegisterGetSets(PythonType: TPythonType); class procedure TPyDelphiStyledControl.RegisterMethods(PythonType: TPythonType); begin inherited; + PythonType.AddMethod('ApplyStyleLookup', @TPyDelphiStyledControl.ApplyStyleLookup_Wrapper, + 'TStyledControl.ApplyStyleLookup()'#10 + + 'Gets and applies the style of a TStyledControl.'); end; procedure TPyDelphiStyledControl.SetDelphiObject(const Value: TStyledControl); From e3dd31c547d71be763eb59eace7d3d8818c0c0bb Mon Sep 17 00:00:00 2001 From: Lucas Moura Belo Date: Wed, 16 Dec 2020 10:59:22 -0300 Subject: [PATCH 08/14] Giving access to the NeedStyleLookup method of a StyledControl --- Source/fmx/WrapFmxControls.pas | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/Source/fmx/WrapFmxControls.pas b/Source/fmx/WrapFmxControls.pas index 875ff89d..f1eb917f 100644 --- a/Source/fmx/WrapFmxControls.pas +++ b/Source/fmx/WrapFmxControls.pas @@ -74,6 +74,7 @@ TPyDelphiStyledControl = class(TPyDelphiControl) protected // Exposed Methods function ApplyStyleLookup_Wrapper(args : PPyObject) : PPyObject; cdecl; + function NeedStyleLookup_Wrapper(args : PPyObject) : PPyObject; cdecl; // Property Getters function Get_DefaultStyleLookupName(AContext: Pointer): PPyObject; cdecl; function Get_StyleLookup(AContext: Pointer): PPyObject; cdecl; @@ -493,6 +494,19 @@ function TPyDelphiStyledControl.Get_StyleLookup(AContext: Pointer): PPyObject; Result := GetPythonEngine.PyUnicodeFromString(DelphiObject.StyleLookup); end; +function TPyDelphiStyledControl.NeedStyleLookup_Wrapper( + args: PPyObject): PPyObject; +begin + Adjust(@Self); + with GetPythonEngine do begin + if PyArg_ParseTuple( args, ':NeedStyleLookup') <> 0 then begin + DelphiObject.NeedStyleLookup; + Result := ReturnNone; + end else + Result := nil; + end; +end; + class procedure TPyDelphiStyledControl.RegisterGetSets(PythonType: TPythonType); begin inherited; @@ -512,6 +526,9 @@ class procedure TPyDelphiStyledControl.RegisterMethods(PythonType: TPythonType); PythonType.AddMethod('ApplyStyleLookup', @TPyDelphiStyledControl.ApplyStyleLookup_Wrapper, 'TStyledControl.ApplyStyleLookup()'#10 + 'Gets and applies the style of a TStyledControl.'); + PythonType.AddMethod('NeedStyleLookup', @TPyDelphiStyledControl.NeedStyleLookup_Wrapper, + 'TStyledControl.NeedStyleLookup()'#10 + + 'Call this procedure to indicate that this control requires to get and apply its style lookup.'); end; procedure TPyDelphiStyledControl.SetDelphiObject(const Value: TStyledControl); From 247597612e3959b0543a710e960ba158abf6f8f1 Mon Sep 17 00:00:00 2001 From: Lucas Moura Belo Date: Wed, 16 Dec 2020 11:03:39 -0300 Subject: [PATCH 09/14] Giving access to the Inflate method of the StyledControl --- Source/fmx/WrapFmxControls.pas | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/Source/fmx/WrapFmxControls.pas b/Source/fmx/WrapFmxControls.pas index f1eb917f..2cb0a872 100644 --- a/Source/fmx/WrapFmxControls.pas +++ b/Source/fmx/WrapFmxControls.pas @@ -75,6 +75,7 @@ TPyDelphiStyledControl = class(TPyDelphiControl) // Exposed Methods function ApplyStyleLookup_Wrapper(args : PPyObject) : PPyObject; cdecl; function NeedStyleLookup_Wrapper(args : PPyObject) : PPyObject; cdecl; + function Inflate_Wrapper(args : PPyObject) : PPyObject; cdecl; // Property Getters function Get_DefaultStyleLookupName(AContext: Pointer): PPyObject; cdecl; function Get_StyleLookup(AContext: Pointer): PPyObject; cdecl; @@ -494,6 +495,18 @@ function TPyDelphiStyledControl.Get_StyleLookup(AContext: Pointer): PPyObject; Result := GetPythonEngine.PyUnicodeFromString(DelphiObject.StyleLookup); end; +function TPyDelphiStyledControl.Inflate_Wrapper(args: PPyObject): PPyObject; +begin + Adjust(@Self); + with GetPythonEngine do begin + if PyArg_ParseTuple( args, ':Inflate') <> 0 then begin + DelphiObject.Inflate; + Result := ReturnNone; + end else + Result := nil; + end; +end; + function TPyDelphiStyledControl.NeedStyleLookup_Wrapper( args: PPyObject): PPyObject; begin @@ -529,6 +542,9 @@ class procedure TPyDelphiStyledControl.RegisterMethods(PythonType: TPythonType); PythonType.AddMethod('NeedStyleLookup', @TPyDelphiStyledControl.NeedStyleLookup_Wrapper, 'TStyledControl.NeedStyleLookup()'#10 + 'Call this procedure to indicate that this control requires to get and apply its style lookup.'); + PythonType.AddMethod('Inflate', @TPyDelphiStyledControl.Inflate_Wrapper, + 'TStyledControl.Inflate()'#10 + + 'Call this procedure to get and apply its style lookup.'); end; procedure TPyDelphiStyledControl.SetDelphiObject(const Value: TStyledControl); From dd86443bae63b297a775eb476830ab4ad9302895 Mon Sep 17 00:00:00 2001 From: Lucas Moura Belo Date: Wed, 16 Dec 2020 11:08:23 -0300 Subject: [PATCH 10/14] Giving access to the PrepareForPaint of a Control --- Source/fmx/WrapFmxControls.pas | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/Source/fmx/WrapFmxControls.pas b/Source/fmx/WrapFmxControls.pas index 2cb0a872..d8a3fc8e 100644 --- a/Source/fmx/WrapFmxControls.pas +++ b/Source/fmx/WrapFmxControls.pas @@ -31,6 +31,7 @@ TPyDelphiControl = class (TPyDelphiFmxObject) function CanFocus_Wrapper(args: PPyObject): PPyObject; cdecl; function SetFocus_Wrapper(args: PPyObject): PPyObject; cdecl; function ResetFocus_Wrapper(args: PPyObject): PPyObject; cdecl; + function PrepareForPaint_Wrapper(args : PPyObject) : PPyObject; cdecl; // Property Getters function Get_Visible(AContext: Pointer): PPyObject; cdecl; function Get_ControlsCount( AContext : Pointer) : PPyObject; cdecl; @@ -148,6 +149,18 @@ function TPyDelphiControl.LocalToAbsolute_Wrapper( end; end; +function TPyDelphiControl.PrepareForPaint_Wrapper(args: PPyObject): PPyObject; +begin + Adjust(@Self); + with GetPythonEngine do begin + if PyArg_ParseTuple( args, ':PrepareForPaint') <> 0 then begin + DelphiObject.PrepareForPaint; + Result := ReturnNone; + end else + Result := nil; + end; +end; + class function TPyDelphiControl.DelphiObjectClass: TClass; begin Result := TControl; @@ -241,6 +254,9 @@ class procedure TPyDelphiControl.RegisterMethods(PythonType: TPythonType); PythonType.AddMethod('ResetFocus', @TPyDelphiControl.ResetFocus_Wrapper, 'TControl.ResetFocus()'#10 + 'Removes the focus from a control of from any children of the control.'); + PythonType.AddMethod('PrepareForPaint', @TPyDelphiControl.PrepareForPaint_Wrapper, + 'TControl.PrepareForPaint()'#10 + + 'Prepares the current control for painting.'); end; function TPyDelphiControl.Repaint_Wrapper(args: PPyObject): PPyObject; From 42a9949c9f709ca6a297519628151431cf52e01c Mon Sep 17 00:00:00 2001 From: Lucas Moura Belo Date: Wed, 16 Dec 2020 11:24:50 -0300 Subject: [PATCH 11/14] Adding the TSizeF wrapper --- Source/fmx/WrapFmxTypes.pas | 154 ++++++++++++++++++++++++++++++++++++ 1 file changed, 154 insertions(+) diff --git a/Source/fmx/WrapFmxTypes.pas b/Source/fmx/WrapFmxTypes.pas index e54d14fe..0a649307 100644 --- a/Source/fmx/WrapFmxTypes.pas +++ b/Source/fmx/WrapFmxTypes.pas @@ -34,6 +34,28 @@ TPyDelphiPointF = class(TPyObject) property Value : TPointF read FValue write FValue; end; + TPyDelphiSizeF = class(TPyObject) + private + FValue: TSizeF; + protected + // Exposed Getters + function Get_Width(Acontext: Pointer): PPyObject; cdecl; + function Get_Height(Acontext: Pointer): PPyObject; cdecl; + // Exposed Setters + function Set_Width(AValue: PPyObject; AContext: Pointer): integer; cdecl; + function Set_Height(AValue: PPyObject; AContext: Pointer): integer; cdecl; + public + constructor CreateWith(APythonType: TPythonType; args: PPyObject); override; + + function Compare(obj: PPyObject): Integer; override; + function Repr: PPyObject; override; + + class procedure RegisterGetSets(PythonType: TPythonType); override; + class procedure SetupType(PythonType: TPythonType); override; + + property Value : TSizeF read FValue write FValue; + end; + TPyDelphiFmxObject = class(TPyDelphiComponent) private function GetDelphiObject: TFmxObject; @@ -74,7 +96,9 @@ TPyDelphiPosition = class(TPyDelphiPersistent) {Helper functions} function WrapPointF(APyDelphiWrapper: TPyDelphiWrapper; const APoint : TPointF) : PPyObject; + function WrapSizeF(APyDelphiWrapper: TPyDelphiWrapper; const ASize : TSizeF) : PPyObject; function CheckPointFAttribute(AAttribute : PPyObject; const AAttributeName : string; out AValue : TPointF) : Boolean; + function CheckSizeFAttribute(AAttribute : PPyObject; const AAttributeName : string; out AValue : TSizeF) : Boolean; implementation @@ -206,6 +230,7 @@ procedure TTypesRegistration.RegisterWrappers( begin inherited; APyDelphiWrapper.RegisterHelperType(TPyDelphiPointF); + APyDelphiWrapper.RegisterHelperType(TPyDelphiSizeF); APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiFmxObject); APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiPosition); end; @@ -220,6 +245,15 @@ function WrapPointF(APyDelphiWrapper : TPyDelphiWrapper; const APoint : TPointF) (PythonToDelphi(Result) as TPyDelphiPointF).Value := APoint; end; +function WrapSizeF(APyDelphiWrapper: TPyDelphiWrapper; const ASize : TSizeF) : PPyObject; +var + LType : TPythonType; +begin + LType := APyDelphiWrapper.GetHelperType('SizeFType'); + Result := LType.CreateInstance; + (PythonToDelphi(Result) as TPyDelphiSizeF).Value := ASize; +end; + function CheckPointFAttribute(AAttribute : PPyObject; const AAttributeName : string; out AValue : TPointF) : Boolean; begin with GetPythonEngine do @@ -239,6 +273,25 @@ function CheckPointFAttribute(AAttribute : PPyObject; const AAttributeName : str end; end; +function CheckSizeFAttribute(AAttribute : PPyObject; const AAttributeName : string; out AValue : TSizeF) : Boolean; +begin + with GetPythonEngine do + begin + if IsDelphiObject(AAttribute) and (PythonToDelphi(AAttribute) is TPyDelphiSizeF) then + begin + AValue := TPyDelphiSizeF(PythonToDelphi(AAttribute)).Value; + Result := True; + end + else + begin + Result := False; + with GetPythonEngine do + PyErr_SetString (PyExc_AttributeError^, + PAnsiChar(AnsiString(Format('%s receives only SizeF objects', [AAttributeName])))); + end; + end; +end; + { TPyDelphiFmxObject } class function TPyDelphiFmxObject.DelphiObjectClass: TClass; @@ -385,6 +438,107 @@ function TPyDelphiPosition.Set_Y(AValue: PPyObject; AContext: Pointer): integer; Result := -1; end; +{ TPyDelphiSizeF } + +function TPyDelphiSizeF.Compare(obj: PPyObject): Integer; +var + LOther : TPyDelphiSizeF; +begin + if IsDelphiObject(obj) and (PythonToDelphi(obj) is TPyDelphiPointF) then + begin + LOther := TPyDelphiSizeF(PythonToDelphi(obj)); + Result := CompareValue(Value.Width, LOther.Value.Width); + if Result = 0 then + Result := CompareValue(Value.Height, LOther.Value.Height); + end + else + Result := 1; +end; + +constructor TPyDelphiSizeF.CreateWith(APythonType: TPythonType; + args: PPyObject); +var + LWidth, LHeight : single; +begin + inherited; + if APythonType.Engine.PyArg_ParseTuple(args, 'ff:Create', @LWidth, @LHeight) <> 0 then + begin + FValue.Width := LWidth; + FValue.Height := LHeight; + end +end; + +function TPyDelphiSizeF.Get_Height(Acontext: Pointer): PPyObject; +begin + Adjust(@Self); + Result := GetPythonEngine.PyFloat_FromDouble(Value.Height); +end; + +function TPyDelphiSizeF.Get_Width(Acontext: Pointer): PPyObject; +begin + Adjust(@Self); + Result := GetPythonEngine.PyFloat_FromDouble(Value.Width); +end; + +class procedure TPyDelphiSizeF.RegisterGetSets(PythonType: TPythonType); +begin + inherited; + with PythonType do + begin + AddGetSet('Width', @TPyDelphiSizeF.Get_Width, @TPyDelphiSizeF.Set_Width, + 'Provides access to the width of a sizef', nil); + AddGetSet('Height', @TPyDelphiSizeF.Get_Height, @TPyDelphiSizeF.Set_Height, + 'Provides access to the height of a sizef', nil); + end; +end; + +function TPyDelphiSizeF.Repr: PPyObject; +begin + Result := GetPythonEngine.PyUnicodeFromString(Format('', + [Value.Width, Value.Height])); +end; + +class procedure TPyDelphiSizeF.SetupType(PythonType: TPythonType); +begin + inherited; + PythonType.TypeName := 'SizeF'; + PythonType.Name := string(PythonType.TypeName) + 'Type'; + PythonType.TypeFlags := PythonType.TypeFlags + [tpfBaseType]; + PythonType.GenerateCreateFunction := False; + PythonType.DocString.Text := 'wrapper for Delphi FMX TSizeF type'; + PythonType.Services.Basic := [bsGetAttrO, bsSetAttrO, bsRepr, bsStr, bsRichCompare]; +end; + +function TPyDelphiSizeF.Set_Height(AValue: PPyObject; + AContext: Pointer): integer; +var + LValue: double; +begin + if CheckFloatAttribute(AValue, 'Height', LValue) then + with GetPythonEngine do begin + Adjust(@Self); + FValue.Height := LValue; + Result := 0; + end + else + Result := -1; +end; + +function TPyDelphiSizeF.Set_Width(AValue: PPyObject; + AContext: Pointer): integer; +var + LValue: double; +begin + if CheckFloatAttribute(AValue, 'Width', LValue) then + with GetPythonEngine do begin + Adjust(@Self); + FValue.Width := LValue; + Result := 0; + end + else + Result := -1; +end; + initialization RegisteredUnits.Add(TTypesRegistration.Create); From 3492d92c0917e425c89f1ef8db6f6da3cb75b3b8 Mon Sep 17 00:00:00 2001 From: Lucas Moura Belo Date: Wed, 16 Dec 2020 11:29:55 -0300 Subject: [PATCH 12/14] Giving access to the AdjustSizeValue property of a StyledControl --- Source/fmx/WrapFmxControls.pas | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/Source/fmx/WrapFmxControls.pas b/Source/fmx/WrapFmxControls.pas index d8a3fc8e..2e8f01d1 100644 --- a/Source/fmx/WrapFmxControls.pas +++ b/Source/fmx/WrapFmxControls.pas @@ -81,6 +81,7 @@ TPyDelphiStyledControl = class(TPyDelphiControl) function Get_DefaultStyleLookupName(AContext: Pointer): PPyObject; cdecl; function Get_StyleLookup(AContext: Pointer): PPyObject; cdecl; function Get_AutoTranslate(AContext: Pointer): PPyObject; cdecl; + function Get_AdjustSizeValue(AContext: Pointer): PPyObject; cdecl; // Property Setters function Set_StyleLookup(AValue: PPyObject; AContext: Pointer): integer; cdecl; function Set_AutoTranslate(AValue: PPyObject; AContext: Pointer): integer; cdecl; @@ -492,6 +493,13 @@ function TPyDelphiStyledControl.GetDelphiObject: TStyledControl; Result := TStyledControl(inherited DelphiObject); end; +function TPyDelphiStyledControl.Get_AdjustSizeValue( + AContext: Pointer): PPyObject; +begin + Adjust(@Self); + Result := WrapSizeF(PyDelphiWrapper, DelphiObject.AdjustSizeValue); +end; + function TPyDelphiStyledControl.Get_AutoTranslate(AContext: Pointer): PPyObject; begin Adjust(@Self); @@ -546,6 +554,8 @@ class procedure TPyDelphiStyledControl.RegisterGetSets(PythonType: TPythonType); 'Specifies the name of the resource object to which the current TStyledControl is linked', nil); AddGetSet('AutoTranslate', @TPyDelphiStyledControl.Get_AutoTranslate, @TPyDelphiStyledControl.Set_AutoTranslate, 'Specifies whether the control''s text should be translated', nil); + AddGetSet('AdjustSizeValue', @TPyDelphiStyledControl.Get_AdjustSizeValue, nil, + 'Updates the width and height of this control according to its current style', nil); end; end; From 96a9591fcace89ec0d5f91080aaddfc92939461d Mon Sep 17 00:00:00 2001 From: Lucas Moura Belo Date: Wed, 16 Dec 2020 11:54:44 -0300 Subject: [PATCH 13/14] Giving access to the AdjustType property of a StyledControl --- Source/fmx/WrapFmxControls.pas | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/Source/fmx/WrapFmxControls.pas b/Source/fmx/WrapFmxControls.pas index 2e8f01d1..3f7039d3 100644 --- a/Source/fmx/WrapFmxControls.pas +++ b/Source/fmx/WrapFmxControls.pas @@ -82,6 +82,7 @@ TPyDelphiStyledControl = class(TPyDelphiControl) function Get_StyleLookup(AContext: Pointer): PPyObject; cdecl; function Get_AutoTranslate(AContext: Pointer): PPyObject; cdecl; function Get_AdjustSizeValue(AContext: Pointer): PPyObject; cdecl; + function Get_AdjustType(AContext: Pointer): PPyObject; cdecl; // Property Setters function Set_StyleLookup(AValue: PPyObject; AContext: Pointer): integer; cdecl; function Set_AutoTranslate(AValue: PPyObject; AContext: Pointer): integer; cdecl; @@ -500,6 +501,12 @@ function TPyDelphiStyledControl.Get_AdjustSizeValue( Result := WrapSizeF(PyDelphiWrapper, DelphiObject.AdjustSizeValue); end; +function TPyDelphiStyledControl.Get_AdjustType(AContext: Pointer): PPyObject; +begin + Adjust(@Self); + Result := GetPythonEngine.PyLong_FromLong(Ord(DelphiObject.AdjustType)); +end; + function TPyDelphiStyledControl.Get_AutoTranslate(AContext: Pointer): PPyObject; begin Adjust(@Self); @@ -556,6 +563,9 @@ class procedure TPyDelphiStyledControl.RegisterGetSets(PythonType: TPythonType); 'Specifies whether the control''s text should be translated', nil); AddGetSet('AdjustSizeValue', @TPyDelphiStyledControl.Get_AdjustSizeValue, nil, 'Updates the width and height of this control according to its current style', nil); + AddGetSet('AdjustType', @TPyDelphiStyledControl.Get_AdjustType, nil, + 'Determines if and how the width and height of this control should be ' + + 'modified to take the fixed space dictated by the style of this control', nil); end; end; From 1f19bd8499eaec442afb1b52b70676f9f41ec247 Mon Sep 17 00:00:00 2001 From: Lucas Moura Belo Date: Wed, 16 Dec 2020 11:57:35 -0300 Subject: [PATCH 14/14] Giving access to the StyleState property of a StyledControl --- Source/fmx/WrapFmxControls.pas | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/Source/fmx/WrapFmxControls.pas b/Source/fmx/WrapFmxControls.pas index 3f7039d3..2d0ed951 100644 --- a/Source/fmx/WrapFmxControls.pas +++ b/Source/fmx/WrapFmxControls.pas @@ -83,6 +83,7 @@ TPyDelphiStyledControl = class(TPyDelphiControl) function Get_AutoTranslate(AContext: Pointer): PPyObject; cdecl; function Get_AdjustSizeValue(AContext: Pointer): PPyObject; cdecl; function Get_AdjustType(AContext: Pointer): PPyObject; cdecl; + function Get_StyleState(AContext: Pointer): PPyObject; cdecl; // Property Setters function Set_StyleLookup(AValue: PPyObject; AContext: Pointer): integer; cdecl; function Set_AutoTranslate(AValue: PPyObject; AContext: Pointer): integer; cdecl; @@ -526,6 +527,12 @@ function TPyDelphiStyledControl.Get_StyleLookup(AContext: Pointer): PPyObject; Result := GetPythonEngine.PyUnicodeFromString(DelphiObject.StyleLookup); end; +function TPyDelphiStyledControl.Get_StyleState(AContext: Pointer): PPyObject; +begin + Adjust(@Self); + Result := GetPythonEngine.PyLong_FromLong(Ord(DelphiObject.StyleState)); +end; + function TPyDelphiStyledControl.Inflate_Wrapper(args: PPyObject): PPyObject; begin Adjust(@Self); @@ -566,6 +573,8 @@ class procedure TPyDelphiStyledControl.RegisterGetSets(PythonType: TPythonType); AddGetSet('AdjustType', @TPyDelphiStyledControl.Get_AdjustType, nil, 'Determines if and how the width and height of this control should be ' + 'modified to take the fixed space dictated by the style of this control', nil); + AddGetSet('StyleState', @TPyDelphiStyledControl.Get_StyleState, nil, + 'This property allows you to define the current state of style', nil); end; end;