From 909b30681d9213c531ef9903deff171e5818716b Mon Sep 17 00:00:00 2001 From: Lucas Belo Date: Wed, 29 Sep 2021 13:47:43 -0700 Subject: [PATCH 1/8] Adding TTrackBar wrapper --- Source/fmx/WrapFmxForms.pas | 123 +++++++++++++++++++++++++++++++++++- 1 file changed, 120 insertions(+), 3 deletions(-) diff --git a/Source/fmx/WrapFmxForms.pas b/Source/fmx/WrapFmxForms.pas index b642c0d9..a6954a83 100644 --- a/Source/fmx/WrapFmxForms.pas +++ b/Source/fmx/WrapFmxForms.pas @@ -6,7 +6,8 @@ interface uses System.Classes, System.SysUtils, FMX.Forms, - PythonEngine, WrapFmxTypes, WrapDelphiClasses, WrapFmxControls; + PythonEngine, WrapFmxTypes, WrapDelphiClasses, WrapFmxControls, WrapDelphi, + System.TypInfo, System.UITypes; type TPyDelphiApplication = class(TPyDelphiComponent) @@ -20,6 +21,24 @@ TPyDelphiApplication = class(TPyDelphiComponent) property DelphiObject: TApplication read GetDelphiObject write SetDelphiObject; end; + TCloseQueryEventHandler = class(TEventHandler) + protected + procedure DoEvent(Sender: TObject; var CanClose : Boolean); + public + constructor Create(PyDelphiWrapper : TPyDelphiWrapper; Component : TObject; + PropertyInfo : PPropInfo; Callable : PPyObject); override; + class function GetTypeInfo : PTypeInfo; override; + end; + + TCloseEventHandler = class(TEventHandler) + protected + procedure DoEvent(Sender: TObject; var Action: TCloseAction); + public + constructor Create(PyDelphiWrapper : TPyDelphiWrapper; Component : TObject; + PropertyInfo : PPropInfo; Callable : PPyObject); override; + class function GetTypeInfo : PTypeInfo; override; + end; + TPyDelphiCommonCustomForm = class(TPyDelphiFmxObject) private function GetDelphiObject: TCommonCustomForm; @@ -93,7 +112,7 @@ EInvalidFormClass = class(Exception); implementation uses - WrapDelphi, System.Types; + System.Types; { Register the wrappers, the globals and the constants } type @@ -137,6 +156,9 @@ procedure TFormsRegistration.RegisterWrappers( APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiForm); APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiFrame); APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiScreen); + + APyDelphiWrapper.EventHandlers.RegisterHandler(TCloseQueryEventHandler); + APyDelphiWrapper.EventHandlers.RegisterHandler(TCloseEventHandler); end; { TPyDelphiApplication } @@ -156,6 +178,101 @@ procedure TPyDelphiApplication.SetDelphiObject(const Value: TApplication); inherited DelphiObject := Value; end; +{ TCloseQueryEventHandler } + +constructor TCloseQueryEventHandler.Create(PyDelphiWrapper: TPyDelphiWrapper; + Component: TObject; PropertyInfo: PPropInfo; Callable: PPyObject); +var + LMethod : TMethod; +begin + inherited; + LMethod.Code := @TCloseQueryEventHandler.DoEvent; + LMethod.Data := Self; + SetMethodProp(Component, PropertyInfo, LMethod); +end; + +procedure TCloseQueryEventHandler.DoEvent(Sender: TObject; + var CanClose: Boolean); +var + LPyObject, LPyTuple, LPyResult, LPyCanClose : PPyObject; + LVarParam : TPyDelphiVarParameter; +begin + Assert(Assigned(PyDelphiWrapper)); + if Assigned(Callable) and PythonOK then + with GetPythonEngine do begin + LPyObject := PyDelphiWrapper.Wrap(Sender); + LPyCanClose := CreateVarParam(PyDelphiWrapper, CanClose); + LVarParam := PythonToDelphi(LPyCanClose) as TPyDelphiVarParameter; + LPyTuple := PyTuple_New(2); + GetPythonEngine.PyTuple_SetItem(LPyTuple, 0, LPyObject); + GetPythonEngine.PyTuple_SetItem(LPyTuple, 1, LPyCanClose); + try + LPyResult := PyObject_CallObject(Callable, LPyTuple); + if Assigned(LPyResult) then + begin + Py_DECREF(LPyResult); + CanClose := PyObject_IsTrue(LVarParam.Value) = 1; + end; + finally + Py_DECREF(LPyTuple); + end; + CheckError; + end; +end; + +class function TCloseQueryEventHandler.GetTypeInfo: PTypeInfo; +begin + Result := System.TypeInfo(TCloseQueryEvent); +end; + +{ TCloseEventHandler } + +constructor TCloseEventHandler.Create(PyDelphiWrapper: TPyDelphiWrapper; + Component: TObject; PropertyInfo: PPropInfo; Callable: PPyObject); +var + LMethod : TMethod; +begin + inherited; + LMethod.Code := @TCloseEventHandler.DoEvent; + LMethod.Data := Self; + SetMethodProp(Component, PropertyInfo, LMethod); +end; + +procedure TCloseEventHandler.DoEvent(Sender: TObject; var Action: TCloseAction); +var + LPyObject, LPyTuple, LPyResult, LPyAction : PPyObject; + LVarParam : TPyDelphiVarParameter; +begin + Assert(Assigned(PyDelphiWrapper)); + if Assigned(Callable) and PythonOK then + with GetPythonEngine do begin + LPyObject := PyDelphiWrapper.Wrap(Sender); + LPyAction := CreateVarParam(PyDelphiWrapper, NativeInt(Action)); + LVarParam := PythonToDelphi(LPyAction) as TPyDelphiVarParameter; + LPyTuple := PyTuple_New(2); + GetPythonEngine.PyTuple_SetItem(LPyTuple, 0, LPyObject); + GetPythonEngine.PyTuple_SetItem(LPyTuple, 1, LPyAction); + try + LPyResult := PyObject_CallObject(Callable, LPyTuple); + if Assigned(LPyResult) then + begin + Py_DECREF(LPyResult); + if PyLong_Check(LVarParam.Value) and + CheckEnum('TCloseAction', PyLong_AsLong(LVarParam.Value), Ord(Low(TCloseAction)), Ord(High(TCloseAction))) then + Action := TCloseAction(PyLong_AsLong(LVarParam.Value)); + end; + finally + Py_DECREF(LPyTuple); + end; + CheckError; + end; +end; + +class function TCloseEventHandler.GetTypeInfo: PTypeInfo; +begin + Result := System.TypeInfo(TCloseEvent); +end; + { TPyDelphiCommonCustomForm } function TPyDelphiCommonCustomForm.CreateComponent( @@ -312,7 +429,7 @@ procedure TPyDelphiScreen.SetDelphiObject(const Value: TScreen); inherited DelphiObject := Value; end; -initialization +Initialization RegisteredUnits.Add(TFormsRegistration.Create); end. From 5494e2220df86083dac42e1734dce26151344c39 Mon Sep 17 00:00:00 2001 From: Lucas Belo Date: Wed, 29 Sep 2021 14:09:37 -0700 Subject: [PATCH 2/8] Adding TTrackBar wrapper --- Source/vcl/WrapVclComCtrls.pas | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/Source/vcl/WrapVclComCtrls.pas b/Source/vcl/WrapVclComCtrls.pas index c70bd46e..426d79c5 100644 --- a/Source/vcl/WrapVclComCtrls.pas +++ b/Source/vcl/WrapVclComCtrls.pas @@ -103,6 +103,16 @@ TPyDelphiPageControl = class (TPyDelphiWinControl) property DelphiObject: TPageControl read GetDelphiObject write SetDelphiObject; end; + TPyDelphiTrackBar = class (TPyDelphiWinControl) + private + function GetDelphiObject: TTrackBar; + procedure SetDelphiObject(const Value: TTrackBar); + public + class function DelphiObjectClass : TClass; override; + // Properties + property DelphiObject: TTrackBar read GetDelphiObject write SetDelphiObject; + end; + implementation uses @@ -137,6 +147,7 @@ procedure TComCtrlsRegistration.RegisterWrappers(APyDelphiWrapper: TPyDelphiWrap {$ENDIF FPC} APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiPageControl); APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiTabSheet); + APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiTrackBar); APyDelphiWrapper.EventHandlers.RegisterHandler(TTabChangingEventHandler); end; @@ -613,6 +624,23 @@ class function TTabChangingEventHandler.GetTypeInfo: PTypeInfo; Result := System.TypeInfo(TTabChangingEvent); end; +{ TPyDelphiTrackBar } + +class function TPyDelphiTrackBar.DelphiObjectClass: TClass; +begin + Result := TTrackBar; +end; + +function TPyDelphiTrackBar.GetDelphiObject: TTrackBar; +begin + Result := TTrackBar(inherited DelphiObject); +end; + +procedure TPyDelphiTrackBar.SetDelphiObject(const Value: TTrackBar); +begin + DelphiObject := Value; +end; + initialization RegisteredUnits.Add( TComCtrlsRegistration.Create ); {$IFNDEF FPC} From fcfc0b5b86dfb540c602169f99d75a8d2b0e6667 Mon Sep 17 00:00:00 2001 From: Lucas Belo Date: Wed, 29 Sep 2021 15:20:51 -0700 Subject: [PATCH 3/8] Small adjustment --- Source/vcl/WrapVclComCtrls.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Source/vcl/WrapVclComCtrls.pas b/Source/vcl/WrapVclComCtrls.pas index 426d79c5..cfe66f7a 100644 --- a/Source/vcl/WrapVclComCtrls.pas +++ b/Source/vcl/WrapVclComCtrls.pas @@ -638,7 +638,7 @@ function TPyDelphiTrackBar.GetDelphiObject: TTrackBar; procedure TPyDelphiTrackBar.SetDelphiObject(const Value: TTrackBar); begin - DelphiObject := Value; + inherited DelphiObject := Value; end; initialization From 5d1716e532cf4062ff23351f82c6e8fd9c3c1f7c Mon Sep 17 00:00:00 2001 From: Lucas Belo Date: Wed, 29 Sep 2021 15:21:27 -0700 Subject: [PATCH 4/8] Adding TActivityIndicator wrapper --- Source/vcl/WrapVclWinXCtrls.pas | 101 ++++++++++++++++++++++++++++++++ 1 file changed, 101 insertions(+) create mode 100644 Source/vcl/WrapVclWinXCtrls.pas diff --git a/Source/vcl/WrapVclWinXCtrls.pas b/Source/vcl/WrapVclWinXCtrls.pas new file mode 100644 index 00000000..ab1f1418 --- /dev/null +++ b/Source/vcl/WrapVclWinXCtrls.pas @@ -0,0 +1,101 @@ +{$I ..\Definition.Inc} +unit WrapVclWinXCtrls; + +interface + +uses + Vcl.WinXCtrls, WrapVclControls; + +type + TPyDelphiCustomActivityIndicator = class (TPyDelphiCustomControl) + private + function GetDelphiObject: TCustomActivityIndicator; + procedure SetDelphiObject(const Value: TCustomActivityIndicator); + public + class function DelphiObjectClass : TClass; override; + property DelphiObject: TCustomActivityIndicator read GetDelphiObject write SetDelphiObject; + end; + + TPyDelphiActivityIndicator = class (TPyDelphiCustomActivityIndicator) + private + function GetDelphiObject: TActivityIndicator; + procedure SetDelphiObject(const Value: TActivityIndicator); + public + class function DelphiObjectClass : TClass; override; + property DelphiObject: TActivityIndicator read GetDelphiObject write SetDelphiObject; + end; + +implementation + +uses + WrapDelphi; + +{ Register the wrappers, the globals and the constants } +type + TWinXCtrlsRegistration = class(TRegisteredUnit) + public + function Name: string; override; + procedure RegisterWrappers(APyDelphiWrapper: TPyDelphiWrapper); override; + procedure DefineVars(APyDelphiWrapper: TPyDelphiWrapper); override; + end; + +{ TComCtrlsRegistration } + +procedure TWinXCtrlsRegistration.DefineVars(APyDelphiWrapper: TPyDelphiWrapper); +begin + inherited; +end; + +function TWinXCtrlsRegistration.Name: string; +begin + Result := 'WinXCtrls'; +end; + +procedure TWinXCtrlsRegistration.RegisterWrappers( + APyDelphiWrapper: TPyDelphiWrapper); +begin + inherited; + APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiCustomActivityIndicator); + APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiActivityIndicator); +end; + +{ TPyDelphiCustomActivityIndicator } + +class function TPyDelphiCustomActivityIndicator.DelphiObjectClass: TClass; +begin + Result := TCustomActivityIndicator; +end; + +function TPyDelphiCustomActivityIndicator.GetDelphiObject: TCustomActivityIndicator; +begin + Result := TCustomActivityIndicator(inherited DelphiObject); +end; + +procedure TPyDelphiCustomActivityIndicator.SetDelphiObject( + const Value: TCustomActivityIndicator); +begin + inherited DelphiObject := Value; +end; + +{ TPyDelphiActivityIndicator } + +class function TPyDelphiActivityIndicator.DelphiObjectClass: TClass; +begin + Result := TActivityIndicator; +end; + +function TPyDelphiActivityIndicator.GetDelphiObject: TActivityIndicator; +begin + Result := TActivityIndicator(inherited DelphiObject); +end; + +procedure TPyDelphiActivityIndicator.SetDelphiObject( + const Value: TActivityIndicator); +begin + inherited DelphiObject := Value; +end; + +initialization + RegisteredUnits.Add(TWinXCtrlsRegistration.Create()); + +end. From c56088924bc08674891125ba270220e4dafa4907 Mon Sep 17 00:00:00 2001 From: Lucas Belo Date: Wed, 29 Sep 2021 15:27:13 -0700 Subject: [PATCH 5/8] Adding WrapVclWinXCtrls to VCL wrappers --- Source/vcl/WrapDelphiVCL.pas | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Source/vcl/WrapDelphiVCL.pas b/Source/vcl/WrapDelphiVCL.pas index 7aba27f2..980d84f3 100644 --- a/Source/vcl/WrapDelphiVCL.pas +++ b/Source/vcl/WrapDelphiVCL.pas @@ -22,6 +22,7 @@ implementation WrapVclExtCtrls, WrapVclButtons, WrapVclGrids, - WrapVclSamplesSpin; + WrapVclSamplesSpin, + WrapVclWinXCtrls; end. From 8053e994a14d8494af71f7fc49b2c8605094c889 Mon Sep 17 00:00:00 2001 From: Lucas Belo Date: Fri, 1 Oct 2021 07:35:43 -0700 Subject: [PATCH 6/8] Adding partial support for VCL themes --- Source/vcl/WrapVclThemes.pas | 165 +++++++++++++++++++++++++++++++++++ 1 file changed, 165 insertions(+) create mode 100644 Source/vcl/WrapVclThemes.pas diff --git a/Source/vcl/WrapVclThemes.pas b/Source/vcl/WrapVclThemes.pas new file mode 100644 index 00000000..6288ddb0 --- /dev/null +++ b/Source/vcl/WrapVclThemes.pas @@ -0,0 +1,165 @@ +{$I ..\Definition.Inc} +unit WrapVclThemes; + +interface + +uses + PythonEngine, WrapDelphi, Vcl.Themes; + +type + TPyDelphiStyleManager = class(TPyDelphiObject) + private + function GetDelphiObject: TStyleManager; + procedure SetDelphiObject(const Value: TStyleManager); + protected + function Get_StyleNames(AContext: Pointer): PPyObject; cdecl; + function Get_ActiveStyle(AContext: Pointer): PPyObject; cdecl; + public + constructor Create( APythonType : TPythonType ); override; + constructor CreateWith(APythonType: TPythonType; args: PPyObject); override; + + class function DelphiObjectClass : TClass; override; + class procedure RegisterGetSets(PythonType: TPythonType); override; + class procedure RegisterMethods(PythonType: TPythonType); override; + + property DelphiObject: TStyleManager read GetDelphiObject write SetDelphiObject; + end; + + TStyleManagerStyleNamesAccess = class(TContainerAccess) + private + function GetContainer: TStyleManager; + public + class function ExpectedContainerClass: TClass; override; + class function Name: string; override; + + function GetItem(AIndex: Integer): PPyObject; override; + function GetSize: Integer; override; + + property Container : TStyleManager read GetContainer; + end; + +implementation + +uses + Vcl.Controls; + +{ Register the wrappers, the globals and the constants } +type + TVclThemesRegistration = class(TRegisteredUnit) + public + function Name: string; override; + procedure RegisterWrappers(APyDelphiWrapper: TPyDelphiWrapper); override; + procedure DefineVars(APyDelphiWrapper: TPyDelphiWrapper); override; + end; + +{ TVclThemesRegistration } + +procedure TVclThemesRegistration.DefineVars(APyDelphiWrapper: TPyDelphiWrapper); +begin + inherited; +end; + +function TVclThemesRegistration.Name: string; +begin + Result := 'VclThemes'; +end; + +procedure TVclThemesRegistration.RegisterWrappers( + APyDelphiWrapper: TPyDelphiWrapper); +begin + inherited; + APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiStyleManager); +end; + +{ TPyDelphiStyleManager } + +constructor TPyDelphiStyleManager.Create(APythonType: TPythonType); +begin + inherited; +end; + +constructor TPyDelphiStyleManager.CreateWith(APythonType: TPythonType; + args: PPyObject); +begin + inherited; + DelphiObject := TStyleManager.Create(); +end; + +class function TPyDelphiStyleManager.DelphiObjectClass: TClass; +begin + Result := TStyleManager; +end; + +function TPyDelphiStyleManager.GetDelphiObject: TStyleManager; +begin + Result := TStyleManager(inherited DelphiObject); +end; + +function TPyDelphiStyleManager.Get_ActiveStyle( + AContext: Pointer): PPyObject; +begin + Adjust(@Self); + Result := Wrap(DelphiObject.ActiveStyle); +end; + +function TPyDelphiStyleManager.Get_StyleNames(AContext: Pointer): PPyObject; +begin + Adjust(@Self); + Result := Self.PyDelphiWrapper.DefaultContainerType.CreateInstance; + with PythonToDelphi(Result) as TPyDelphiContainer do + Setup(Self.PyDelphiWrapper, + TStyleManagerStyleNamesAccess.Create(Self.PyDelphiWrapper, Self.DelphiObject)); +end; + +class procedure TPyDelphiStyleManager.RegisterGetSets(PythonType: TPythonType); +begin + inherited; + with PythonType do begin + AddGetSet('StyleNames', @TPyDelphiStyleManager.Get_StyleNames, nil, + 'Provides access to the VCL style names.', nil); + AddGetSet('ActiveStyle', @TPyDelphiStyleManager.Get_ActiveStyle, nil, + 'Returns the current style.', nil); + end; +end; + +class procedure TPyDelphiStyleManager.RegisterMethods(PythonType: TPythonType); +begin + inherited; +end; + +procedure TPyDelphiStyleManager.SetDelphiObject(const Value: TStyleManager); +begin + inherited DelphiObject := Value; +end; + +{ TStyleManagerStyleNamesAccess } + +class function TStyleManagerStyleNamesAccess.ExpectedContainerClass: TClass; +begin + Result := TStyleManager; +end; + +function TStyleManagerStyleNamesAccess.GetContainer: TStyleManager; +begin + Result := TStyleManager(inherited Container); +end; + +function TStyleManagerStyleNamesAccess.GetItem(AIndex: Integer): PPyObject; +begin + Result := GetPythonEngine().PyUnicodeFromString(Container.StyleNames[AIndex]); +end; + +function TStyleManagerStyleNamesAccess.GetSize: Integer; +begin + Result := Length(Container.StyleNames); +end; + +class function TStyleManagerStyleNamesAccess.Name: string; +begin + Result := 'TStyleManager.StyleNames'; +end; + +initialization + RegisteredUnits.Add(TVclThemesRegistration.Create()); + +end. From 0796cbd437cd0bff7392d52265caff39a5755c40 Mon Sep 17 00:00:00 2001 From: Lucas Belo Date: Fri, 1 Oct 2021 07:37:33 -0700 Subject: [PATCH 7/8] Adding WrapVclWinXCtrls and WrapVclThemes units to project --- Packages/Delphi/Delphi 10.4+/PythonVcl.dpk | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/Packages/Delphi/Delphi 10.4+/PythonVcl.dpk b/Packages/Delphi/Delphi 10.4+/PythonVcl.dpk index 0cdecfd5..8ef5f7e3 100644 --- a/Packages/Delphi/Delphi 10.4+/PythonVcl.dpk +++ b/Packages/Delphi/Delphi 10.4+/PythonVcl.dpk @@ -34,7 +34,9 @@ requires rtl, vcl, Python, - VclSmp; + VclSmp, + vclimg, + vclwinx; contains Vcl.PythonGUIInputOutput in '..\..\..\Source\vcl\Vcl.PythonGUIInputOutput.pas', @@ -49,6 +51,8 @@ contains WrapVclGraphics in '..\..\..\Source\vcl\WrapVclGraphics.pas', WrapVclGrids in '..\..\..\Source\vcl\WrapVclGrids.pas', WrapVclSamplesSpin in '..\..\..\Source\vcl\WrapVclSamplesSpin.pas', - WrapVclStdCtrls in '..\..\..\Source\vcl\WrapVclStdCtrls.pas'; + WrapVclStdCtrls in '..\..\..\Source\vcl\WrapVclStdCtrls.pas', + WrapVclWinXCtrls in '..\..\..\Source\vcl\WrapVclWinXCtrls.pas', + WrapVclThemes in '..\..\..\Source\vcl\WrapVclThemes.pas'; end. From e1cd4612826cb40d608564d3fdb395b0059b2ef9 Mon Sep 17 00:00:00 2001 From: Lucas Belo Date: Fri, 1 Oct 2021 07:40:43 -0700 Subject: [PATCH 8/8] Including WrapVclWinXCtrls and WrapVclThemes in VCL wrappers --- Source/vcl/WrapDelphiVCL.pas | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Source/vcl/WrapDelphiVCL.pas b/Source/vcl/WrapDelphiVCL.pas index 980d84f3..241f9c2d 100644 --- a/Source/vcl/WrapDelphiVCL.pas +++ b/Source/vcl/WrapDelphiVCL.pas @@ -23,6 +23,7 @@ implementation WrapVclButtons, WrapVclGrids, WrapVclSamplesSpin, - WrapVclWinXCtrls; + WrapVclWinXCtrls, + WrapVclThemes; end.