Fix #435

Author: pyscripter

Source/WrapDelphi.pas

@@ -1031,6 +1031,9 @@   TExposedProperty = class(TExposedGetSet)
   procedure RaiseNotifyEvent(PyDelphiWrapper : TPyDelphiWrapper; ACallable : PPyObject; Sender: TObject);
   {Sets mulptiple properties of PyObject from keywords argument}
   function SetProperties(PyObject: PPyObject; keywords: PPyObject): PPyObject;
+  function ValidateClassRef(PyValue: PPyObject; RefClass: TClass;
+    out ClassRef: TClass; out ErrMsg: string): Boolean;
+  procedure InvalidArguments(const MethName, ErrMsg : string);
 
 implementation
 
@@ -1105,20 +1108,9 @@ function SetRttiAttr(const ParentAddr: Pointer;  ParentType: TRttiStructuredType
   const AttrName: string; Value: PPyObject;  PyDelphiWrapper: TPyDelphiWrapper;
   out ErrMsg: string): Boolean; forward;
 
-  function ValidateClassRef(PyValue: PPyObject; RefClass: TClass;
-    out ClassRef: TClass; out ErrMsg: string): Boolean; forward;
-
 function ValidateClassProperty(PyValue: PPyObject; TypeInfo: PTypeInfo;
   out Obj: TObject; out ErrMsg: string): Boolean; forward;
 
