Fix pyscripter#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;