{$I Definition.Inc}
unit WrapDelphiTypes;
interface
uses
Classes,
SysUtils,
PythonEngine,
Types,
WrapDelphi;
type
TPyDelphiPoint = class(TPyObject)
private
fValue: TPoint;
protected
// Exposed Getters
function Get_X(Acontext : Pointer) : PPyObject; cdecl;
function Get_Y(Acontext : Pointer) : PPyObject; cdecl;
// Exposed Setters
function Set_X(AValue : PPyObject; AContext : Pointer) : Integer; cdecl;
function Set_Y(AValue : PPyObject; AContext : Pointer) : Integer; cdecl;
public
constructor CreateWith( APythonType : TPythonType; args : PPyObject ); override;
function Compare( obj: PPyObject) : Integer; override;
function Repr : PPyObject; override;
class procedure RegisterGetSets( PythonType : TPythonType ); override;
class procedure SetupType( PythonType : TPythonType ); override;
property Value : TPoint read fValue write fValue;
end;
TPyDelphiRect = class(TPyObject)
private
fValue: TRect;
protected
// Exposed Getters
function Get_Left(Acontext : Pointer) : PPyObject; cdecl;
function Get_Top(Acontext : Pointer) : PPyObject; cdecl;
function Get_Right(Acontext : Pointer) : PPyObject; cdecl;
function Get_Bottom(Acontext : Pointer) : PPyObject; cdecl;
function Get_TopLeft(Acontext : Pointer) : PPyObject; cdecl;
function Get_BottomRight(Acontext : Pointer) : PPyObject; cdecl;
// Exposed Setters
function Set_Left(AValue : PPyObject; AContext : Pointer) : Integer; cdecl;
function Set_Top(AValue : PPyObject; AContext : Pointer) : Integer; cdecl;
function Set_Right(AValue : PPyObject; AContext : Pointer) : Integer; cdecl;
function Set_Bottom(AValue : PPyObject; AContext : Pointer) : Integer; cdecl;
function Set_TopLeft(AValue : PPyObject; AContext : Pointer) : Integer; cdecl;
function Set_BottomRight(AValue : PPyObject; AContext : Pointer) : Integer; cdecl;
public
PyDelphiWrapper : TPyDelphiWrapper;
constructor CreateWith( APythonType : TPythonType; args : PPyObject ); override;
function Compare( obj: PPyObject) : Integer; override;
function Repr : PPyObject; override;
class procedure RegisterGetSets( PythonType : TPythonType ); override;
class procedure SetupType( PythonType : TPythonType ); override;
property Value : TRect read fValue write fValue;
end;
TPyDelphiSize = class(TPyObject)
private
fValue: TSize;
protected
// Exposed Getters
function Get_CX(Acontext : Pointer) : PPyObject; cdecl;
function Get_CY(Acontext : Pointer) : PPyObject; cdecl;
// Exposed Setters
function Set_CX(AValue : PPyObject; AContext : Pointer) : Integer; cdecl;
function Set_CY(AValue : PPyObject; AContext : Pointer) : Integer; cdecl;
public
constructor CreateWith( APythonType : TPythonType; args : PPyObject ); override;
function Compare( obj: PPyObject) : Integer; override;
function Repr : PPyObject; override;
class procedure RegisterGetSets( PythonType : TPythonType ); override;
class procedure SetupType( PythonType : TPythonType ); override;
property Value : TSize read fValue write fValue;
end;
function WrapPoint(APyDelphiWrapper : TPyDelphiWrapper; const APoint : TPoint) : PPyObject;
function WrapRect(APyDelphiWrapper : TPyDelphiWrapper; const ARect : TRect) : PPyObject;
function WrapSize(APyDelphiWrapper : TPyDelphiWrapper; const ASize : TSize) : PPyObject;
function CheckPointAttribute(AAttribute : PPyObject; const AAttributeName : string; out AValue : TPoint) : Boolean;
function CheckRectAttribute(AAttribute : PPyObject; const AAttributeName : string; out AValue : TRect) : Boolean;
function CheckSizeAttribute(AAttribute : PPyObject; const AAttributeName : string; out AValue : TSize) : Boolean;
implementation
uses
Math;
{ Register the wrappers, the globals and the constants }
type
TTypesRegistration = class(TRegisteredUnit)
public
function Name : string; override;
procedure RegisterWrappers(APyDelphiWrapper : TPyDelphiWrapper); override;
procedure DefineVars(APyDelphiWrapper : TPyDelphiWrapper); override;
end;
{ TExtCtrlsRegistration }
procedure TTypesRegistration.DefineVars(APyDelphiWrapper: TPyDelphiWrapper);
begin
inherited;
end;
function TTypesRegistration.Name: string;
begin
Result := 'Types';
end;
procedure TTypesRegistration.RegisterWrappers(APyDelphiWrapper: TPyDelphiWrapper);
begin
inherited;
APyDelphiWrapper.RegisterHelperType(TPyDelphiPoint);
APyDelphiWrapper.RegisterHelperType(TPyDelphiRect);
APyDelphiWrapper.RegisterHelperType(TPyDelphiSize);
end;
{ Helper functions }
function WrapPoint(APyDelphiWrapper : TPyDelphiWrapper; const APoint : TPoint) : PPyObject;
var
_type : TPythonType;
begin
_type := APyDelphiWrapper.GetHelperType('PointType');
Result := _type.CreateInstance;
(PythonToDelphi(Result) as TPyDelphiPoint).Value := APoint;
end;
function WrapRect(APyDelphiWrapper : TPyDelphiWrapper; const ARect : TRect) : PPyObject;
var
_type : TPythonType;
begin
_type := APyDelphiWrapper.GetHelperType('RectType');
Result := _type.CreateInstance;
with PythonToDelphi(Result) as TPyDelphiRect do
begin
PyDelphiWrapper := APyDelphiWrapper;
Value := ARect;
end;
end;
function WrapSize(APyDelphiWrapper : TPyDelphiWrapper; const ASize : TSize) : PPyObject;
var
_type : TPythonType;
begin
_type := APyDelphiWrapper.GetHelperType('SizeType');
Result := _type.CreateInstance;
(PythonToDelphi(Result) as TPyDelphiSize).Value := ASize;
end;
function CheckPointAttribute(AAttribute : PPyObject; const AAttributeName : string; out AValue : TPoint) : Boolean;
begin
with GetPythonEngine do
begin
if IsDelphiObject(AAttribute) and (PythonToDelphi(AAttribute) is TPyDelphiPoint) then
begin
AValue := TPyDelphiPoint(PythonToDelphi(AAttribute)).Value;
Result := True;
end
else
begin
Result := False;
with GetPythonEngine do
PyErr_SetString (PyExc_AttributeError^,
PAnsiChar(AnsiString(Format('%s receives only Point objects', [AAttributeName]))));
end;
end;
end;
function CheckRectAttribute(AAttribute : PPyObject; const AAttributeName : string; out AValue : TRect) : Boolean;
begin
with GetPythonEngine do
begin
if IsDelphiObject(AAttribute) and (PythonToDelphi(AAttribute) is TPyDelphiRect) then
begin
AValue := TPyDelphiRect(PythonToDelphi(AAttribute)).Value;
Result := True;
end
else
begin
Result := False;
with GetPythonEngine do
PyErr_SetString (PyExc_AttributeError^,
PAnsiChar(AnsiString(Format('%s receives only Rect objects', [AAttributeName]))));
end;
end;
end;
function CheckSizeAttribute(AAttribute : PPyObject; const AAttributeName : string; out AValue : TSize) : Boolean;
begin
with GetPythonEngine do
begin
if IsDelphiObject(AAttribute) and (PythonToDelphi(AAttribute) is TPyDelphiSize) then
begin
AValue := TPyDelphiSize(PythonToDelphi(AAttribute)).Value;
Result := True;
end
else
begin
Result := False;
with GetPythonEngine do
PyErr_SetString (PyExc_AttributeError^,
PAnsiChar(AnsiString(Format('%s receives only Size objects', [AAttributeName]))));
end;
end;
end;
{ TPyDelphiPoint }
function TPyDelphiPoint.Compare(obj: PPyObject): Integer;
var
_other : TPyDelphiPoint;
begin
if IsDelphiObject(obj) and (PythonToDelphi(obj) is TPyDelphiPoint) then
begin
_other := TPyDelphiPoint(PythonToDelphi(obj));
Result := CompareValue(Value.X, _other.Value.X);
if Result = 0 then
Result := CompareValue(Value.Y, _other.Value.Y);
end
else
Result := 1;
end;
constructor TPyDelphiPoint.CreateWith(APythonType: TPythonType;
args: PPyObject);
var
x, y : Integer;
begin
inherited;
if APythonType.Engine.PyArg_ParseTuple( args, 'ii:Create',@x, @y ) <> 0 then
begin
fValue.X := x;
fValue.Y := y;
end
end;
function TPyDelphiPoint.Get_X(Acontext: Pointer): PPyObject;
begin
Adjust(@Self);
Result := GetPythonEngine.PyInt_FromLong(Value.X);
end;
function TPyDelphiPoint.Get_Y(Acontext: Pointer): PPyObject;
begin
Adjust(@Self);
Result := GetPythonEngine.PyInt_FromLong(Value.Y);
end;
class procedure TPyDelphiPoint.RegisterGetSets(PythonType: TPythonType);
begin
inherited;
with PythonType do
begin
AddGetSet('X', @TPyDelphiPoint.Get_X, @TPyDelphiPoint.Set_X,
'Provides access to the X coordinate of a point', nil);
AddGetSet('Y', @TPyDelphiPoint.Get_Y, @TPyDelphiPoint.Set_Y,
'Provides access to the Y coordinate of a point', nil);
end;
end;
function TPyDelphiPoint.Repr: PPyObject;
begin
Result := GetPythonEngine.PyString_FromDelphiString(Format('