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;

function InternalReadComponent(const AResFile: string;

const AInstance: TComponent): boolean; virtual;

// 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, kwds: 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;

TPyDelphiStream = class(TPyDelphiObject)

private

function GetDelphiObject: TStream;

procedure SetDelphiObject(const Value: TStream);

function GetReadCount(const AArgs: PPyObject): integer; inline;

protected

function ReadBytes_Wrapper(const AArgs: PPyObject): PPyObject;

function ReadInt_Wrapper(const AArgs: PPyObject): PPyObject;

function ReadString_Wrapper(const AArgs: PPyObject): PPyObject;

function ReadFloat_Wrapper(const AArgs: PPyObject): PPyObject;

function WriteBytes_Wrapper(const AArgs: PPyObject): PPyObject;

function WriteInt_Wrapper(const AArgs: PPyObject): PPyObject;

function WriteString_Wrapper(const AArgs: PPyObject): PPyObject;

function WriteFloat_Wrapper(const AArgs: PPyObject): PPyObject;

public

// Class methods

class function DelphiObjectClass : TClass; override;

class procedure SetupType(PythonType: TPythonType); override;

class procedure RegisterMethods( PythonType : TPythonType ); override;

// Properties

property DelphiObject: TStream read GetDelphiObject write SetDelphiObject;

end;

TPyDelphiHandleStream = class(TPyDelphiStream)

private

function GetDelphiObject: THandleStream;

procedure SetDelphiObject(const Value: THandleStream);

public

constructor CreateWith(APythonType: TPythonType; args, kwds: PPyObject); override;

// Class methods

class function DelphiObjectClass : TClass; override;

// Properties

property DelphiObject: THandleStream read GetDelphiObject write SetDelphiObject;

end;

TPyDelphiFileStream = class(TPyDelphiHandleStream)

private

function GetDelphiObject: TFileStream;

procedure SetDelphiObject(const Value: TFileStream);

public

constructor CreateWith(APythonType: TPythonType; args, kwds: PPyObject); override;

// Class methods

class function DelphiObjectClass : TClass; override;

// Properties

property DelphiObject: TFileStream read GetDelphiObject write SetDelphiObject;

end;

TPyDelphiBufferedFileStream = class(TPyDelphiFileStream)

private

function GetDelphiObject: TBufferedFileStream;

procedure SetDelphiObject(const Value: TBufferedFileStream);

public

constructor CreateWith(APythonType: TPythonType; args, kwds: PPyObject); override;

// Class methods

class function DelphiObjectClass : TClass; override;

// Properties

property DelphiObject: TBufferedFileStream read GetDelphiObject write SetDelphiObject;

end;

TPyDelphiCustomMemoryStream = class(TPyDelphiStream)

private

function GetDelphiObject: TCustomMemoryStream;

procedure SetDelphiObject(const Value: TCustomMemoryStream);

public

// Class methods

class function DelphiObjectClass : TClass; override;

// Properties

property DelphiObject: TCustomMemoryStream read GetDelphiObject write SetDelphiObject;

end;

TPyDelphiMemoryStream = class(TPyDelphiCustomMemoryStream)

private

function GetDelphiObject: TMemoryStream;

procedure SetDelphiObject(const Value: TMemoryStream);

public

// Class methods

class function DelphiObjectClass : TClass; override;

// Properties

property DelphiObject: TMemoryStream read GetDelphiObject write SetDelphiObject;

end;

TPyDelphiByteStream = class(TPyDelphiMemoryStream)

private

function GetDelphiObject: TBytesStream;

procedure SetDelphiObject(const Value: TBytesStream);

public

constructor CreateWith(APythonType: TPythonType; args, kwds: PPyObject); override;

// Class methods

class function DelphiObjectClass : TClass; override;

// Properties

property DelphiObject: TBytesStream read GetDelphiObject write SetDelphiObject;

end;

TPyDelphiStringStream = class(TPyDelphiByteStream)

private

function GetDelphiObject: TStringStream;

procedure SetDelphiObject(const Value: TStringStream);

public

constructor CreateWith(APythonType: TPythonType; args, kwds: PPyObject); override;

// Class methods

class function DelphiObjectClass : TClass; override;

// Properties

property DelphiObject: TStringStream read GetDelphiObject write SetDelphiObject;

end;

TPyDelphiResourceStream = class(TPyDelphiCustomMemoryStream)

private

function GetDelphiObject: TResourceStream;

procedure SetDelphiObject(const Value: TResourceStream);

public

constructor CreateWith(APythonType: TPythonType; args, kwds: PPyObject); override;

// Class methods

class function DelphiObjectClass : TClass; override;

// Properties

property DelphiObject: TResourceStream read GetDelphiObject write SetDelphiObject;

end;

{ Helper functions }

function ShiftToPython(AShift : TShiftState) : PPyObject;

TypInfo {$IFNDEF FPC}, System.Rtti{$ENDIF};

TPyReader = class(TReader)

private

FPyObject: TPyDelphiObject;

FInstance: TComponent;

procedure DoFind(Reader: TReader; const ClassName: string; var ComponentClass: TComponentClass);

protected

procedure SetName(Component: TComponent; var Name: string); override;

function FindMethod(Root: TComponent; const AMethodName: string): Pointer; override;

public

constructor Create(APyObject: TPyDelphiObject; Stream: TStream; BufSize: Integer);

end;

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

//TFileStream mode

APyDelphiWrapper.DefineVar('fmCreate', fmCreate);

APyDelphiWrapper.DefineVar('fmOpenRead', fmOpenRead);

APyDelphiWrapper.DefineVar('fmOpenWrite', fmOpenWrite);

APyDelphiWrapper.DefineVar('fmOpenReadWrite', fmOpenReadWrite);

{$WARN SYMBOL_PLATFORM OFF}

{$IFDEF MSWINDOWS}

APyDelphiWrapper.DefineVar('fmShareCompat', fmShareCompat);

{$ENDIF MSWINDOWS}

{$WARN SYMBOL_PLATFORM ON}

APyDelphiWrapper.DefineVar('fmShareExclusive', fmShareExclusive);

APyDelphiWrapper.DefineVar('fmShareDenyWrite', fmShareDenyWrite);

{$WARN SYMBOL_PLATFORM OFF}

{$IFDEF MSWINDOWS}

APyDelphiWrapper.DefineVar('fmShareDenyRead', fmShareDenyRead);

{$ENDIF MSWINDOWS}

{$WARN SYMBOL_PLATFORM ON}

APyDelphiWrapper.DefineVar('fmShareDenyNone', fmShareDenyNone);

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

APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiStream);

APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiHandleStream);

APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiFileStream);

APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiBufferedFileStream);

APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiCustomMemoryStream);

APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiMemoryStream);

APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiByteStream);

APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiStringStream);

APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiResourceStream);

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

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

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

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