Merge pull request Embarcadero#2 from Embarcadero/lastmile

lmbelo · web-flow · commit 2b718a27e54a · 2021-10-01T11:44:21.000-03:00
Lastmile
diff --git 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.
diff --git 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.
diff --git a/Source/vcl/WrapDelphiVCL.pas b/Source/vcl/WrapDelphiVCL.pas
@@ -22,6 +22,8 @@ implementation
   WrapVclExtCtrls,
   WrapVclButtons,
   WrapVclGrids,
-  WrapVclSamplesSpin;
+  WrapVclSamplesSpin,
+  WrapVclWinXCtrls,
+  WrapVclThemes;
 
 end.
diff --git 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
+  inherited DelphiObject := Value;
+end;
+
 initialization
   RegisteredUnits.Add( TComCtrlsRegistration.Create );
   {$IFNDEF FPC}
diff --git a/Source/vcl/WrapVclThemes.pas b/Source/vcl/WrapVclThemes.pas
diff --git a/Source/vcl/WrapVclWinXCtrls.pas b/Source/vcl/WrapVclWinXCtrls.pas
