unit WrapDelphiClasses;

Classes, SysUtils, PythonEngine, WrapDelphi;

{

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;

{

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;

{

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;

{

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;

{

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;

{

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;

{

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;

{

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;

{

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;

TypInfo;

TClassesRegistration = class(TRegisteredUnit)

public

function Name : string; override;

procedure RegisterWrappers(APyDelphiWrapper : TPyDelphiWrapper); override;

procedure DefineVars(APyDelphiWrapper : TPyDelphiWrapper); override;

end;

procedure TClassesRegistration.DefineVars(APyDelphiWrapper: TPyDelphiWrapper);

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;

Result := 'Classes';

end;

procedure TClassesRegistration.RegisterWrappers(APyDelphiWrapper: TPyDelphiWrapper);

inherited;

APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiPersistent);

APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiCollection);

APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiComponent);

APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiStrings);

APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiBasicAction);

end;

function ShiftToPython(AShift : TShiftState) : PPyObject;

procedure Append(AList : PPyObject; const AString : string);

var

_item : PPyObject;

begin

with GetPythonEngine do

begin

_item := PyUnicodeFromString(AString);

PyList_Append(AList, _item);

Py_XDecRef(_item);

end;

end;

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;

function TPyDelphiPersistent.Assign(ASource: PPyObject): PPyObject;

_object : TObject;

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;

_obj : PPyObject;

// 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;

Result := TPersistent;

end;

function TPyDelphiPersistent.GetDelphiObject: TPersistent;

Result := TPersistent(inherited DelphiObject);

end;

function TPyDelphiPersistent.GetNamePath_Wrapper(

args: PPyObject): PPyObject;

// We adjust the transmitted self argument

Adjust(@Self);

with GetPythonEngine do begin

if PyArg_ParseTuple( args, ':GetNamePath' ) <> 0 then begin

Result := PyUnicodeFromString(DelphiObject.GetNamePath)

end else

Result := nil;

end;

end;

class procedure TPyDelphiPersistent.RegisterMethods(

PythonType: TPythonType);

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);

inherited DelphiObject := Value;

end;

class function TCollectionAccess.ExpectedContainerClass: TClass;

Result := TCollection;

end;

function TCollectionAccess.GetContainer: TCollection;

Result := TCollection(inherited Container);

end;

function TCollectionAccess.GetItem(AIndex: Integer): PPyObject;

Result := Wrap( Container.Items[AIndex] );

end;

function TCollectionAccess.GetSize: Integer;

Result := Container.Count;

end;

function TCollectionAccess.IndexOf(AValue: PPyObject): Integer;

i : Integer;

_obj : TPyObject;

_item : TCollectionItem;

Result := -1;

with GetPythonEngine do

begin

if PyLong_Check(AValue) then

begin

_item := Container.FindItemID(PyLong_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;

Result := 'TCollection.Items';

end;

class function TCollectionAccess.SupportsIndexOf: Boolean;

Result := True;

end;

function TPyDelphiCollection.Add_Wrapper(args: PPyObject): PPyObject;

// 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;

// 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;

// 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;

Index : integer;

// 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;

Result := TCollection;

end;

function TPyDelphiCollection.EndUpdate_Wrapper(args: PPyObject): PPyObject;

// 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;

Result := TCollectionAccess;

end;

function TPyDelphiCollection.GetDelphiObject: TCollection;

Result := TCollection(inherited DelphiObject);

end;

function TPyDelphiCollection.Get_Count(AContext: Pointer): PPyObject;

Adjust(@Self);

Result := GetPythonEngine.PyLong_FromLong(DelphiObject.Count);

end;

function TPyDelphiCollection.Get_Items(AContext: Pointer): PPyObject;

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;

Adjust(@Self);

Result := Wrap(DelphiObject.Owner);

end;

function TPyDelphiCollection.Insert_Wrapper(args: PPyObject): PPyObject;

Index : integer;

// 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);

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);

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);

inherited DelphiObject := Value;

end;

class function TComponentsAccess.ExpectedContainerClass: TClass;

Result := TComponent;

end;

function TComponentsAccess.GetContainer: TComponent;

Result := TComponent(inherited Container);

end;

function TComponentsAccess.GetItem(AIndex: Integer): PPyObject;

Result := Wrap( Container.Components[AIndex] );

end;

function TComponentsAccess.GetSize: Integer;

Result := Container.ComponentCount;

end;

function TComponentsAccess.IndexOf(AValue: PPyObject): Integer;

i : Integer;

S : string;

_obj : TPyObject;

_value : TObject;

_comp : TComponent;

Result := -1;

with GetPythonEngine do

begin

if PyUnicode_Check(AValue) then

begin

S := PyUnicodeAsString(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;

Result := True;

end;

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;

procedure TPyDelphiObjectNexus.Notification(AComponent: TComponent; Operation: TOperation);

if (Operation = opRemove) and Assigned(FOnFreeNotify) then

FOnFreeNotify(Self, AComponent);

inherited Notification(AComponent, Operation);

end;

function TPyDelphiComponent.BindMethodsToEvents(args: PPyObject): PPyObject;

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;

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 := PyObjectAsString(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, PyUnicodeFromString(_compName));

PyTuple_SetItem(_pair, 1, PyUnicodeFromString(_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;

Adjust(@Self);

Result := GetPythonEngine.PyLong_FromLong(DelphiObject.ComponentCount);

end;

function TPyDelphiComponent.Get_Components(AContext: Pointer): PPyObject;

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;

Adjust(@Self);

Result := Wrap(DelphiObject.Owner);

end;

function TPyDelphiComponent.GetParentComponent_Wrapper(

args: PPyObject): PPyObject;

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;

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;

Component: TComponent;

Name: string;

Result := nil;

if Assigned(DelphiObject) then

begin

if GetPythonEngine.PyUnicode_Check(Key) then

begin

Name := GetPythonEngine.PyUnicodeAsString(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;

Result := TComponent(inherited DelphiObject);

end;

procedure TPyDelphiComponent.SetDelphiObject(const Value: TComponent);

inherited DelphiObject := Value;

end;

class procedure TPyDelphiComponent.RegisterGetSets(

PythonType: TPythonType);

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);

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);

inherited;

PythonType.Services.Mapping := PythonType.Services.Mapping + [msLength, msSubscript];

end;

class function TPyDelphiComponent.GetContainerAccessClass: TContainerAccessClass;

Result := TComponentsAccess;

end;

function TPyDelphiComponent.MpLength: NativeInt;

Result := SqLength;

end;

function TPyDelphiComponent.MpSubscript(obj: PPyObject): PPyObject;

_name : UnicodeString;

_comp : TComponent;

with GetPythonEngine do

begin

if PyLong_Check(obj) then

Result := SqItem(PyLong_AsLong(obj))

else if PyUnicode_Check(obj) then

begin

_name := PyUnicodeAsString(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;

Assert(Assigned(DelphiObject));

if not Assigned(fFreeNotificationComp) then

begin

fFreeNotificationComp := TPyDelphiObjectNexus.Create(nil);

TPyDelphiObjectNexus(fFreeNotificationComp).OnFreeNotify := HandleFreeNotificationEvent;

end;

DelphiObject.FreeNotification(fFreeNotificationComp);

end;