-procedure InvalidArguments(const MethName, ErrMsg : string);
-begin
-  with GetPythonEngine do
-    PyErr_SetObject(PyExc_TypeError^, PyUnicodeFromString(
-      Format(rs_ErrInvalidArgs,
-      [MethName, ErrMsg])));
-end;
-
 { TAbstractExposedMember }
 
 constructor TAbstractExposedMember.Create(ARttiMember: TRttiMember;
@@ -1373,6 +1365,59 @@ function GlobalDelphiWrapper: TPyDelphiWrapper;
 
 { Helper functions }
 
+procedure InvalidArguments(const MethName, ErrMsg : string);
+begin
+  with GetPythonEngine do
+    PyErr_SetObject(PyExc_TypeError^, PyUnicodeFromString(
+      Format(rs_ErrInvalidArgs,
+      [MethName, ErrMsg])));
+end;
+
+function ValidateClassRef(PyValue: PPyObject; RefClass: TClass;
+  out ClassRef: TClass; out ErrMsg: string): Boolean;
+var
+  LTypeName: AnsiString;
+  LPythonType: TPythonType;
+begin
+  ClassRef := nil;
+  if (PyValue = GetPythonEngine.Py_None) then begin
+     Result := True;
+     Exit;
+  end;
+
+  Result := False;
+  // Is PyValue a Python type?
+  if PyValue^.ob_type^.tp_name = 'type' then
+    LTypeName := PPyTypeObject(PyValue).tp_name
+  else
+  begin
+    ErrMsg := rs_ExpectedClass;
+    Exit;
+  end;
+
+  LPythonType := GetPythonEngine.FindPythonType(PPyTypeObject(PyValue));
+  if not Assigned(LPythonType) then
+    // Try once more with the base type to catter for pascal classes
+    // subclassed in Python
+    LPythonType := GetPythonEngine.FindPythonType(PPyTypeObject(PyValue).tp_base);
+
+  if Assigned(LPythonType) then
+  begin
+    if Assigned(LPythonType) and LPythonType.PyObjectClass.InheritsFrom(TPyDelphiObject) then
+    begin
+      ClassRef := TPyDelphiObjectClass(LPythonType.PyObjectClass).DelphiObjectClass;
+      if ClassRef.InheritsFrom(RefClass) then
+        Result := True
+      else
+        ErrMsg := rs_IncompatibleClasses;
+    end
+    else
+      ErrMsg := rs_ExpectedClass;
+  end
+  else
+    ErrMsg := rs_ExpectedClass;
+end;
+
 {$IFDEF EXTENDED_RTTI}
 function DynArrayToPython(const Value: TValue): PPyObject;
 var
@@ -1559,51 +1604,6 @@ function ValidateInterfaceProperty(PyValue: PPyObject; RttiType: TRttiInterfaceT
     ErrMsg := rs_ExpectedInterface;
 end;
 
-function ValidateClassRef(PyValue: PPyObject; RefClass: TClass;
-  out ClassRef: TClass; out ErrMsg: string): Boolean;
-var
-  LTypeName: AnsiString;
-  LPythonType: TPythonType;
-begin
-  ClassRef := nil;
-  if (PyValue = GetPythonEngine.Py_None) then begin
-     Result := True;
-     Exit;
-  end;
-
-  Result := False;
-  // Is PyValue a Python type?
-  if PyValue^.ob_type^.tp_name = 'type' then
-    LTypeName := PPyTypeObject(PyValue).tp_name
-  else
-  begin
-    ErrMsg := rs_ExpectedClass;
-    Exit;
-  end;
-
-  LPythonType := GetPythonEngine.FindPythonType(PPyTypeObject(PyValue));
-  if not Assigned(LPythonType) then
-    // Try once more with the base type to catter for pascal classes
-    // subclassed in Python
-    LPythonType := GetPythonEngine.FindPythonType(PPyTypeObject(PyValue).tp_base);
-
-  if Assigned(LPythonType) then
-  begin
-    if Assigned(LPythonType) and LPythonType.PyObjectClass.InheritsFrom(TPyDelphiObject) then
-    begin
-      ClassRef := TPyDelphiObjectClass(LPythonType.PyObjectClass).DelphiObjectClass;
-      if ClassRef.InheritsFrom(RefClass) then
-        Result := True
-      else
-        ErrMsg := rs_IncompatibleClasses;
-    end
-    else
-      ErrMsg := rs_ExpectedClass;
-  end
-  else
-    ErrMsg := rs_ExpectedClass;
-end;
-
 function ValidateDynArray(PyValue: PPyObject; const RttiParam: TRttiParameter; out ParamValue: TValue; out ErrMsg: string): Boolean;
 var
   Arr: array of TValue;

Source/WrapDelphiWindows.pas

@@ -19,7 +19,9 @@ interface
 
 {$IFDEF MSWINDOWS}
 uses
-  Windows, Classes, SysUtils, PythonEngine, WrapDelphi, WrapDelphiClasses;
+  Windows, Classes, SysUtils, TypInfo, PythonEngine, WrapDelphi, WrapDelphiClasses;
+
+function OwnerDrawStateToPython(const AOwnerDrawState: TOwnerDrawState): PPyObject;
 {$ENDIF MSWINDOWS}
 
 implementation
@@ -31,6 +33,27 @@ implementation
   System.Win.HighDpi, Winapi.ShellScaling;
 {$ENDIF DELPHI11_OR_HIGHER}
 
+function OwnerDrawStateToPython(const AOwnerDrawState: TOwnerDrawState): PPyObject;
+
+  procedure Append(const AList: PPyObject; const AString: string);
+  var
+    LItem: PPyObject;
+  begin
+    with GetPythonEngine do begin
+      LItem := PyUnicodeFromString(AString);
+      PyList_Append(AList, LItem);
+      Py_XDecRef(LItem);
+    end;
+  end;
+
+var
+  LState: integer;
+begin
+  Result := GetPythonEngine().PyList_New(0);
+  for LState := Ord(odSelected) to Ord(odComboBoxEdit) do
+    Append(Result, System.TypInfo.GetEnumName(TypeInfo(TOwnerDrawState), LState));
+end;
+
 { Register the wrappers, the globals and the constants }
 type
   TWindowsRegistration = class(TRegisteredUnit)

Source/vcl/WrapVclComCtrls.pas

@@ -2372,6 +2372,7 @@ procedure TTVCreateNodeClassEventHandler.DoEvent(Sender: TCustomTreeView;
 var
   LPyObject, LPyTuple, LPyResult, LPyNodeClass: PPyObject;
   LVarParam: TPyDelphiVarParameter;
+  ErrMsg: string;
   LClass: TClass;
 begin
   Assert(Assigned(PyDelphiWrapper));
@@ -2388,8 +2389,11 @@ procedure TTVCreateNodeClassEventHandler.DoEvent(Sender: TCustomTreeView;
         if Assigned(LPyResult) then begin
           Py_DECREF(LPyResult);
 
-          LClass := TPyDelphiObjectClass(
-            PythonToPythonType(LVarParam.Value).PyObjectClass).DelphiObjectClass;
+          if not ValidateClassRef(LVarParam.Value, TTreeNode, LClass, ErrMsg) then
+          begin
+            InvalidArguments('OnCreateNode', ErrMsg);
+            Exit;
+          end;
 
           NodeClass := TTreeNodeClass(LClass);
         end;
@@ -3647,6 +3651,7 @@ procedure TLVCreateItemClassEventHandler.DoEvent(Sender: TCustomListView;
   LPyObject, LPyTuple, LPyResult, LPyItemClass: PPyObject;
   LVarParam: TPyDelphiVarParameter;
   LClass: TClass;
+  ErrMsg: string;
 begin
   Assert(Assigned(PyDelphiWrapper));
   if Assigned(Callable) and PythonOK() then
@@ -3662,8 +3667,11 @@ procedure TLVCreateItemClassEventHandler.DoEvent(Sender: TCustomListView;
         if Assigned(LPyResult) then begin
           Py_DECREF(LPyResult);
 
-          LClass := TPyDelphiObjectClass(
-            PythonToPythonType(LVarParam.Value).PyObjectClass).DelphiObjectClass;
+          if not ValidateClassRef(LVarParam.Value, TListItem, LClass, ErrMsg) then
+          begin
+            InvalidArguments('OnCreateItem', ErrMsg);
+            Exit;
+          end;
 
           ItemClass := TListItemClass(LClass);
         end;