(*-----------------------------------------------------------------------------
Unit Name: WrapDelphi
Author: Kiriakos Vlahos
Date: 24-Feb-2005
Purpose: Provide automatic wrapping of Delphi variables utilising RTTI
Contributors:
Morgan Martinet ([email protected])
Features:
Published properties and methods compiled with {$METHODINFO ON} are
handled automatically (Note that METHODINFO can be used only with Delphi7
or later, but all the other wrapping features will work with previous
versions of Delphi starting from Delphi5).
Moreover common methods and properties of
the following frequently used Delphi classes are also exported
(Note that this list is not exhaustive):
TObject (ClassName, Free, InheritsFrom)
TPersistent (Assign)
TCollection (sequence interface, Items, Count, Insert, Add, Clear)
TStrings (mapping interface, Text, Add, AddObject, Delete, IndexOf, Clear)
TComponent (Event properties, Subproperties, Owner, ComponentCount, Components)
TControl (Parent)
TWinControl (ControlCount, Controls)
TForm (Show, ShowModal, Release)
TStrings, TCollection.Items, TComponent.Components and
TWinControl.Controls are exposed as sequence/mapping interfaces.
You can also access the Screen and Application objects, and some other
constants like mrOk, mrCancel...
PyDelphiWrapper.RegisterDelphiWrapper allows the customized wrapping of
additional Delphi classes over which you do not have direct control.
PyDelphiWrapper.EventHandlers.RegisterHandler() can be used to add event handling
functionality. TNotify events are handled out-of-the-box. To handle
other types of events you need to write a TEventHandler descendent and
register the EventHandler.
A Module level function CreateComponent(ClassName, Owner) is also exported.
For this function to work, the class needs to be registered using
Classes.RegisterClass (Some classes are already pre-registered like TForm,
TApplication, TScreen, TButton, TCheckBox...).
You can subclass TForm as you would do in Delphi, but you are not able to
override the Delphi methods in Python. There is also a helper
function BindMethodsToEvents that can connect your method handlers to the
component events if you respect a specific pattern for naming your methods:
handle_ComponentName_EventName --> handle_Button1_OnClick
This function is especially useful when you subclass an existing Delphi form,
as the form will already have all the necessary components setup, but you'll
be missing the events to your Python code.
If you subclass Form in Python and name your class with the same name as
an existing Delphi form (that must be registered with RegisterClass),
then this class will be used to instanciate the form instead of the regular empty TForm.
class TTestForm(Form):
def __init__(self, Owner):
self.Caption = self.Caption + ' - changed by Python subclass'
self.BindMethodsToEvents() # this will connect handle_btnAdd_OnClick to btnAdd.OnClick
def handle_btnAdd_OnClick(self, Sender):
self.ListBox1.Items.Add(self.Edit1.Text)
There is also a helper method named SetProps at the TPyDelphiObject level,
allowing any wrapped object to do:
button.SetProps(Left=10, Top=20, Caption='Clickme!)
You can inspect the published properties of any wrapped object by inspecting the
__published__ property.
Note that events requiring var parameters like OnCloseQuery will provide a specific object
containing a single Value property that will hold the actual value of the parameter,
because Python does not allow modifying the parameters:
def handle_close_query(self, sender, accept):
accept.Value = False # accept = False would have not effect!
Usage:
Drop a PyDelphiWrapper component on a form, set its engine and module
properties to a PythonEngine and PythonModule.
Note that it is very important to add each wrapped Delphi unit to your uses
clause or you won't access the specific wrappers as they would not be
registered.
To make it easier, you can simply add the unit WrapDelphiVCL to your uses
clause.
Alternatively create a PyDelphiWrapper component using code,
set its engine and module properties and initialize e.g.
PyDelphiWrapper := TPyDelphiWrapper.Create(Self);
PyDelphiWrapper.Engine := PyEngine;
PyDelphiWrapper.Module := PythonModule;
PyDelphiWrapper.Initialize; // Should only be called if PyDelphiWrapper is created at run time
Use PyDelphiWrapper.Wrap to wrap a given object
var
p : PPyObject;
begin
// Wrap the Form itself.
p := PyDelphiWrapper.Wrap(Form1);
PythonModule.SetVar( 'Form', p );
PyEngine.Py_DecRef(p);
end;
Look at the demos 31 and 32 for further examples of usage.
History:
1.00 24-Feb-2005 Kiriakos Vlahos
Initial release
1.01 12-May-2005 Morgan Martinet
- inherit TPyDelphiWrapper from TPythonClient
- removed type TPythonTypeCustomCreate as TPythonType now has a new attribute GenerateCreateFunction
the custom types didn't use the former CanCreate property and thus CreateComponent conflicted
with the function exposed by TPyDelphiWrapper.
- changed the boolean parameter of TObjectToPyObject into an enumeration, to help understand
when you read the code, if the object is owned or not.
- added property __bound__ to TPyDelphiObject, to know if the wrapper is still bound to the instance.
- added property __owned__ to the base Delphi wrapper, to know if the wrapper owns the underlying
object or not.
- added SqAssItem and SqSlice to the TStringsWrapper
- moved method Show of the Form wrapper to the Control wrapper
- added Exception's message to the exception raised in TPyDelphiMethodObject.Call
- fixed bug in Collection iterator (method Iter and IterNext were swapped)
- refactored iterators with a common base class
- added automatic support of sequences and iterators if the wrapper overrides the GetContainerAccessClass method.
- refactored index checking
- implemented sequence protocol with more collections
- used new class method SetupType for configuring the services exposed by the python type
allowing better polymorphism.
- TStrings wrapper now inherits from TPersistent wrapper.
- Fixed bug in TStrings.SqItem that returned a string instead of a wrapped TObject.
- Changed DelphiObject member field to a property and redefined its type for each subclass,
in order to avoid casting DelphiObject each time need to invoke an attribute.
This was too much error prone, especially with Copy&Paste.
- Added various helper functions to check parameter types.
- Allowed events with TObject subclasses, using an interfaces IFreeNotification/IFreeNotificationSubscriber
- Added helper class TFreeNotificationImpl handling the details of the IFreeNotification implementation.
- Fixed bug when accessing attributes of an unbound wrapper
- Renamed TPyStringsObject into TPyDelphiStrings for consistency
- Changed the TForm wrapper into a TCustomForm wrapper
- Added helper methods ToTuple, ToList to any wrapper supporting sequences (TStrings, TComponent...)
- Added Objects property to TStrings
- TStrings can be accessed with an integer to get the string item or with a key string to get
the associated object.
1.02 23-May-2005 Morgan Martinet
- Wrapped TBasicAction
- Wrapped TActionList
- Wrapped Screen object
- Defined TModalResult constants
- fixed bug when exiting application with Python events still attached -> crash
- fixed bug in event handlers: when destroying an event, only set the handler to nil if it is our handler!
- created TEventHandlers collection
- Moved code that gets/sets events outside of GetAttrO/SetAttrO into TEventHandlers
- return the associated Python handler of an event (in TPyDelphiObject.GetAttrO)
1.03 30-May-2005 Morgan Martinet
- Wrapped TMonitor
- Wrapped TApplication
- The wrappers now will try to receive a free notification from the wrapped object. This will always
work with components and may work with classes that implement IFreeNotification.
- Refactored the registration of wrappers and helper types.
Now you don't have to create your TPythonType instance. This will be done automatically in the
RegisterDelphiWrapper and RegisterHelperType methods.
You can setup the new type by overriding the SetupType class method of TPyObject.
procedure RegisterDelphiWrapper(AWrapperClass : TPyDelphiObjectClass);
RegisterHelperType(APyObjectClass : TPyObjectClass);
Also, note that RegisterDelphiClass as been renamed RegisterDelphiWrapper and there's no
ne need to give the associated Delphi class, as the wrapper class will override a new
class function named DelphiObjectClass that must return the wrapped delphi class.
- Moved wrappers into new dedicated units for each Delphi VCL unit:
WrapDelphiClasses, WrapDelphiControls, WrapDelphiForms, WrapDelphiActnList
- Added a new registration system at the unit level, to allow each dedicated unit to register
the wrappers of the unit's classes.
- New way to define getters/setters by using Class methods instead of global functions,
thanks to Michiel du Toit.
1.04 30-May-2005 Morgan Martinet
- Made WrapDelphi compatible with previous versions of Delphi (below 7):
all the wrapping features are available, and only the dynamic method invocation
relying on {$METHODINFO ON} is disabled. Have to check compilation with D5 to D6.
- Allowed subclassing of components. Introduced new wrappers for TForm and TButton.
- Added new unit WrapDelphiStdCtrls
1.05 11-June-2005 Morgan Martinet
- renamed method TObjectToPyObject into Wrap
- stored default wrapper types pointers into public properties of TPyDelphiWrapper,
for immediate access (instead of doing a lookup in the list).
- added class TPyDelphiVarParameter for handling Delphi var Parameters.
- Defined event for TForm.OnCloseQuery
- Defined event for TForm.OnClose
1.06 13-June-2005 Morgan Martinet
- Created wrappers for all controls of the StdCtrls unit.
- Created wrappers for all controls of the ExtCtrls unit in new unit WrapDelphiExtCtrls.
- Added property __published__ to TPyDelphiObject, that will return the list of all published properties
of the wrapped class. This can be use to know which properties can be accessed and for documenting...
- Made Helper types visible at a module level, because Point, Rect... are helper types.
- Added wrapper for TPoint
- Implemented method TScreen.MonitorFromPoint using Point object.
1.07 25-June-2005 Morgan Martinet
- When creating an instance of a form (with a Python subclass of Form), if the Owner is Application,
then we use Application.CreateForm instead of just instanciating the metaclass, otherwise the Application
will never have a Main form.
- Started making a Python dll module hosting the Delphi wrappers.
- fixed a declaration error of the property setters in TApplication wrapper
- Added method RegisterFunction to TPyDelphiWrapper
- Wrapped api FreeConsole in WrapDelphiForms
- Added method SetProps at the TPyDelphiObject level, allowing any wrapped object to do:
button.SetProps(Left=10, Top=20, Caption='Clickme!)
- Wrapped procedure Abort
- Created new type for wrapping TRect records.
- New behaviour with forms: if you subclass Form in Python and name your class with the same name as
a Delphi form (that must be registered with RegisterClass), then this class will be used to instanciate
the form instead of the regular empty TForm.
- Added a fake get/set method to TPyDelphiObject and create get/set definitions for each published property, using
those fake methods that won't do anything, because the property value will be fetched in the GetAttr method,
before even trying to use the python properties.
This will help a lot documenting existing wrappers, using regular python tools, and it will also allow the
use of the code insight provided by the IDE.
1.08 16-July-2005 Morgan Martinet
- Added method BindMethodsToEvents to TComponent wrapper. It will allow a subclassed form
to automatically bind its controls to the form's methods, if you respect a specific naming
convention. Each method must be named like:
def handle_MyComponent_OnClick(self, sender): pass
Note that for the hooking the form's properties, you have to use a special component name "Self":
def handle_Self_OnCloseQuery(self, sender, CanClose): pass
Note that BindMethodsToEvents accepts a default parameter for specifying the expected prefix,
which defaults to "handle_".
Note that BindMethodsToEvents returns a list of tuples. Each tuple contains:
ComponentName, EventName, MethodObject
This method is especially useful if you create a base form in Delphi, using the form designer,
with no code (or not much), then you subclass this form in Python, provide events that will
be automatically be connected when you invoke BindMethodsToEvents in the __init__ handler.
- Finished cleanup of the property getters (global function --> method)
1.09 18-Dec-2005 Morgan Martinet
- Added new unit WrapDelphiWindows (to define a couple of symbols only)
- Added new unit WrapDelphiComCtrls
- Added new unit WrapDelphiGrids
- Added new unit WrapDelphiGraphics
- Added new unit WrapDelphiButtons
- Wrapped TSize
- Wrapped TCanvas, TGraphic, TBitmap, TMetaFile, TIcon, TPicture
- Wrapped TKeyPressEvent and TKeyEvent
- Made a breaking change when dealing with property sets:
now we expect a sequence of strings. Each string should have the name as the enumeration in the set.
Ex: MainForm.Anchors = ['akLeft', 'akTop']
Of course, a set property will now return a list of strings.
In the past, it would have returned an integer containing all the bits of the set,
and it would have accepted to assign either the same kind of integer value or
a string like "[akLeft, akTop]".
- Made a breaking change when dealing with property enumerations:
return a string representing its value instead of the ordinal value.
- You don't need to call explicitely RegisterClass for your registered Python types as it will be done
automatically for you in RegisterDelphiWrapper. But it is still usefull if you need to create VCL objects
that have no wrapper, using the CreateComponent helper function.
1.10 24-Feb-2006 Morgan Martinet
- Wrapped TPageControl and TTabSheet
1.11 14-Mar-2006 Morgan Martinet
- Added methods Repaint and Invalidate to the TControl wrapper
- Fixed bug when running WrapDelphi without Assertions in the compiler options
thanks to a report from Dominique Whali
- made fields fDefaultIterType and fDefaultContainerType of TPyDelphiWrapper protected
Oct-2019 PyScripter
- Major refactoring and clean-up
- In Delhi version newer than XE, enhanced RTTI is used to provide access to
methods, fields and properties. So in most cases you no longer need to
create wrapping classes.
- __published__ property was replaced with the implementation of the __dir__()
method, so that you can do for example dir(MainForm) to inspect the
methods, fields and properties of MainForm.
- Demo 31 has been updated to test/showcase some of the new features.
Apr-2020 PyScripter
- Wrapping of Records using extended RTTI
- Wrapping of Interfaces using extended RTTI (see unit tests)
TODO:
- Extend SetProps: if property receiving the value is a TStrings and the value a sequence,
then assign the sequence content to the TStrings.
- can we debug the Python code executed from a triggered event? Presently not, as we directly ask Python
to execute a specific callable...
- Create a simple app that just initializes Python and executes a script? To avoid having a console...
- Bug with Delphi pyd: can't change the application title, because TApplication creates its own handle
- Wrap TApplicationEvents. In fact define the events used by TApplicationEvents.
- Wrap TMenu and Toolbar
- Wrap TObjectList
- Unit Test all exposed attributes
- Wrap simple types like TMessage
- Generate Documentation from available metainformation (see __members__, ClassName...)
- Allow Wrappers to handle IFreeNotification for the wrapped object when the object does not
support it, only when the wrapper knows that it is safe enough (singleton delphi object)
- Be able to return an object containing the current event handler of any Delphi object that was hooked by Delphi,
and not by Python, as presently, if a button has a Delphi OnClick event, inspecting this event from Python
will return None.
-----------------------------------------------------------------------------*)
{$I Definition.Inc}
unit WrapDelphi;
interface
uses
SysUtils, Classes, PythonEngine, TypInfo,
Variants,
{$IFNDEF FPC}
{$IFDEF EXTENDED_RTTI}
Rtti,
{$ELSE}
ObjAuto,
{$ENDIF}
{$ENDIF}
Contnrs;
Type
TObjectOwnership = (soReference, soOwned);
// forward declaration
TPyDelphiWrapper = class;
{
If you want to benefit from subscribing to events from Python when your
wrapped class does not inherit from TComponent, then you can simply
implement the IFreeNotification, store the subscriber event sink and
trigger its Notify method in your destructor.
Note that TFreeNotificationImpl does all the plumbing for you.
}
IFreeNotificationSubscriber = interface
['{F08FB6EA-3D8B-43C0-8343-77C8E06DE401}']
procedure Notify(ADeletedObject : TObject);
end;
IFreeNotification = interface
['{085FD1BB-44FC-457A-B357-4E06071BBEA5}']
procedure Subscribe(const ASubscriber: IFreeNotificationSubscriber);
procedure UnSubscribe(const ASubscriber: IFreeNotificationSubscriber);
end;
{ Helper class that handles the detail of implementing IFreeNotification.
Usage:
TMyClass = class(TInterfacedObject, IFreeNotification)
private
fFreeNotifImpl : IFreeNotification;
protected
property FreeNotifImpl : IFreeNotification read fFreeNotifImpl implements IFreeNotification;
public
constructor Create;
end;
constructor TMyClass.Create;
begin
fFreeNotifImpl := TFreeNotificationImpl.Create(Self);
end;
}
TFreeNotificationImpl = class(TInterfacedObject, IFreeNotification)
private
fSubscribers : TInterfaceList;
fOwner: TObject;
function GetSubscribers : TInterfaceList;
protected
// implementation of IFreeNotification
procedure Subscribe(const ASubscriber: IFreeNotificationSubscriber);
procedure UnSubscribe(const ASubscriber: IFreeNotificationSubscriber);
public
constructor Create(AOwner : TObject);
destructor Destroy; override;
property Owner : TObject read fOwner;
end;
{
This class helps wrappers to implement sequence and iterator protocols.
You must subclass it, override GetItem, GetSize.
If you override IndexOf, then you must override SupportsIndexOf and return True.
If you override SetItem, then you must override SupportsWrite and return True.
You can give a specific name to the container if you override the Name function.
Note that an instance of this class must belong to a single owner, if you want
to give it to another class (like a container to an iterator, then you must
clone it).
}
TContainerAccess = class
private
fContainer: TObject;
fWrapper: TPyDelphiWrapper;
protected
function Wrap(Obj : TObject; Ownership: TObjectOwnership = soReference) : PPyObject;
public
constructor Create(AWrapper : TPyDelphiWrapper; AContainer: TObject); virtual;
function Clone : TContainerAccess; virtual;
function GetItem(AIndex : Integer) : PPyObject; virtual; abstract;
function GetSize : Integer; virtual; abstract;
function IndexOf(AValue : PPyObject) : Integer; virtual;
function SetItem(AIndex : Integer; AValue : PPyObject) : Boolean; virtual;
class function ExpectedContainerClass : TClass; virtual; abstract;
class function Name : string; virtual;
class function SupportsWrite : Boolean; virtual;
class function SupportsIndexOf : Boolean; virtual;
property Container : TObject read fContainer;
property Wrapper : TPyDelphiWrapper read fWrapper;
end;
TContainerAccessClass = class of TContainerAccess;
{
Abstract sequence relying on the container access protocol.
This will help us support the VCL way to access elements,
for instance: form.Components[i]
Note that we could simply write form[i], but then we might use it for
form.Controls[i] (as Components would be the default sequence).
As the sequence supports iterators, you can also write:
for i in form: pass
for i in form.Components: pass
for i in form.Controls: pass
}
TPyDelphiContainer = class(TPyObject)
private
fContainerAccess: TContainerAccess;
fPyDelphiWrapper: TPyDelphiWrapper;
public
destructor Destroy; override;
procedure Setup(APyDelphiWrapper : TPyDelphiWrapper; AContainerAccess : TContainerAccess);
class procedure SetupType( PythonType : TPythonType ); override;
function Repr : PPyObject; override;
function Iter : PPyObject; override;
// Sequence services
function SqLength : NativeInt; override;
function SqItem( idx : NativeInt ) : PPyObject; override;
function SqAssItem( idx : NativeInt; obj : PPyObject) : Integer; override;
function SqSlice( idx1, idx2 : NativeInt ) : PPyObject; override;
function SqContains( obj: PPyObject): integer; override;
// Properties
property ContainerAccess : TContainerAccess read fContainerAccess;
property PyDelphiWrapper : TPyDelphiWrapper read fPyDelphiWrapper;
end;
{
Abstract iterator relying on the container access protocol.
}
TPyDelphiIterator = class(TPyObject)
private
fPosition: Integer;
fContainerAccess: TContainerAccess;
public
destructor Destroy; override;
procedure Setup(AContainerAccess : TContainerAccess);
class procedure SetupType( PythonType : TPythonType ); override;
function Repr : PPyObject; override;
function Iter : PPyObject; override;
function IterNext : PPyObject; override;
// Properties
property Position : Integer read fPosition;
property ContainerAccess : TContainerAccess read fContainerAccess;
end;
{
Base class allowing us to implement interfaces.
}
TPyInterfacedObject = class(TPyObject, IInterface)
private
// implementation of interface IInterface
{$IFDEF FPC_HAS_CONSTREF}
function QueryInterface(constref IID: TGUID; out Obj): HResult; {$IFDEF MSWINDOWS}stdcall{$ELSE}cdecl{$ENDIF};
function _AddRef: Integer; {$IFDEF MSWINDOWS}stdcall{$ELSE}cdecl{$ENDIF};
function _Release: Integer; {$IFDEF MSWINDOWS}stdcall{$ELSE}cdecl{$ENDIF};
{$ELSE}
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
{$ENDIF}
end;
{
PyObject wrapping TObject
Exposes published properties and methods
Also exposes the property ClassName and methods InheritesFrom and Free
Do not create TPyDelphi or its subclasses directly - Instead use
PyDelphiWrapper.Wrap
}
TPyDelphiObject = class (TPyInterfacedObject, IFreeNotificationSubscriber)
private
fDelphiObject: TObject;
fContainerAccess : TContainerAccess;
function GetContainerAccess: TContainerAccess;
procedure SetDelphiObject(const Value: TObject);
protected
fCanFreeOwnedObject : Boolean;
function CheckBound : Boolean;
function HasContainerAccessClass : Boolean;
procedure SubscribeToFreeNotification; virtual;
procedure UnSubscribeToFreeNotification; virtual;
class function GetTypeName : string; virtual;
// Exposed Methods
function Free_Wrapper(args : PPyObject) : PPyObject; cdecl;
function InheritsFrom_Wrapper(args : PPyObject) : PPyObject; cdecl;
function ToTuple_Wrapper(args : PPyObject) : PPyObject; cdecl;
function ToList_Wrapper(args : PPyObject) : PPyObject; cdecl;
function SetProps(args, keywords : PPyObject) : PPyObject; cdecl;
function Dir_Wrapper(args: PPyObject): PPyObject; cdecl;
// Exposed Getters
function Get_ClassName(Acontext : Pointer) : PPyObject; cdecl;
function Get_Owned(Acontext : Pointer) : PPyObject; cdecl;
function Get_Bound(Acontext : Pointer) : PPyObject; cdecl;
// implementation of interface IFreeNotificationSubscriber
procedure Notify(ADeletedObject : TObject);
public
PyDelphiWrapper : TPyDelphiWrapper;
Owned: Boolean;
constructor Create( APythonType : TPythonType ); override;
destructor Destroy; override;
function GetAttrO( key: PPyObject) : PPyObject; override;
function SetAttrO( key, value: PPyObject) : Integer; override;
// Objects are equal when they refer to the same DelphiObject
function Compare( obj: PPyObject) : Integer; override;
function Repr : PPyObject; override;
// automatic iterator support when the wrapper implements IContainerAccessProvider
function Iter : PPyObject; override;
// Sequence services
function SqLength : NativeInt; override;
function SqItem( idx : NativeInt ) : PPyObject; override;
function SqSlice( idx1, idx2 : NativeInt ) : PPyObject; override;
function SqContains( obj: PPyObject): integer; override;
function SqAssItem( idx : NativeInt; obj : PPyObject) : Integer; override;
class function DelphiObjectClass : TClass; virtual;
class procedure RegisterMethods( PythonType : TPythonType ); override;
class procedure RegisterGetSets( PythonType : TPythonType ); override;
class procedure SetupType( PythonType : TPythonType ); override;
// if the class is a container (TStrings, TComponent, TCollection...),
// then return the class implementing the access to the contained items.
class function GetContainerAccessClass : TContainerAccessClass; virtual;
// creates a container access object using the class returned by GetContainerAccess.
function CreateContainerAccess : TContainerAccess; virtual;
// helper methods
function Wrap(AObject : TObject; AOwnership: TObjectOwnership = soReference) : PPyObject;
// Properties
property DelphiObject: TObject read fDelphiObject write SetDelphiObject;
property ContainerAccess : TContainerAccess read GetContainerAccess;
end;
TPyDelphiObjectClass = class of TPyDelphiObject;
{ This class will simply hold a Python object in its Value property.
This is required for Delphi var parameters because Python won't let you
replace a parameter value with another one, so, we will provide a container
and you'll be able to change its content. }
TPyDelphiVarParameter = class(TPyObject)
private
fValue: PPyObject;
procedure SetValue(const Value: PPyObject);
protected
// Exposed Getters
function Get_Value(Acontext : Pointer) : PPyObject; cdecl;
// Exposed Setters
function Set_Value(AValue : PPyObject; AContext : Pointer) : Integer; cdecl;
public
destructor Destroy; override;
function RichCompare( obj : PPyObject; Op : TRichComparisonOpcode) : PPyObject; override;
function Repr : PPyObject; override;
class procedure RegisterGetSets( PythonType : TPythonType ); override;
class procedure SetupType( PythonType : TPythonType ); override;
property Value : PPyObject read fValue write SetValue;
end;
{$IFDEF EXTENDED_RTTI}
{ Base class for exposing Records and Interfaces when Extended RTTI is available }
TPyRttiObject = class (TPyObject)
private
fAddr: Pointer;
fRttiType: TRttiStructuredType;
function GetValue: TValue; virtual; abstract;
protected
// Exposed Methods
function SetProps(args, keywords : PPyObject) : PPyObject; cdecl;
function Dir_Wrapper(args: PPyObject): PPyObject; cdecl;
public
PyDelphiWrapper : TPyDelphiWrapper;
constructor Create( APythonType : TPythonType ); override;
procedure SetAddrAndType(Address: Pointer; Typ: TRttiStructuredType);
function GetAttrO( key: PPyObject) : PPyObject; override;
function SetAttrO( key, value: PPyObject) : Integer; override;
function Repr : PPyObject; override;
property Addr: Pointer read fAddr;
property RttiType: TRttiStructuredType read fRttiType;
property Value: TValue read GetValue;
//
class procedure RegisterMethods( PythonType : TPythonType ); override;
class procedure SetupType( PythonType : TPythonType ); override;
end;
TPyPascalRecord = class(TPyRttiObject)
private
function GetValue: TValue; override;
public
class procedure SetupType( PythonType : TPythonType ); override;
end;
TPyPascalInterface = class(TPyRttiObject)
private
function GetValue: TValue; override;
public
class procedure SetupType( PythonType : TPythonType ); override;
end;
{$ENDIF}
TEventHandler = class
private
fComponent: TObject;
public
PyDelphiWrapper : TPyDelphiWrapper;
PropertyInfo : PPropInfo;
EventType : PTypeInfo;
Callable : PPyObject;
// connects to the event on creation
constructor Create(PyDelphiWrapper : TPyDelphiWrapper; Component : TObject;
PropertyInfo : PPropInfo; Callable : PPyObject); virtual;
// Disconnects from the event on destruction
destructor Destroy; override;
// Disconnects from the free notification event now
procedure Unsubscribe;
// returns the type info of the supported event
class function GetTypeInfo : PTypeInfo; virtual; abstract;
// properties
property Component : TObject read fComponent;
end;
TEventHandlerClass = class of TEventHandler;
TEventHandlers = class
private
fItems : TObjectList;
fRegisteredClasses : TClassList;
fPyDelphiWrapper: TPyDelphiWrapper;
function GetCount: Integer;
function GetItem(AIndex: Integer): TEventHandler;
function GetRegisteredClass(AIndex: Integer): TEventHandlerClass;
function GetRegisteredClassCount: Integer;
protected
function FindHandler(ATypeInfo : PTypeInfo) : TEventHandlerClass;
property RegisteredClasses[AIndex : Integer] : TEventHandlerClass read GetRegisteredClass;
property RegisteredClassCount : Integer read GetRegisteredClassCount;
public
constructor Create(APyDelphiWrapper : TPyDelphiWrapper);
destructor Destroy; override;
function Add(AEventHandler : TEventHandler) : Boolean;
procedure Clear;
procedure Delete(AIndex : Integer);
function GetCallable(AComponent : TObject; APropInfo : PPropInfo) : PPyObject; overload;
function GetCallable(AComponent : TObject; const APropName : string) : PPyObject; overload;
function Link(AComponent : TObject; APropInfo : PPropInfo;
ACallable : PPyObject; out ErrMsg: string) : Boolean;
function IndexOf(AComponent : TObject; APropInfo : PPropInfo) : Integer;
procedure RegisterHandler(AEventHandlerClass : TEventHandlerClass);
function Unlink(AComponent : TObject; APropInfo : PPropInfo) : Boolean;
property Count : Integer read GetCount;
property Items[AIndex : Integer] : TEventHandler read GetItem; default;
property PyDelphiWrapper : TPyDelphiWrapper read fPyDelphiWrapper;
end;
TNotifyEventHandler = class(TEventHandler)
protected
procedure DoEvent(Sender: TObject);
public
constructor Create(PyDelphiWrapper : TPyDelphiWrapper; Component : TObject;
PropertyInfo : PPropInfo; Callable : PPyObject); override;
class function GetTypeInfo : PTypeInfo; override;
end;
{ Subclass TRegisteredUnit to register your wrappers for a specific unit.
See WrapDelphiForms which will wrapp some of the classes of the Forms.pas unit.
type
TFormsRegistration = class(TRegisteredUnit)
public
function Name : string; override;
procedure RegisterWrappers(APyDelphiWrapper : TPyDelphiWrapper); override;
procedure DefineVars(APyDelphiWrapper : TPyDelphiWrapper); override;
end;
procedure TFormsRegistration.DefineVars(APyDelphiWrapper: TPyDelphiWrapper);
begin
inherited;
// Singletons
APyDelphiWrapper.DefineVar('Application', Application);
APyDelphiWrapper.DefineVar('Screen', Screen);
// MessageBox flags
APyDelphiWrapper.DefineVar('MB_ABORTRETRYIGNORE', MB_ABORTRETRYIGNORE);
APyDelphiWrapper.DefineVar('MB_OK', MB_OK);
end;
function TFormsRegistration.Name: string;
begin
Result := 'Forms';
end;
procedure TFormsRegistration.RegisterWrappers(APyDelphiWrapper: TPyDelphiWrapper);
begin
inherited;
APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiCustomForm);
APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiApplication);
APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiScreen);
APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiMonitor);
APyDelphiWrapper.EventHandlers.RegisterHandler(TCloseQueryEventHandler);
end;
You must also register this class to the RegisteredUnits singleton like this:
initialization
RegisteredUnits.Add(TFormsRegistration.Create);
}
TRegisteredUnit = class
public
function Name : string; virtual; abstract;
procedure RegisterWrappers(APyDelphiWrapper : TPyDelphiWrapper); virtual;
procedure DefineVars(APyDelphiWrapper : TPyDelphiWrapper); virtual;
procedure DefineFunctions(APyDelphiWrapper : TPyDelphiWrapper); virtual;
end;
{ Singleton containing all registered units.
This will be used by TPyDelphiWrapper for registering the wrappers of
classes contained in those units.
The advantage is that we can select what we want to wrap simply by
including the Wrapped units into the project, and thus avoid code bloating
if we don't need those units.
}
TRegisteredUnits = class
private
fItems : TObjectList;
function GetCount: Integer;
function GetItem(AIndex: Integer): TRegisteredUnit;
public
constructor Create;
destructor Destroy; override;
procedure Add(ARegisteredModule : TRegisteredUnit);
property Count : Integer read GetCount;
property Items[AIndex : Integer] : TRegisteredUnit read GetItem; default;
end;
{
The main component of this unit.
Method Wrap wraps Delphi objects into Python objects
Method RegisterDelphiWrapper can be used to extend its functionality.
Method EventHandlers.RegisterHandler can be used to add event handling functionality
}
{$IF not Defined(FPC) and (CompilerVersion >= 23)}
[ComponentPlatformsAttribute(pidSupportedPlatforms)]
{$IFEND}
TPyDelphiWrapper = class(TEngineClient, IFreeNotificationSubscriber)
private
// Stores Delphi class registration information
fClassRegister : TObjectList;
// Stores registration for Helper Types (do not correspond to Delphi classes)
fHelperClassRegister : TStringList;
// Stores Created Event Handlers
fEventHandlerList : TEventHandlers;
fVarParamType: TPythonType;
{$IFNDEF FPC}
fDelphiMethodType: TPythonType;
{$ENDIF}
{$IFDEF EXTENDED_RTTI}
fRecordType: TPythonType;
fInterfaceType: TPythonType;
{$ENDIF}
// Exposed Module level function CreateComponent(ComponentClass, Owner)
function CreateComponent( pself, args : PPyObject ) : PPyObject; cdecl;
// Implementation of interface IFreeNotificationSubscriber
procedure Notify(ADeletedObject : TObject);
protected
FModule : TPythonModule;
fDefaultIterType: TPythonType;
fDefaultContainerType: TPythonType;
procedure CreateWrappers; virtual;
procedure CreateModuleVars; virtual;
procedure CreateModuleFunctions; virtual;
procedure SetEngine(Value : TPythonEngine ); override;
procedure SetModule(const Value: TPythonModule);
procedure Notification( AComponent: TComponent;
Operation: TOperation); override;
procedure ModuleReady(Sender : TObject); override;
procedure UnsubscribeFreeNotifications;
procedure CreatePyFunc(AModule : TPythonModule; AMethodDef : PPyMethodDef);
public
constructor Create( AOwner : TComponent ); override;
destructor Destroy; override;
procedure Initialize; override;
procedure Finalize; override;
procedure DefineVar(const AName : string; const AValue : Variant); overload;
procedure DefineVar(const AName : string; AValue : TObject); overload;
procedure RegisterDelphiWrapper(AWrapperClass : TPyDelphiObjectClass);
function RegisterHelperType(APyObjectClass : TPyObjectClass) : TPythonType;
function RegisterFunction(AFuncName : PAnsiChar; AFunc : PyCFunction; ADocString : PAnsiChar ): PPyMethodDef; overload;
function RegisterFunction(AFuncName : PAnsiChar; AFunc : TDelphiMethod; ADocString : PAnsiChar ): PPyMethodDef; overload;
function GetHelperType(TypeName : string) : TPythonType;
// Function that provides a Python object wrapping an object
function Wrap(AObj : TObject; AOwnership: TObjectOwnership = soReference) : PPyObject;
{$IFDEF EXTENDED_RTTI}
// Function that provides a Python object wrapping a record
function WrapRecord(Address: Pointer; Typ: TRttiStructuredType): PPyObject;
// Function that provides a Python object wrapping an interface
// Note the the interface must be compiled in {$M+} mode and have a guid
// Usage: WrapInterface(TValue.From(YourInterfaceReference))
function WrapInterface(IValue: TValue): PPyObject;
{$ENDIF}
// properties
property EventHandlers : TEventHandlers read fEventHandlerList;
// Helper types
property DefaultContainerType : TPythonType read fDefaultContainerType;
property DefaultIterType : TPythonType read fDefaultIterType;
{$IFNDEF FPC}
property DelphiMethodType : TPythonType read fDelphiMethodType;
{$ENDIF}
property VarParamType : TPythonType read fVarParamType;
published
property Module : TPythonModule read FModule write SetModule;
end;
{ Singletons }
function RegisteredUnits : TRegisteredUnits;
{ Misc }
procedure Register;
{ Helper Functions }
function CheckIndex(AIndex, ACount : Integer; const AIndexName : string = 'Index') : Boolean;
function CheckIntAttribute(AAttribute : PPyObject; const AAttributeName : string; out AValue : Integer) : Boolean;
function CheckBoolAttribute(AAttribute : PPyObject; const AAttributeName : string; out AValue : Boolean) : Boolean;
function CheckStrAttribute(AAttribute : PPyObject; const AAttributeName : string; out AValue : string) : Boolean;
function CheckObjAttribute(AAttribute : PPyObject; const AAttributeName : string;
AExpectedClass : TClass;
out AValue : TObject) : Boolean;
function CheckCallableAttribute(AAttribute : PPyObject; const AAttributeName : string) : Boolean;
function CheckEnum(const AEnumName : string; AValue, AMinValue, AMaxValue : Integer) : Boolean;
function CreateSlice(ASequence : TPyObject; AIndex1, AIndex2 : Integer) : PPyObject;
function CreateVarParam(PyDelphiWrapper : TPyDelphiWrapper; const AValue : Variant) : PPyObject;
function SetToPython(ATypeInfo: PTypeInfo; AValue : Integer) : PPyObject; overload;
function SetToPython(APropInfo: PPropInfo; AValue : Integer) : PPyObject; overload;
function SetToPython(AInstance: TObject; APropInfo: PPropInfo) : PPyObject; overload;
function PythonToSet(APropInfo: PPropInfo; ASet : PPyObject) : Integer; overload;
function PythonToSet(ATypeInfo: PTypeInfo; ASet : PPyObject) : Integer; overload;
function SupportsFreeNotification(AObject : TObject) : Boolean;
procedure RaiseNotifyEvent(PyDelphiWrapper : TPyDelphiWrapper; ACallable : PPyObject; Sender: TObject);
{Sets mulptiple properties of PyObject from keywords argument}
function SetProperties(PyObject: PPyObject; keywords: PPyObject): PPyObject;
implementation
Uses
Math,
RTLConsts;
resourcestring
rs_ErrCheckIndex = '%s "%d" out of range';
rs_ErrCheckInt = '%s receives only integer values';
rs_ErrCheckStr = '%s receives only string values';
rs_ErrCheckCallable = '%s accepts only None or Callable values';
rs_ErrCheckEnum = 'Enum %s accepts values between %d and %d. Received %d.';
rs_ErrCheckObjOfType = '%s receives only Delphi objects of type %s';
rs_ErrCheckObj = '%s receives only Delphi objects';
rs_ErrSqAss = 'Container %s does not support indexed write (f[i] = x)';
rs_ErrSqContains = 'Container %s does not support the Contains protocol';
rs_ErrCheckBound = 'Delphi wrapper %s is not bound';
rs_ErrFree = 'The Delphi object cannot be freed, since it is not Owned';
rs_ErrSequence = 'Wrapper %s does not support sequences';
rs_ErrInvalidArgs = '"%s" called with invalid arguments.'#$A'Error: %s';
rs_ErrInvalidRet = 'Call "%s" returned a value that could not be coverted to Python'#$A'Error: %s';
rs_IncompatibleArguments = 'Could not find a method with compatible arguments';
rs_ErrAttrGet = 'Error in getting property "%s".'#$A'Error: %s';
rs_UnknownAttribute = 'Unknown attribute';
rs_ErrIterSupport = 'Wrapper %s does not support iterators';
rs_ErrAttrSetr = 'Error in setting property %s'#$A'Error: %s';
rs_IncompatibleClasses = 'Incompatible classes';
rs_IncompatibleRecords = 'Incompatible record types';
rs_IncompatibleInterfaces = 'Incompatible interfaces';
rs_NotPublished = 'Event handling is available only for published properties';
rs_ExpectedObject = 'Expected a Pascal object';
rs_ExpectedRecord = 'Expected a Pascal record';
rs_ExpectedInterface = 'Expected a Pascal interface';
rs_InvalidClass = 'Invalid class';
rs_ErrEventNotReg = 'No Registered EventHandler for events of type "%s';
rs_ErrEventNoSuport = 'Class %s does not support events because it must '+
'either inherit from TComponent or implement interface IFreeNotification';
rs_ErrEventExpectCallable = 'You can only assign a callable to method property "%s"';
rs_NotWritable = 'The class members is not writable';
rs_NotReadable = 'The class member is not readable';
rs_NoAccess = 'Private and protected class members cannot be accessed';
rs_ErrValueToPython = 'Unsupported conversion from TValue to Python value';
rs_ErrPythonToValue = 'Unsupported conversion from Python value to TValue';
rs_ErrNoTypeInfo = 'TypeInfo is not available';
rs_ErrUnexpected = 'Unexpected error';
var
gRegisteredUnits : TRegisteredUnits;
function RegisteredUnits : TRegisteredUnits;
begin
if not Assigned(gRegisteredUnits) then
gRegisteredUnits := TRegisteredUnits.Create;
Result := gRegisteredUnits;
end;
procedure Register;
begin
RegisterComponents('Python', [TPyDelphiWrapper]);
end;
{ Helper functions }
{$IFDEF EXTENDED_RTTI}
function SimpleValueToPython(const Value: TValue; out ErrMsg: string): PPyObject;
begin
Result := nil;
if Value.IsEmpty then begin
Result := GetPythonEngine.ReturnNone;
Exit;
end;
try
case Value.TypeInfo^.Kind of
tkUnknown: Result := GetPythonEngine.ReturnNone;
tkInteger, tkChar, tkFloat,
tkString, tkWChar, tkLString,
tkWString, tkUString, tkInt64,
tkVariant:
Result := GetPythonEngine.VariantAsPyObject(Value.AsVariant);
tkEnumeration:
begin
if Value.TypeInfo = TypeInfo(Boolean) then
with GetPythonEngine do begin
if Value.AsBoolean then
Result := PPyObject(Py_True)
else
Result := PPyObject(Py_False);
Py_XIncRef(Result);
end
else
Result := GetPythonEngine.PyString_FromDelphiString(GetEnumName(Value.TypeInfo,
PInteger(Value.GetReferenceToRawData)^));
end;
tkSet:
begin
Result := SetToPython(Value.TypeData.CompType^,
PInteger(Value.GetReferenceToRawData)^);
end;
tkClass, tkMethod, tkArray,
tkRecord, tkInterface, tkDynArray,
tkClassRef, tkPointer, tkProcedure:
ErrMsg := rs_ErrValueToPython;
else
ErrMsg := rs_ErrUnexpected;
end;
except
on E: Exception do begin
Result := nil;
ErrMsg := E.Message;
end;
end;
end;
function SimplePythonToValue(PyValue: PPyObject; TypeInfo: PTypeInfo;
out Value: TValue; out ErrMsg: string): Boolean;
Var
S: string;
I : integer;
V : TValue;
begin
Result := False;
if TypeInfo = nil then begin
ErrMsg := rs_ErrNoTypeInfo;
Exit;
end;
try
case TypeInfo^.Kind of
tkUnknown:
if PyValue = GetPythonEngine.Py_None then
begin
Value := TValue.Empty;
Result := True;
end
else
ErrMsg := rs_ErrPythonToValue;
tkString, tkWString, tkUString,
tkLString, tkChar, tkWChar:
begin
V := GetPythonEngine.PyObjectAsString(PyValue);
Value := V.Cast(TypeInfo);
Result := True;
end;
tkInteger, tkFloat, tkInt64,
tkVariant:
begin
V := TValue.FromVariant(GetPythonEngine.PyObjectAsVariant(PyValue));
Value := V.Cast(TypeInfo);
Result := True;
end;
tkEnumeration:
begin
S := GetPythonEngine.PyString_AsDelphiString(PyValue);
I := GetEnumValue(TypeInfo, S);
Value := TValue.FromOrdinal(TypeInfo, I);
Result := True;
end;
tkSet:
begin
I := PythonToSet(TypeInfo, PyValue);
TValue.Make(@I, TypeInfo, Value);
Result := True;
end;
tkClass, tkMethod, tkArray,
tkRecord, tkInterface, tkDynArray,
tkClassRef, tkPointer, tkProcedure:
ErrMsg := rs_ErrPythonToValue;
else
ErrMsg := rs_ErrUnexpected;
end;
except
on E: Exception do begin
Result := False;
ErrMsg := E.Message;
end;
end
end;
function ValidateRecordProperty(PyValue: PPyObject; TypeInfo: PTypeInfo;
out RecValue: TValue; out ErrMsg: string): Boolean;
var
PyObject : TPyObject;
begin
Result := False;
if IsDelphiObject(PyValue) then
begin
PyObject := PythonToDelphi(PyValue);
if PyObject is TPyPascalRecord then
begin
RecValue := TPyPascalRecord(PyObject).Value;
if RecValue.TypeInfo = TypeInfo then
Result := True
else
ErrMsg := rs_IncompatibleRecords;
end
else
ErrMsg := rs_ExpectedRecord;
end
else
ErrMsg := rs_ExpectedRecord;
end;
function ValidateInterfaceProperty(PyValue: PPyObject; RttiType: TRttiInterfaceType;
out IValue: TValue; out ErrMsg: string): Boolean;
var
PyObject : TPyObject;
begin
if PyValue = GetPythonEngine.Py_None then begin
Result := True;
TValue.Make(nil, RttiType.Handle, IValue);
Exit;
end;
Result := False;
if IsDelphiObject(PyValue) then
begin
PyObject := PythonToDelphi(PyValue);
if PyObject is TPyPascalInterface then
begin
IValue := TPyPascalInterface(PyObject).Value;
if Supports(IValue.AsInterface, RttiType.GUID) then
Result := True
else
ErrMsg := rs_IncompatibleInterfaces;
end
else
ErrMsg := rs_ExpectedInterface;
end
else
ErrMsg := rs_ExpectedInterface;
end;
{$ENDIF}
function ValidateClassProperty(PyValue: PPyObject; TypeInfo: PTypeInfo;
out Obj: TObject; out ErrMsg: string): Boolean;
var
PyObject : TPyObject;
begin
if PyValue = GetPythonEngine.Py_None then begin
Result := True;
Obj := nil;
Exit;
end;
Result := False;
if IsDelphiObject(PyValue) then
begin
PyObject := PythonToDelphi(PyValue);
if PyObject is TPyDelphiObject then
begin
Obj := TPyDelphiObject(PyObject).DelphiObject;
if Obj.ClassType.InheritsFrom(GetTypeData(TypeInfo).ClassType) then
Result := True
else
ErrMsg := rs_IncompatibleClasses;
end
else
ErrMsg := rs_ExpectedObject;
end
else
ErrMsg := rs_ExpectedObject;
end;
function CheckIndex(AIndex, ACount : Integer; const AIndexName : string = 'Index') : Boolean;
begin
if (AIndex < 0) or (AIndex >= ACount) then
with GetPythonEngine do
begin
Result := False;
PyErr_SetObject (PyExc_IndexError^, PyString_FromDelphiString(
Format(rs_ErrCheckIndex,[AIndexName, AIndex])));
end
else
Result := True;
end;
function CheckIntAttribute(AAttribute : PPyObject; const AAttributeName : string; out AValue : Integer) : Boolean;
begin
if GetPythonEngine.PyInt_Check(AAttribute) then
begin
AValue := GetPythonEngine.PyInt_AsLong(AAttribute);
Result := True;
end
else
begin
Result := False;
with GetPythonEngine do
PyErr_SetObject (PyExc_AttributeError^,
PyString_FromDelphiString(Format(rs_ErrCheckInt, [AAttributeName])));
end;
end;
function CheckBoolAttribute(AAttribute : PPyObject; const AAttributeName : string; out AValue : Boolean) : Boolean;
begin
AValue := GetPythonEngine.PyObject_IsTrue(AAttribute) <> 0;
Result := True;
end;
function CheckStrAttribute(AAttribute : PPyObject; const AAttributeName : string; out AValue : string) : Boolean;
begin
if GetPythonEngine.PyString_Check(AAttribute) then
begin
AValue := GetPythonEngine.PyString_AsDelphiString(AAttribute);
Result := True;
end
else
begin
Result := False;
with GetPythonEngine do
PyErr_SetObject (PyExc_AttributeError^,
PyString_FromDelphiString(Format(rs_ErrCheckStr, [AAttributeName])));
end;
end;
function CheckCallableAttribute(AAttribute : PPyObject; const AAttributeName : string) : Boolean;
begin
if (AAttribute = GetPythonEngine.Py_None) or (GetPythonEngine.PyCallable_Check(AAttribute) <> 0) then
Result := True
else
begin
Result := False;
with GetPythonEngine do
PyErr_SetObject (PyExc_AttributeError^,
PyString_FromDelphiString(Format(rs_ErrCheckCallable, [AAttributeName])));
end;
end;
function CheckEnum(const AEnumName : string; AValue, AMinValue, AMaxValue : Integer) : Boolean;
begin
if (AValue >= AMinValue) and (AValue <= AMaxValue) then
Result := True
else
begin
Result := False;
with GetPythonEngine do
PyErr_SetObject (PyExc_AttributeError^,
PyString_FromDelphiString(Format(rs_ErrCheckEnum,
[AEnumName, AMinValue, AMaxValue, AValue])));
end;
end;
function CheckObjAttribute(AAttribute : PPyObject; const AAttributeName : string;
AExpectedClass : TClass;
out AValue : TObject) : Boolean;
var
PyObject : TPyObject;
begin
if AAttribute = GetPythonEngine.Py_None then
begin
Result := True;
AValue := nil;
end
else if IsDelphiObject(AAttribute) then
begin
PyObject := PythonToDelphi(AAttribute);
if not (PyObject is TPyDelphiObject) or
not (TPyDelphiObject(PyObject).DelphiObject.InheritsFrom(AExpectedClass)) then
begin
Result := False;
with GetPythonEngine do
PyErr_SetObject (PyExc_AttributeError^,
PyString_FromDelphiString(Format(rs_ErrCheckObjOfType, [AAttributeName, AExpectedClass.ClassName])));
end
else
begin
Result := True;
AValue := TPyDelphiObject(PyObject).DelphiObject;
end;
end
else
begin
Result := False;
with GetPythonEngine do
PyErr_SetObject (PyExc_AttributeError^,
PyString_FromDelphiString(Format(rs_ErrCheckObj, [AAttributeName])));
end;
end;
function CreateSlice(ASequence : TPyObject; AIndex1, AIndex2 : Integer) : PPyObject;
var
i : Integer;
tmp : Integer;
begin
if not CheckIndex(AIndex1, ASequence.SqLength, 'Index1') then
Result := nil
else if not CheckIndex(AIndex2, ASequence.SqLength, 'Index2') then
Result := nil
else with GetPythonEngine do
begin
if AIndex1 > AIndex2 then
begin
tmp := AIndex2;
AIndex2 := AIndex1;
AIndex1 := tmp;
end;
Result := PyTuple_New(AIndex2-AIndex1+1);
for i := 0 to PyTuple_Size(Result)-1 do
PyTuple_SetItem(Result, i, ASequence.SqItem(AIndex1));
end;
end;
function CreateVarParam(PyDelphiWrapper : TPyDelphiWrapper; const AValue : Variant) : PPyObject;
var
tmp : PPyObject;
_varParam : TPyDelphiVarParameter;
begin
Result := PyDelphiWrapper.VarParamType.CreateInstance;
_varParam := PythonToDelphi(Result) as TPyDelphiVarParameter;
tmp := GetPythonEngine.VariantAsPyObject(AValue);
_varParam.Value := tmp; // refcount was incremented
GetPythonEngine.Py_DECREF(tmp);
end;
function SupportsFreeNotification(AObject : TObject) : Boolean;
var
_FreeNotification : IFreeNotification;
begin
Result := (AObject is TComponent) or AObject.GetInterface(IFreeNotification, _FreeNotification);
end;
procedure RaiseNotifyEvent(PyDelphiWrapper : TPyDelphiWrapper; ACallable : PPyObject; Sender: TObject);
Var
PyObject, PyTuple, PyResult : PPyObject;
begin
Assert(Assigned(PyDelphiWrapper));
if Assigned(ACallable) and PythonOK then
with GetPythonEngine do begin
PyObject := PyDelphiWrapper.Wrap(Sender);
PyTuple := PyTuple_New(1);
try
GetPythonEngine.PyTuple_SetItem(PyTuple, 0, PyObject);
PyResult := PyObject_CallObject(ACallable, PyTuple);
if Assigned(PyResult) then Py_DECREF(PyResult);
finally
Py_DECREF(PyTuple);
end;
CheckError;
end;
end;
function SetToPython(ATypeInfo: PTypeInfo; AValue : Integer) : PPyObject; overload;
var
S: TIntegerSet;
I: Integer;
_name : PPyObject;
begin
Result := GetPythonEngine.PyList_New(0);
Integer(S) := AValue;
for I := 0 to SizeOf(Integer) * 8 - 1 do
if I in S then
begin
_name := GetPythonEngine.PyString_FromDelphiString(GetEnumName(ATypeInfo, I));
GetPythonEngine.PyList_Append(Result, _name);
GetPythonEngine.Py_XDecRef(_name);
end;
end;
function SetToPython(APropInfo: PPropInfo; AValue : Integer) : PPyObject; overload;
begin
{$IFDEF FPC}
Result := SetToPython(GetTypeData(APropInfo.PropType)^.CompType, AValue);
{$ELSE FPC}
Result := SetToPython(GetTypeData(APropInfo^.PropType^)^.CompType^, AValue);
{$ENDIF FPC}
end;
function SetToPython(AInstance: TObject; APropInfo: PPropInfo) : PPyObject; overload;
begin
Result := SetToPython(APropInfo, GetOrdProp(AInstance, APropInfo));
end;
function PythonToSet(ATypeInfo: PTypeInfo; ASet : PPyObject) : Integer; overload;
var
i : Integer;
EnumObj: PPyObject;
EnumName: string;
EnumValue: Integer;
EnumInfo: PTypeInfo;
begin
Result := 0;
with GetPythonEngine do
begin
Assert(PySequence_Check(ASet) <> 0, 'PythonToSet expects a Python sequence as first parameter');
{$IFDEF FPC}
EnumInfo := GetTypeData(ATypeInfo)^.CompType;
{$ELSE FPC}
EnumInfo := GetTypeData(ATypeInfo)^.CompType^;
{$ENDIF FPC}
for i := 0 to PySequence_Length(ASet)-1 do
begin
EnumObj := PySequence_GetItem(ASet, i);
try
EnumName := PyObjectAsString(EnumObj);
finally
Py_XDecRef(EnumObj);
end;
EnumValue := GetEnumValue(EnumInfo, EnumName);
if EnumValue < 0 then
raise EPropertyConvertError.CreateResFmt(@SInvalidPropertyElement, [EnumName]);
Include(TIntegerSet(Result), EnumValue);
end;
end;
end;
function PythonToSet(APropInfo: PPropInfo; ASet : PPyObject) : Integer; overload;
begin
{$IFDEF FPC}
Result := PythonToSet(APropInfo^.PropType, ASet);
{$ELSE FPC}
Result := PythonToSet(APropInfo^.PropType^, ASet);
{$ENDIF FPC}
end;
{$IFDEF FPC}
function GetPropValue(Instance: TObject; PropInfo: PPropInfo): Variant;
begin
Result := Variants.GetPropValue(Instance, PropInfo, False);
end;
procedure SetPropValue(Instance: TObject; PropInfo: PPropInfo; const Value: Variant);
begin
Variants.SetPropValue(Instance, PropInfo, Value);
end;
{$ENDIF}
function Abort_Wrapper(pself, args: PPyObject): PPyObject; cdecl;
begin
Result := nil;
Abort;
end;
Type
// Used for class registration by TPyDelphiWrapper fClassRegister
TRegisteredClass = class
public
DelphiClass : TClass;
PythonType : TPythonType;
end;
{$IFNDEF FPC}
Type
// PyObject wrapping TObject method call
// Helper object used by TPyDelphiObject
TPyDelphiMethodObject = class (TPyObject)
public
{$IFDEF EXTENDED_RTTI}
ParentAddress: Pointer;
ParentRtti: TRttiStructuredType;
fDelphiWrapper : TPyDelphiWrapper;
MethName: string;
{$ELSE}
DelphiObject: TObject;
MethodInfo : TMethodInfoHeader;
{$ENDIF}
function Call( ob1, ob2 : PPyObject) : PPyObject; override;
function Repr : PPyObject; override;
class procedure SetupType( PythonType : TPythonType ); override;
end;
{$ENDIF}
{ TFreeNotificationImpl }
constructor TFreeNotificationImpl.Create(AOwner: TObject);
begin
inherited Create;
Assert(Assigned(AOwner));
fOwner := AOwner;
end;
destructor TFreeNotificationImpl.Destroy;
var
i : Integer;
begin
if Assigned(fSubscribers) then
begin
for i := 0 to fSubscribers.Count-1 do
(fSubscribers[i] as IFreeNotificationSubscriber).Notify(Owner);
fSubscribers.Free;
end;
inherited;
end;
function TFreeNotificationImpl.GetSubscribers: TInterfaceList;
begin
if not Assigned(fSubscribers) then
fSubscribers := TInterfaceList.Create;
Result := fSubscribers;
end;
procedure TFreeNotificationImpl.Subscribe(
const ASubscriber: IFreeNotificationSubscriber);
begin
Assert(Assigned(ASubscriber));
if not Assigned(fSubscribers) or (fSubscribers.IndexOf(ASubscriber) < 0) then
GetSubscribers.Add(ASubscriber);
end;
procedure TFreeNotificationImpl.UnSubscribe(
const ASubscriber: IFreeNotificationSubscriber);
begin
if Assigned(fSubscribers) then
begin
fSubscribers.Remove(ASubscriber);
if fSubscribers.Count = 0 then
FreeAndNil(fSubscribers);
end;
end;
{ TContainerAccess }
function TContainerAccess.Clone: TContainerAccess;
begin
Result := TContainerAccessClass(ClassType).Create(Wrapper, Container);
end;
constructor TContainerAccess.Create(AWrapper: TPyDelphiWrapper;
AContainer: TObject);
begin
inherited Create;
Assert(Assigned(AWrapper));
Assert(Assigned(AContainer));
Assert(AContainer.InheritsFrom(ExpectedContainerClass), Format('Class %s expects a container of class %s', [ClassName, ExpectedContainerClass.ClassName]));
fWrapper := AWrapper;
fContainer := AContainer;
end;
function TContainerAccess.IndexOf(AValue: PPyObject): Integer;
begin
Result := -1;
end;
class function TContainerAccess.Name: string;
begin
Result := ExpectedContainerClass.ClassName;
end;
function TContainerAccess.SetItem(AIndex: Integer; AValue: PPyObject): Boolean;
begin
Result := False;
end;
class function TContainerAccess.SupportsIndexOf: Boolean;
begin
Result := False;
end;
class function TContainerAccess.SupportsWrite: Boolean;
begin
Result := False;
end;
function TContainerAccess.Wrap(Obj: TObject;
Ownership: TObjectOwnership): PPyObject;
begin
Result := Wrapper.Wrap(Obj, Ownership);
end;
{ TPyDelphiContainer }
destructor TPyDelphiContainer.Destroy;
begin
fContainerAccess.Free;
inherited;
end;
function TPyDelphiContainer.Iter: PPyObject;
begin
Result := PyDelphiWrapper.DefaultIterType.CreateInstance;
with PythonToDelphi(Result) as TPyDelphiIterator do
Setup(Self.ContainerAccess.Clone);
end;
function TPyDelphiContainer.Repr: PPyObject;
begin
with GetPythonEngine do
Result := PyString_FromDelphiString( Format('