{$I Definition.Inc}
unit WrapDelphiClasses;
interface
uses
Classes, SysUtils, PythonEngine, WrapDelphi;
type
{
PyObject wrapping TPersistent
Exposes Assign Method
}
TPyDelphiPersistent = class (TPyDelphiObject)
private
function GetDelphiObject: TPersistent;
procedure SetDelphiObject(const Value: TPersistent);
protected
// Exposed Methods
function Assign_Wrapper(args : PPyObject) : PPyObject; cdecl;
function GetNamePath_Wrapper(args : PPyObject) : PPyObject; cdecl;
// Virtual Methods
function Assign(ASource : PPyObject) : PPyObject; virtual;
public
class function DelphiObjectClass : TClass; override;
class procedure RegisterMethods( PythonType : TPythonType ); override;
// Properties
property DelphiObject: TPersistent read GetDelphiObject write SetDelphiObject;
end;
{
Access to the TCollectionItem items of a TCollection.
}
TCollectionAccess = class(TContainerAccess)
private
function GetContainer: TCollection;
public
function GetItem(AIndex : Integer) : PPyObject; override;
function GetSize : Integer; override;
function IndexOf(AValue : PPyObject) : Integer; override;
class function ExpectedContainerClass : TClass; override;
class function SupportsIndexOf : Boolean; override;
class function Name : string; override;
property Container : TCollection read GetContainer;
end;
{
PyObject wrapping TCollection
}
TPyDelphiCollection = class (TPyDelphiPersistent)
private
function GetDelphiObject: TCollection;
procedure SetDelphiObject(const Value: TCollection);
protected
// Exposed Methods
function Insert_Wrapper(args : PPyObject) : PPyObject; cdecl;
function Add_Wrapper(args : PPyObject) : PPyObject; cdecl;
function Clear_Wrapper(args : PPyObject) : PPyObject; cdecl;
function Delete_Wrapper(args : PPyObject) : PPyObject; cdecl;
function BeginUpdate_Wrapper(args : PPyObject) : PPyObject; cdecl;
function EndUpdate_Wrapper(args : PPyObject) : PPyObject; cdecl;
// Property Getters
function Get_Count( AContext : Pointer) : PPyObject; cdecl;
function Get_Items( AContext : Pointer) : PPyObject; cdecl;
function Get_Owner( AContext : Pointer) : PPyObject; cdecl;
public
class function DelphiObjectClass : TClass; override;
class procedure RegisterMethods( PythonType : TPythonType ); override;
class procedure RegisterGetSets( PythonType : TPythonType ); override;
class function GetContainerAccessClass : TContainerAccessClass; override;
// Properties
property DelphiObject: TCollection read GetDelphiObject write SetDelphiObject;
end;
{
Access to the items owned by a component.
}
TComponentsAccess = class(TContainerAccess)
private
function GetContainer: TComponent;
public
function GetItem(AIndex : Integer) : PPyObject; override;
function GetSize : Integer; override;
function IndexOf(AValue : PPyObject) : Integer; override;
class function ExpectedContainerClass : TClass; override;
class function SupportsIndexOf : Boolean; override;
property Container : TComponent read GetContainer;
end;
{
PyObject wrapping TComponent
Exposes read-only properties ComponentCount and Owner as well as
sub-components as pseudo-properties
}
TPyDelphiComponent = class (TPyDelphiPersistent)
private
fFreeNotificationComp : TComponent;
function GetDelphiObject: TComponent;
procedure SetDelphiObject(const Value: TComponent);
procedure HandleFreeNotificationEvent(Sender: TObject; AComponent: TComponent);
protected
function CreateComponent(AOwner : TComponent) : TComponent; virtual;
procedure SubscribeToFreeNotification; override;
procedure UnSubscribeToFreeNotification; override;
// Exposed Methods
function GetParentComponent_Wrapper(args : PPyObject) : PPyObject; cdecl;
function HasParent_Wrapper(args : PPyObject) : PPyObject; cdecl;
function BindMethodsToEvents(args : PPyObject) : PPyObject; cdecl;
// Property Getters
function Get_ComponentCount( AContext : Pointer) : PPyObject; cdecl;
function Get_Owner( AContext : Pointer) : PPyObject; cdecl;
function Get_Components( AContext : Pointer) : PPyObject; cdecl;
public
constructor CreateWith( APythonType : TPythonType; args : PPyObject ); override;
destructor Destroy; override;
function GetAttrO( key: PPyObject) : PPyObject; override;
class function DelphiObjectClass : TClass; override;
class procedure RegisterGetSets( PythonType : TPythonType ); override;
class procedure RegisterMethods( PythonType : TPythonType ); override;
class procedure SetupType( PythonType : TPythonType ); override;
class function GetContainerAccessClass : TContainerAccessClass; override;
// Mapping services
function MpLength : NativeInt; override;
function MpSubscript( obj : PPyObject) : PPyObject; override;
// Properties
property DelphiObject: TComponent read GetDelphiObject write SetDelphiObject;
end;
{
Access to the string items of the TStrings collection.
}
TStringsAccess = class(TContainerAccess)
private
function GetContainer: TStrings;
public
function GetItem(AIndex : Integer) : PPyObject; override;
function GetSize : Integer; override;
function IndexOf(AValue : PPyObject) : Integer; override;
function SetItem(AIndex : Integer; AValue : PPyObject) : Boolean; override;
class function ExpectedContainerClass : TClass; override;
class function SupportsIndexOf : Boolean; override;
class function SupportsWrite : Boolean; override;
property Container : TStrings read GetContainer;
end;
{
Access to the TObject items of the TStrings.Objects collection.
}
TStringsObjectsAccess = class(TStringsAccess)
public
function GetItem(AIndex : Integer) : PPyObject; override;
function IndexOf(AValue : PPyObject) : Integer; override;
function SetItem(AIndex : Integer; AValue : PPyObject) : Boolean; override;
class function Name : string; override;
end;
{
PyObject wrapping TStrings
Note that you can assign a Python sequence to a TStrings (X.Assign([1, 2, 3]))
Note that X[1] will return a string, where as X['key'] will return the object associated
with the string 'key'.
Provides a mapping interface to a Delphi strings object
Exposes Methods Add, AddObject, Delete, IndexOf and Clear
}
TPyDelphiStrings = class (TPyDelphiPersistent)
private
function GetDelphiObject: TStrings;
procedure SetDelphiObject(const Value: TStrings);
protected
// Exposed Methods
function Add_Wrapper(args : PPyObject) : PPyObject; cdecl;
function AddObject_Wrapper(args : PPyObject) : PPyObject; cdecl;
function Clear_Wrapper(args : PPyObject) : PPyObject; cdecl;
function Delete_Wrapper(args : PPyObject) : PPyObject; cdecl;
function IndexOf_Wrapper(args : PPyObject) : PPyObject; cdecl;
function BeginUpdate_Wrapper(args : PPyObject) : PPyObject; cdecl;
function EndUpdate_Wrapper(args : PPyObject) : PPyObject; cdecl;
function LoadFromFile_Wrapper(args : PPyObject) : PPyObject; cdecl;
function SaveToFile_Wrapper(args : PPyObject) : PPyObject; cdecl;
// Property Getters
function Get_Capacity( AContext : Pointer) : PPyObject; cdecl;
function Get_Text( AContext : Pointer) : PPyObject; cdecl;
function Get_Objects( AContext : Pointer) : PPyObject; cdecl;
// Property Setters
function Set_Capacity( AValue : PPyObject; AContext : Pointer) : integer; cdecl;
function Set_Text( AValue : PPyObject; AContext : Pointer) : integer; cdecl;
// Virtual Methods
function Assign(ASource : PPyObject) : PPyObject; override;
public
function Repr : PPyObject; override;
// Mapping services
function MpLength : NativeInt; override;
function MpSubscript( obj : PPyObject) : PPyObject; override;
// Class methods
class function DelphiObjectClass : TClass; override;
class procedure RegisterGetSets( PythonType : TPythonType ); override;
class procedure RegisterMethods( PythonType : TPythonType ); override;
class procedure SetupType( PythonType : TPythonType ); override;
class function GetContainerAccessClass : TContainerAccessClass; override;
// Properties
property DelphiObject: TStrings read GetDelphiObject write SetDelphiObject;
end;
{
PyObject wrapping TBasicAction
Exposes methods Execute, Update
Exposes property ActionComponent
}
TPyDelphiBasicAction = class (TPyDelphiComponent)
private
function GetDelphiObject: TBasicAction;
procedure SetDelphiObject(const Value: TBasicAction);
protected
// Exposed Methods
function Execute_Wrapper(args : PPyObject) : PPyObject; cdecl;
function Update_Wrapper(args : PPyObject) : PPyObject; cdecl;
// Property Getters
function Get_ActionComponent( AContext : Pointer) : PPyObject; cdecl;
// Property Setters
function Set_ActionComponent( AValue : PPyObject; AContext : Pointer) : integer; cdecl;
public
// Class methods
class function DelphiObjectClass : TClass; override;
class procedure RegisterGetSets( PythonType : TPythonType ); override;
class procedure RegisterMethods( PythonType : TPythonType ); override;
// Properties
property DelphiObject: TBasicAction read GetDelphiObject write SetDelphiObject;
end;
{ Helper functions }
function ShiftToPython(AShift : TShiftState) : PPyObject;
implementation
uses
TypInfo;
{ Register the wrappers, the globals and the constants }
type
TClassesRegistration = class(TRegisteredUnit)
public
function Name : string; override;
procedure RegisterWrappers(APyDelphiWrapper : TPyDelphiWrapper); override;
procedure DefineVars(APyDelphiWrapper : TPyDelphiWrapper); override;
end;
{ TClassesRegistration }
procedure TClassesRegistration.DefineVars(APyDelphiWrapper: TPyDelphiWrapper);
begin
inherited;
APyDelphiWrapper.DefineVar('ssShift', 'ssShift');
APyDelphiWrapper.DefineVar('ssAlt', 'ssAlt');
APyDelphiWrapper.DefineVar('ssCtrl', 'ssCtrl');
APyDelphiWrapper.DefineVar('ssLeft', 'ssLeft');
APyDelphiWrapper.DefineVar('ssRight', 'ssRight');
APyDelphiWrapper.DefineVar('ssMiddle', 'ssMiddle');
APyDelphiWrapper.DefineVar('ssDouble', 'ssDouble');
end;
function TClassesRegistration.Name: string;
begin
Result := 'Classes';
end;
procedure TClassesRegistration.RegisterWrappers(APyDelphiWrapper: TPyDelphiWrapper);
begin
inherited;
APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiPersistent);
APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiCollection);
APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiComponent);
APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiStrings);
APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiBasicAction);
end;
{ Helper functions }
function ShiftToPython(AShift : TShiftState) : PPyObject;
procedure Append(AList : PPyObject; const AString : string);
var
_item : PPyObject;
begin
with GetPythonEngine do
begin
_item := PyString_FromDelphiString(AString);
PyList_Append(AList, _item);
Py_XDecRef(_item);
end;
end;
begin
with GetPythonEngine do
begin
Result := PyList_New(0);
if ssShift in AShift then
Append(Result, 'ssShift');
if ssAlt in AShift then
Append(Result, 'ssAlt');
if ssCtrl in AShift then
Append(Result, 'ssCtrl');
if ssLeft in AShift then
Append(Result, 'ssLeft');
if ssRight in AShift then
Append(Result, 'ssRight');
if ssMiddle in AShift then
Append(Result, 'ssMiddle');
if ssDouble in AShift then
Append(Result, 'ssDouble');
end;
end;
{ TPyDelphiPersistent }
function TPyDelphiPersistent.Assign(ASource: PPyObject): PPyObject;
var
_object : TObject;
begin
if CheckObjAttribute(ASource, 'First parameter', TPersistent, _object) then
begin
DelphiObject.Assign(TPersistent(_object));
Result := GetPythonEngine.ReturnNone;
end
else
Result := nil;
end;
function TPyDelphiPersistent.Assign_Wrapper(args: PPyObject): PPyObject;
var
_obj : PPyObject;
begin
// We adjust the transmitted self argument
Adjust(@Self);
if GetPythonEngine.PyArg_ParseTuple( args, 'O:Assign',@_obj ) <> 0 then
Result := Self.Assign(_obj)
else
Result := nil;
end;
class function TPyDelphiPersistent.DelphiObjectClass: TClass;
begin
Result := TPersistent;
end;
function TPyDelphiPersistent.GetDelphiObject: TPersistent;
begin
Result := TPersistent(inherited DelphiObject);
end;
function TPyDelphiPersistent.GetNamePath_Wrapper(
args: PPyObject): PPyObject;
begin
// We adjust the transmitted self argument
Adjust(@Self);
with GetPythonEngine do begin
if PyArg_ParseTuple( args, ':GetNamePath' ) <> 0 then begin
Result := PyString_FromDelphiString(DelphiObject.GetNamePath)
end else
Result := nil;
end;
end;
class procedure TPyDelphiPersistent.RegisterMethods(
PythonType: TPythonType);
begin
inherited;
PythonType.AddMethod('Assign', @TPyDelphiPersistent.Assign_Wrapper,
'TPersistent.Assign(persistent)'#10 +
'Assigns to this object the values of another TPersistent object');
PythonType.AddMethod('GetNamePath', @TPyDelphiPersistent.GetNamePath_Wrapper,
'TPersistent.GetNamePath()'#10 +
'Returns the name of the object as it appears in the Object Inspector.');
end;
procedure TPyDelphiPersistent.SetDelphiObject(const Value: TPersistent);
begin
inherited DelphiObject := Value;
end;
{ TCollectionAccess }
class function TCollectionAccess.ExpectedContainerClass: TClass;
begin
Result := TCollection;
end;
function TCollectionAccess.GetContainer: TCollection;
begin
Result := TCollection(inherited Container);
end;
function TCollectionAccess.GetItem(AIndex: Integer): PPyObject;
begin
Result := Wrap( Container.Items[AIndex] );
end;
function TCollectionAccess.GetSize: Integer;
begin
Result := Container.Count;
end;
function TCollectionAccess.IndexOf(AValue: PPyObject): Integer;
var
i : Integer;
_obj : TPyObject;
_item : TCollectionItem;
begin
Result := -1;
with GetPythonEngine do
begin
if PyInt_Check(AValue) then
begin
_item := Container.FindItemID(PyInt_AsLong(AValue));
if Assigned(_item) then
Result := _item.Index;
end
else if IsDelphiObject(AValue) then
begin
_obj := PythonToDelphi(AValue);
if (_obj is TPyDelphiObject) and (TPyDelphiObject(_obj).DelphiObject is TCollectionItem) then
begin
_item := TCollectionItem(TPyDelphiObject(_obj).DelphiObject);
for i := 0 to Container.Count-1 do
if Container.Items[i] = _item then
begin
Result := i;
Break;
end;
end;
end;
end;
end;
class function TCollectionAccess.Name: string;
begin
Result := 'TCollection.Items';
end;
class function TCollectionAccess.SupportsIndexOf: Boolean;
begin
Result := True;
end;
{ TPyDelphiCollection }
function TPyDelphiCollection.Add_Wrapper(args: PPyObject): PPyObject;
begin
// We adjust the transmitted self argument
Adjust(@Self);
if GetPythonEngine.PyArg_ParseTuple( args, ':Add' ) <> 0 then
Result := Wrap(DelphiObject.Add)
else
Result := nil;
end;
function TPyDelphiCollection.BeginUpdate_Wrapper(
args: PPyObject): PPyObject;
begin
// We adjust the transmitted self argument
Adjust(@Self);
if GetPythonEngine.PyArg_ParseTuple( args, ':BeginUpdate' ) <> 0 then begin
DelphiObject.BeginUpdate;
Result := GetPythonEngine.ReturnNone;
end else
Result := nil;
end;
function TPyDelphiCollection.Clear_Wrapper(args: PPyObject): PPyObject;
begin
// We adjust the transmitted self argument
Adjust(@Self);
if GetPythonEngine.PyArg_ParseTuple( args, ':Clear') <> 0 then begin
(DelphiObject as TCollection).Clear;
Result := GetPythonEngine.ReturnNone;
end else
Result := nil;
end;
function TPyDelphiCollection.Delete_Wrapper(args: PPyObject): PPyObject;
Var
Index : integer;
begin
// We adjust the transmitted self argument
Adjust(@Self);
if GetPythonEngine.PyArg_ParseTuple( args, 'i:Delete',@Index ) <> 0 then
begin
if not CheckIndex(Index, DelphiObject.Count) then
Result := nil
else
begin
DelphiObject.Delete(Index);
Result := GetPythonEngine.ReturnNone;
end;
end
else
Result := nil;
end;
class function TPyDelphiCollection.DelphiObjectClass: TClass;
begin
Result := TCollection;
end;
function TPyDelphiCollection.EndUpdate_Wrapper(args: PPyObject): PPyObject;
begin
// We adjust the transmitted self argument
Adjust(@Self);
if GetPythonEngine.PyArg_ParseTuple( args, ':EndUpdate') <> 0 then begin
DelphiObject.EndUpdate;
Result := GetPythonEngine.ReturnNone;
end else
Result := nil;
end;
class function TPyDelphiCollection.GetContainerAccessClass: TContainerAccessClass;
begin
Result := TCollectionAccess;
end;
function TPyDelphiCollection.GetDelphiObject: TCollection;
begin
Result := TCollection(inherited DelphiObject);
end;
function TPyDelphiCollection.Get_Count(AContext: Pointer): PPyObject;
begin
Adjust(@Self);
Result := GetPythonEngine.PyInt_FromLong(DelphiObject.Count);
end;
function TPyDelphiCollection.Get_Items(AContext: Pointer): PPyObject;
begin
Adjust(@Self);
Result := Self.PyDelphiWrapper.DefaultContainerType.CreateInstance;
with PythonToDelphi(Result) as TPyDelphiContainer do
Setup(Self.PyDelphiWrapper, Self.ContainerAccess.Clone);
end;
function TPyDelphiCollection.Get_Owner(AContext: Pointer): PPyObject;
begin
Adjust(@Self);
Result := Wrap(DelphiObject.Owner);
end;
function TPyDelphiCollection.Insert_Wrapper(args: PPyObject): PPyObject;
Var
Index : integer;
begin
// We adjust the transmitted self argument
Adjust(@Self);
if GetPythonEngine.PyArg_ParseTuple( args, 'i:Insert',@Index ) <> 0 then
Result := Wrap(DelphiObject.Insert(Index))
else
Result := nil;
end;
class procedure TPyDelphiCollection.RegisterGetSets(PythonType: TPythonType);
begin
inherited;
with PythonType do
begin
AddGetSet('Count', @TPyDelphiCollection.Get_Count, nil,
'Returns the count of collection items', nil);
AddGetSet('Items', @TPyDelphiCollection.Get_Items, nil,
'Returns an iterator over the collection items', nil);
AddGetSet('Owner', @TPyDelphiCollection.Get_Owner, nil,
'Returns the Owner of the collection', nil);
end;
end;
class procedure TPyDelphiCollection.RegisterMethods(
PythonType: TPythonType);
begin
inherited;
PythonType.AddMethod('Insert', @TPyDelphiCollection.Insert_Wrapper,
'TCollection.Insert(Index)'#10 +
'Inserts a new collection item to the collection at the Index position');
PythonType.AddMethod('Add', @TPyDelphiCollection.Add_Wrapper,
'TCollection.Add()'#10 +
'Adds a collection item to the collection');
PythonType.AddMethod('Clear', @TPyDelphiCollection.Clear_Wrapper,
'TCollection.Clear()'#10 +
'Clears all collection items');
PythonType.AddMethod('Delete', @TPyDelphiCollection.Delete_Wrapper,
'TCollection.Delete(Index)'#10 +
'Deletes a single item from the collection.');
PythonType.AddMethod('BeginUpdate', @TPyDelphiCollection.BeginUpdate_Wrapper,
'TCollection.BeginUpdate()'#10 +
'Suspends screen repainting.');
PythonType.AddMethod('EndUpdate', @TPyDelphiCollection.EndUpdate_Wrapper,
'TCollection.EndUpdate()'#10 +
'Re-enables screen repainting.');
end;
procedure TPyDelphiCollection.SetDelphiObject(const Value: TCollection);
begin
inherited DelphiObject := Value;
end;
{ TComponentsAccess }
class function TComponentsAccess.ExpectedContainerClass: TClass;
begin
Result := TComponent;
end;
function TComponentsAccess.GetContainer: TComponent;
begin
Result := TComponent(inherited Container);
end;
function TComponentsAccess.GetItem(AIndex: Integer): PPyObject;
begin
Result := Wrap( Container.Components[AIndex] );
end;
function TComponentsAccess.GetSize: Integer;
begin
Result := Container.ComponentCount;
end;
function TComponentsAccess.IndexOf(AValue: PPyObject): Integer;
Var
i : Integer;
S : string;
_obj : TPyObject;
_value : TObject;
_comp : TComponent;
begin
Result := -1;
with GetPythonEngine do
begin
if PyString_Check(AValue) then
begin
S := PyString_AsDelphiString(AValue);
for i := 0 to Container.ComponentCount-1 do
if SameText( Container.Components[i].Name, S) then
begin
Result := i;
Break;
end;
end
else if IsDelphiObject(AValue) then
begin
_obj := PythonToDelphi(AValue);
if _obj is TPyDelphiObject then
begin
_value := TPyDelphiObject(_obj).DelphiObject;
if _value is TComponent then
begin
_comp := TComponent(_value);
for i := 0 to Container.ComponentCount-1 do
if Container.Components[i] = _comp then
begin
Result := i;
Break;
end;
end;
end;
end;
end;
end;
class function TComponentsAccess.SupportsIndexOf: Boolean;
begin
Result := True;
end;
{ TPyDelphiObjectNexus }
{ used by TPyDelphiObject to get free notification }
type
TPyDelphiObjectNexusEvent = procedure(Sender: TObject; AComponent: TComponent) of object;
TPyDelphiObjectNexus = class(TComponent)
private
FOnFreeNotify: TPyDelphiObjectNexusEvent;
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
property OnFreeNotify: TPyDelphiObjectNexusEvent read FOnFreeNotify write FOnFreeNotify;
end;
{ TPyDelphiObjectNexus }
procedure TPyDelphiObjectNexus.Notification(AComponent: TComponent; Operation: TOperation);
begin
if (Operation = opRemove) and Assigned(FOnFreeNotify) then
FOnFreeNotify(Self, AComponent);
inherited Notification(AComponent, Operation);
end;
{ TPyDelphiComponent }
function TPyDelphiComponent.BindMethodsToEvents(args: PPyObject): PPyObject;
var
i : Integer;
j : Integer;
d : PPyObject;
s : PPyObject;
obj : PPyObject;
objMethod : PPyObject;
objComp : PPyObject;
key : PPyObject;
keys : PPyObject;
_idx : Integer;
_name : string;
_prefix : string;
_compName : string;
_eventName : string;
_comp : TComponent;
_pair : PPyObject;
_bindings : PPyObject;
_type : PPyTypeObject;
begin
Adjust(@Self);
_prefix := 'handle_';
with GetPythonEngine do begin
// We adjust the transmitted self argument
Result := nil;
s := nil;
if PyArg_ParseTuple( args, '|O:BindMethodsToEvents',@s ) <> 0 then
begin
if Assigned(S) then
_prefix := PyString_AsDelphiString(s);
_bindings := PyList_New(0);
try
_type := GetSelf.ob_type;
while _type <> nil do
begin
d := _type.tp_dict;
if Assigned(d) and PyDict_Check(d) then
begin
keys := PyDict_Keys(d);
try
if PySequence_Check(keys) = 1 then
for i := 0 to PySequence_Length(keys)-1 do
begin
key := PySequence_GetItem(keys, i);
obj := PyDict_GetItem(d, key); // borrowed ref
objComp := nil;
try
if PyCallable_Check(obj) = 1 then
begin
_name := PyObjectAsString(key);
if SameText(Copy(_name, 1, Length(_prefix)), _prefix) then
begin
System.Delete(_name, 1, Length(_prefix));
_idx := -1;
for j := Length(_name) downto 1 do
if _name[j] = '_' then
begin
_idx := j;
Break;
end;
if _idx > -1 then
begin
_compName := Copy(_name, 1, _idx-1);
_eventName := Copy(_name, _idx+1, MaxInt);
if SameText(_compName, 'Self') then
begin
_comp := Self.DelphiObject;
objComp := GetSelf;
Py_IncRef(objComp);
end
else
begin
_comp := Self.DelphiObject.FindComponent(_compName);
if Assigned(_comp) then
objComp := Wrap(_comp);
end;
if not Assigned(_comp) and not Assigned(objComp) then
begin
objComp := PyObject_GetAttrString(GetSelf, PAnsiChar(AnsiString(_compName)));
if Assigned(objComp) then
begin
if IsDelphiObject(objComp) and (PythonToDelphi(objComp) is TPyDelphiComponent) then
_comp := TPyDelphiComponent(PythonToDelphi(objComp)).DelphiObject;
end
else
PyErr_Clear;
end;
if Assigned(_comp) and Assigned(objComp) and IsPublishedProp(_comp, _eventName) then
begin
objMethod := PyObject_GenericGetAttr(GetSelf, key);
try
if PyErr_Occurred <> nil then
Exit;
PyObject_SetAttrString(objComp, PAnsiChar(AnsiString(_eventName)), objMethod);
if PyErr_Occurred <> nil then
Exit
else
begin
_pair := PyTuple_New(3);
PyTuple_SetItem(_pair, 0, PyString_FromDelphiString(_compName));
PyTuple_SetItem(_pair, 1, PyString_FromDelphiString(_eventName));
PyTuple_SetItem(_pair, 2, objMethod);
PyList_Append(_bindings, _pair);
end;
finally
Py_XDecRef(objMethod);
end;
end;
end;
end;
end;
finally
Py_XDecRef(objComp);
Py_DecRef(key);
end;
end; // for
finally
Py_DecRef(keys);
end;
end;
_type := _type.tp_base;
end;
Result := _bindings;
_bindings := nil;
finally
Py_XDecRef(_bindings);
end;
end;
end;
end;
function TPyDelphiComponent.Get_ComponentCount(AContext: Pointer): PPyObject;
begin
Adjust(@Self);
Result := GetPythonEngine.PyInt_FromLong(DelphiObject.ComponentCount);
end;
function TPyDelphiComponent.Get_Components(AContext: Pointer): PPyObject;
begin
Adjust(@Self);
Result := Self.PyDelphiWrapper.DefaultContainerType.CreateInstance;
with PythonToDelphi(Result) as TPyDelphiContainer do
Setup(Self.PyDelphiWrapper, Self.ContainerAccess.Clone);
end;
function TPyDelphiComponent.Get_Owner(AContext: Pointer): PPyObject;
begin
Adjust(@Self);
Result := Wrap(DelphiObject.Owner);
end;
function TPyDelphiComponent.GetParentComponent_Wrapper(
args: PPyObject): PPyObject;
begin
Adjust(@Self);
with GetPythonEngine do begin
// We adjust the transmitted self argument
if PyArg_ParseTuple( args, ':GetParentComponent') <> 0 then begin
Result := Wrap(DelphiObject.GetParentComponent)
end else
Result := nil;
end;
end;
function TPyDelphiComponent.HasParent_Wrapper(args: PPyObject): PPyObject;
begin
Adjust(@Self);
with GetPythonEngine do begin
// We adjust the transmitted self argument
if PyArg_ParseTuple( args, ':HasParent') <> 0 then begin
Result := VariantAsPyObject(DelphiObject.HasParent)
end else
Result := nil;
end;
end;
function TPyDelphiComponent.GetAttrO(key: PPyObject): PPyObject;
Var
Component: TComponent;
Name: string;
begin
Result := nil;
if Assigned(DelphiObject) then
begin
if GetPythonEngine.PyString_Check(Key) then
begin
Name := GetPythonEngine.PyString_AsDelphiString(Key);
// try a sub component
Component := DelphiObject.FindComponent(Name);
if Component <> nil then
Result := Wrap(Component);
end;
end;
if not Assigned(Result) then
Result := inherited GetAttrO(key);
end;
function TPyDelphiComponent.GetDelphiObject: TComponent;
begin
Result := TComponent(inherited DelphiObject);
end;
procedure TPyDelphiComponent.SetDelphiObject(const Value: TComponent);
begin
inherited DelphiObject := Value;
end;
class procedure TPyDelphiComponent.RegisterGetSets(
PythonType: TPythonType);
begin
inherited;
with PythonType do
begin
AddGetSet('ComponentCount', @TPyDelphiComponent.Get_ComponentCount, nil,
'Returns the owned component count', nil);
AddGetSet('Owner', @TPyDelphiComponent.Get_Owner, nil,
'Returns the Component Owner', nil);
AddGetSet('Components', @TPyDelphiComponent.Get_Components, nil,
'Returns an iterator over the owned components', nil);
end;
end;
class procedure TPyDelphiComponent.RegisterMethods(
PythonType: TPythonType);
begin
inherited;
PythonType.AddMethod('GetParentComponent', @TPyDelphiComponent.GetParentComponent_Wrapper,
'TComponent.GetParentComponent()'#10 +
'Returns the parent of a component.');
PythonType.AddMethod('HasParent', @TPyDelphiComponent.HasParent_Wrapper,
'TComponent.HasParent()'#10 +
'Indicates whether the component has a parent to handle its filing.');
PythonType.AddMethod('BindMethodsToEvents', @TPyDelphiComponent.BindMethodsToEvents,
'TComponent.BindMethodsToEvents(prefix)'#10 +
'Connects methods to component events if they are named using the following patter: Prefix_ComponentName_EventName.'+#10+
'Example: def handle_button1_OnClick(Sender): pass'+#10+
'The function returns a list of tuples. Each tuple contains the name of the component, the name of the event and the method object assigned to the event.'+#10+
'Note that the prefix parameter is optional and will default to "handle_".');
end;
class procedure TPyDelphiComponent.SetupType(PythonType: TPythonType);
begin
inherited;
PythonType.Services.Mapping := PythonType.Services.Mapping + [msLength, msSubscript];
end;
class function TPyDelphiComponent.GetContainerAccessClass: TContainerAccessClass;
begin
Result := TComponentsAccess;
end;
function TPyDelphiComponent.MpLength: NativeInt;
begin
Result := SqLength;
end;
function TPyDelphiComponent.MpSubscript(obj: PPyObject): PPyObject;
var
_name : string;
_comp : TComponent;
begin
with GetPythonEngine do
begin
if PyInt_Check(obj) then
Result := SqItem(PyInt_AsLong(obj))
else if PyString_Check(obj) then
begin
_name := string(PyString_AsDelphiString(obj));
_comp := DelphiObject.FindComponent(_name);
if Assigned(_comp) then
Result := Wrap(_comp)
else
begin
Result := nil;
PyErr_SetString (PyExc_KeyError^, PAnsiChar(AnsiString(_name)));
end;
end
else
begin
Result := nil;
PyErr_SetString (PyExc_KeyError^, 'Key must be a string');
end;
end;
end;
procedure TPyDelphiComponent.SubscribeToFreeNotification;
begin
Assert(Assigned(DelphiObject));
if not Assigned(fFreeNotificationComp) then
begin
fFreeNotificationComp := TPyDelphiObjectNexus.Create(nil);
TPyDelphiObjectNexus(fFreeNotificationComp).OnFreeNotify := HandleFreeNotificationEvent;
end;
DelphiObject.FreeNotification(fFreeNotificationComp);
end;
procedure TPyDelphiComponent.UnSubscribeToFreeNotification;
begin
Assert(Assigned(DelphiObject));
if Assigned(fFreeNotificationComp) then
DelphiObject.RemoveFreeNotification(fFreeNotificationComp);
end;
function TPyDelphiComponent.CreateComponent(AOwner: TComponent): TComponent;
begin
Result := TComponentClass(DelphiObjectClass).Create(AOwner);
end;
constructor TPyDelphiComponent.CreateWith(APythonType: TPythonType;
args: PPyObject);
var
_obj : PPyObject;
_owner : TObject;
begin
inherited;
if APythonType.Engine.PyArg_ParseTuple( args, 'O:Create',@_obj ) <> 0 then
begin
_owner := nil;
if CheckObjAttribute(_obj, 'Owner', TComponent, _owner) then
begin
DelphiObject := CreateComponent(TComponent(_owner));
Owned := not Assigned(_owner);
fCanFreeOwnedObject := True;
end;
end;
end;
destructor TPyDelphiComponent.Destroy;
begin
inherited;
fFreeNotificationComp.Free; // Free fFreeNotificationComp after inherited, because inherited will do DelphiObject := nil which call UnsubscribeFreeNotification
end;
procedure TPyDelphiComponent.HandleFreeNotificationEvent(Sender: TObject;
AComponent: TComponent);
begin
Notify(AComponent);
end;
class function TPyDelphiComponent.DelphiObjectClass: TClass;
begin
Result := TComponent;
end;
{ TStringsAccess }
class function TStringsAccess.ExpectedContainerClass: TClass;
begin
Result := TStrings;
end;
function TStringsAccess.GetContainer: TStrings;
begin
Result := TStrings(inherited Container);
end;
function TStringsAccess.GetItem(AIndex: Integer): PPyObject;
begin
Result := GetPythonEngine.PyString_FromDelphiString( Container[AIndex] );
end;
function TStringsAccess.GetSize: Integer;
begin
Result := Container.Count;
end;
function TStringsAccess.IndexOf(AValue: PPyObject): Integer;
begin
Result := Container.IndexOf(GetPythonEngine.PyObjectAsString(AValue));
end;
function TStringsAccess.SetItem(AIndex: Integer; AValue: PPyObject): Boolean;
begin
with GetPythonEngine do
begin
if PyString_Check(AValue) then
begin
Container[AIndex] := PyString_AsDelphiString(AValue);
Result := True;
end
else
begin
Result := False;
PyErr_SetString (PyExc_AttributeError^, 'You can only assign strings to TStrings items');
end;
end
end;
class function TStringsAccess.SupportsIndexOf: Boolean;
begin
Result := True;
end;
class function TStringsAccess.SupportsWrite: Boolean;
begin
Result := True;
end;
{ TStringsObjectsAccess }
function TStringsObjectsAccess.GetItem(AIndex: Integer): PPyObject;
begin
Result := Wrap( Container.Objects[AIndex] );
end;
function TStringsObjectsAccess.IndexOf(AValue: PPyObject): Integer;
var
i : Integer;
_obj : TPyObject;
_value : TObject;
begin
Result := -1;
if IsDelphiObject(AValue) then
begin
_obj := PythonToDelphi(AValue);
if _obj is TPyDelphiObject then
begin
_value := TPyDelphiObject(_obj).DelphiObject;
for i := 0 to Container.Count-1 do
begin
if Container.Objects[i] = _value then
begin
Result := i;
Break;
end;
end;
end;
end;
end;
class function TStringsObjectsAccess.Name: string;
begin
Result := 'Objects';
end;
function TStringsObjectsAccess.SetItem(AIndex: Integer; AValue: PPyObject): Boolean;
begin
with GetPythonEngine do
begin
if IsDelphiObject(AValue) and (PythonToDelphi(AValue) is TPyDelphiObject) then
begin
Container.Objects[AIndex] := TPyDelphiObject(PythonToDelphi(AValue)).DelphiObject;
Result := True;
end
else
begin
Result := False;
PyErr_SetString (PyExc_AttributeError^, 'You can only assign Delphi wrappers to Objects items');
end;
end
end;
{ TPyDelphiStrings }
function TPyDelphiStrings.AddObject_Wrapper(args: PPyObject): PPyObject;
Var
PStr : PPyObject;
_obj : PPyObject;
_value : TObject;
begin
// We adjust the transmitted self argument
Adjust(@Self);
with GetPythonEngine do
if PyArg_ParseTuple( args, 'OO:AddObject',@PStr, @_obj ) <> 0 then
begin
if CheckObjAttribute(_obj, 'The second argument of AddObject', TObject, _value) then
Result := PyInt_FromLong(DelphiObject.AddObject(PyString_AsDelphiString(PStr), _value))
else
Result := nil;
end
else
Result := nil;
end;
function TPyDelphiStrings.Add_Wrapper(args: PPyObject): PPyObject;
Var
PStr : PPyObject;
begin
// We adjust the transmitted self argument
Adjust(@Self);
with GetPythonEngine do
if PyArg_ParseTuple( args, 'O:Add',@PStr ) <> 0 then
Result := PyInt_FromLong(DelphiObject.Add(PyString_AsDelphiString(PStr)))
else
Result := nil;
end;
function TPyDelphiStrings.Assign(ASource: PPyObject): PPyObject;
var
i : Integer;
_item : PPyObject;
begin
with GetPythonEngine do
begin
if not IsDelphiObject(ASource) and (PySequence_Check(ASource) <> 0) then
begin
DelphiObject.BeginUpdate;
try
DelphiObject.Clear;
DelphiObject.Capacity := PySequence_Length(ASource);
for i := 0 to PySequence_Length(ASource)-1 do
begin
_item := PySequence_GetItem(ASource, i);
try
DelphiObject.Add(PyObjectAsString(_item));
finally
Py_DecRef(_item);
end;
end;
finally
DelphiObject.EndUpdate;
end;
Result := ReturnNone;
end
else
Result := inherited Assign(ASource);
end;
end;
function TPyDelphiStrings.BeginUpdate_Wrapper(args: PPyObject): PPyObject;
begin
// We adjust the transmitted self argument
Adjust(@Self);
if GetPythonEngine.PyArg_ParseTuple( args, ':BeginUpdate') <> 0 then begin
DelphiObject.BeginUpdate;
Result := GetPythonEngine.ReturnNone;
end else
Result := nil;
end;
function TPyDelphiStrings.Clear_Wrapper(args: PPyObject): PPyObject;
begin
// We adjust the transmitted self argument
Adjust(@Self);
if GetPythonEngine.PyArg_ParseTuple( args, ':Clear') <> 0 then begin
DelphiObject.Clear;
Result := GetPythonEngine.ReturnNone;
end else
Result := nil;
end;
function TPyDelphiStrings.Delete_Wrapper(args: PPyObject): PPyObject;
Var
Index : integer;
begin
// We adjust the transmitted self argument
Adjust(@Self);
if GetPythonEngine.PyArg_ParseTuple( args, 'i:Delete',@Index ) <> 0 then
begin
if CheckIndex(Index, DelphiObject.Count) then
begin
DelphiObject.Delete(Index);
Result := GetPythonEngine.ReturnNone;
end
else
Result := nil
end
else
Result := nil;
end;
class function TPyDelphiStrings.DelphiObjectClass: TClass;
begin
Result := TStrings;
end;
function TPyDelphiStrings.EndUpdate_Wrapper(args: PPyObject): PPyObject;
begin
// We adjust the transmitted self argument
Adjust(@Self);
if GetPythonEngine.PyArg_ParseTuple( args, ':EndUpdate') <> 0 then begin
DelphiObject.EndUpdate;
Result := GetPythonEngine.ReturnNone;
end else
Result := nil;
end;
class function TPyDelphiStrings.GetContainerAccessClass: TContainerAccessClass;
begin
Result := TStringsAccess;
end;
function TPyDelphiStrings.GetDelphiObject: TStrings;
begin
Result := TStrings(inherited DelphiObject);
end;
function TPyDelphiStrings.Get_Capacity(AContext: Pointer): PPyObject;
begin
Adjust(@Self);
Result := GetPythonEngine.PyInt_FromLong(DelphiObject.Capacity);
end;
function TPyDelphiStrings.Get_Objects(AContext: Pointer): PPyObject;
begin
Adjust(@Self);
Result := Self.PyDelphiWrapper.DefaultContainerType.CreateInstance;
with PythonToDelphi(Result) as TPyDelphiContainer do
Setup(Self.PyDelphiWrapper, TStringsObjectsAccess.Create(Self.PyDelphiWrapper,
Self.DelphiObject));
end;
function TPyDelphiStrings.Get_Text(AContext: Pointer): PPyObject;
begin
Adjust(@Self);
Result := GetPythonEngine.PyString_FromDelphiString(
CleanString(DelphiObject.Text, False));
end;
function TPyDelphiStrings.IndexOf_Wrapper(args: PPyObject): PPyObject;
Var
PStr : PPyObject;
begin
// We adjust the transmitted self argument
Adjust(@Self);
with GetPythonEngine do
if PyArg_ParseTuple( args, 'O:IndexOf',@PStr ) <> 0 then
Result := GetPythonEngine.PyInt_FromLong(DelphiObject.IndexOf(PyString_AsDelphiString(PStr)))
else
Result := nil;
end;
function TPyDelphiStrings.LoadFromFile_Wrapper(args: PPyObject): PPyObject;
Var
PStr : PAnsiChar;
begin
// We adjust the transmitted self argument
Adjust(@Self);
if GetPythonEngine.PyArg_ParseTuple( args, 's:LoadFromFile',@PStr ) <> 0 then
begin
DelphiObject.LoadFromFile(string(PStr));
Result := GetPythonEngine.ReturnNone;
end
else
Result := nil;
end;
function TPyDelphiStrings.MpLength: NativeInt;
begin
Result := DelphiObject.Count;
end;
function TPyDelphiStrings.MpSubscript(obj: PPyObject): PPyObject;
Var
S : string;
Index : integer;
begin
with GetPythonEngine do
begin
if PyInt_Check(obj) then
Result := SqItem(PyInt_AsLong(obj))
else
begin
S := PyObjectAsString(obj);
if S <> '' then begin
Index := DelphiObject.IndexOf(S);
if Index >= 0 then begin
if Assigned(DelphiObject.Objects[Index]) then
Result := Wrap(DelphiObject.Objects[Index])
else
Result := GetPythonEngine.ReturnNone;
end else with GetPythonEngine do begin
PyErr_SetString (PyExc_KeyError^, PAnsiChar(AnsiString(S)));
Result := nil;
end;
end else with GetPythonEngine do begin
PyErr_SetString (PyExc_KeyError^, '