{$I Definition.Inc} unit WrapDelphiGrids; interface uses Classes, SysUtils, PythonEngine, WrapDelphi, WrapDelphiClasses, WrapDelphiControls, Windows, Grids, TypInfo; type TDrawCellEventHandler = class(TEventHandler) protected procedure DoEvent(Sender: TObject; ACol, ARow: Longint; Rect: TRect; State: TGridDrawState); public constructor Create(PyDelphiWrapper : TPyDelphiWrapper; Component : TObject; PropertyInfo : PPropInfo; Callable : PPyObject); override; class function GetTypeInfo : PTypeInfo; override; end; TSelectCellEventHandler = class(TEventHandler) protected procedure DoEvent(Sender: TObject; ACol, ARow: Longint; var CanSelect: Boolean); public constructor Create(PyDelphiWrapper : TPyDelphiWrapper; Component : TObject; PropertyInfo : PPropInfo; Callable : PPyObject); override; class function GetTypeInfo : PTypeInfo; override; end; TGridColWidthsAccess = class(TContainerAccess) private function GetContainer: TCustomDrawGrid; public function GetItem(AIndex : Integer) : PPyObject; override; function GetSize : Integer; override; function SetItem(AIndex : Integer; AValue : PPyObject) : Boolean; override; class function ExpectedContainerClass : TClass; override; class function SupportsWrite : Boolean; override; class function Name : string; override; property Container : TCustomDrawGrid read GetContainer; end; TPyDelphiCustomGrid = class (TPyDelphiWinControl) private function GetDelphiObject: TCustomGrid; procedure SetDelphiObject(const Value: TCustomGrid); public class function DelphiObjectClass : TClass; override; // Properties property DelphiObject: TCustomGrid read GetDelphiObject write SetDelphiObject; end; TPyDelphiCustomDrawGrid = class (TPyDelphiCustomGrid) private function GetDelphiObject: TCustomDrawGrid; procedure SetDelphiObject(const Value: TCustomDrawGrid); protected // methods //function CellRect(ACol, ARow: Longint): TRect; //procedure MouseToCell(X, Y: Integer; var ACol, ARow: Longint); class function GetTypeName : string; override; // property getters function Get_Canvas(AContext : Pointer): PPyObject; cdecl; function Get_Col(AContext : Pointer): PPyObject; cdecl; function Get_ColWidths( AContext : Pointer) : PPyObject; cdecl; function Get_EditorMode(AContext : Pointer): PPyObject; cdecl; function Get_GridHeight(AContext : Pointer): PPyObject; cdecl; function Get_GridWidth(AContext : Pointer): PPyObject; cdecl; function Get_LeftCol(AContext : Pointer): PPyObject; cdecl; function Get_Selection(AContext : Pointer): PPyObject; cdecl; function Get_Row(AContext : Pointer): PPyObject; cdecl; //function Get_RowHeights(AContext : Pointer): PPyObject; cdecl; //function Get_TabStops(AContext : Pointer): PPyObject; cdecl; function Get_TopRow(AContext : Pointer): PPyObject; cdecl; // property setters function Set_Col(AValue : PPyObject; AContext : Pointer): Integer; cdecl; function Set_EditorMode(AValue : PPyObject; AContext : Pointer): Integer; cdecl; function Set_LeftCol(AValue : PPyObject; AContext : Pointer): Integer; cdecl; function Set_Selection(AValue : PPyObject; AContext : Pointer): Integer; cdecl; function Set_Row(AValue : PPyObject; AContext : Pointer): Integer; cdecl; function Set_TopRow(AValue : PPyObject; AContext : Pointer): Integer; cdecl; public class function DelphiObjectClass : TClass; override; // Class methods class procedure RegisterGetSets( PythonType : TPythonType ); override; // Properties property DelphiObject: TCustomDrawGrid read GetDelphiObject write SetDelphiObject; end; TPyDelphiDrawGrid = class (TPyDelphiCustomDrawGrid) private function GetDelphiObject: TDrawGrid; procedure SetDelphiObject(const Value: TDrawGrid); protected class function GetTypeName : string; override; public class function DelphiObjectClass : TClass; override; // Properties property DelphiObject: TDrawGrid read GetDelphiObject write SetDelphiObject; end; {$IFDEF FPC} TPyDelphiStringGrid = class (TPyDelphiCustomDrawGrid) {$ELSE FPC} TPyDelphiStringGrid = class (TPyDelphiDrawGrid) {$ENDIF FPC} private function GetDelphiObject: TStringGrid; procedure SetDelphiObject(const Value: TStringGrid); protected class function GetTypeName : string; override; function GetCell(args : PPyObject): PPyObject; cdecl; function SetCell(args : PPyObject): PPyObject; cdecl; public class function DelphiObjectClass : TClass; override; class procedure RegisterMethods( PythonType : TPythonType ); override; // Properties property DelphiObject: TStringGrid read GetDelphiObject write SetDelphiObject; end; implementation uses WrapDelphiTypes; { Register the wrappers, the globals and the constants } type TGridsRegistration = class(TRegisteredUnit) public function Name : string; override; procedure RegisterWrappers(APyDelphiWrapper : TPyDelphiWrapper); override; procedure DefineVars(APyDelphiWrapper : TPyDelphiWrapper); override; end; { TGridsRegistration } procedure TGridsRegistration.DefineVars(APyDelphiWrapper: TPyDelphiWrapper); begin inherited; APyDelphiWrapper.DefineVar('gdSelected', 'gdSelected'); APyDelphiWrapper.DefineVar('gdFocused', 'gdFocused'); APyDelphiWrapper.DefineVar('gdFixed', 'gdFixed'); end; function TGridsRegistration.Name: string; begin Result := 'Grids'; end; procedure TGridsRegistration.RegisterWrappers(APyDelphiWrapper: TPyDelphiWrapper); begin inherited; APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiCustomGrid); APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiCustomDrawGrid); APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiDrawGrid); APyDelphiWrapper.RegisterDelphiWrapper(TPyDelphiStringGrid); APyDelphiWrapper.EventHandlers.RegisterHandler(TDrawCellEventHandler); APyDelphiWrapper.EventHandlers.RegisterHandler(TSelectCellEventHandler); end; { Helper functions } function MakeGridDrawState(AState : TGridDrawState) : PPyObject; var _item : PPyObject; begin with GetPythonEngine do begin Result := PyList_New(0); if gdSelected in AState then begin _item := PyString_FromDelphiString('gdSelected'); PyList_Append(Result, _item); Py_DecRef(_item); end; if gdFocused in AState then begin _item := PyString_FromDelphiString('gdFocused'); PyList_Append(Result, _item); Py_DecRef(_item); end; if gdFixed in AState then begin _item := PyString_FromDelphiString('gdFixed'); PyList_Append(Result, _item); Py_DecRef(_item); end; end; end; { TDrawCellEventHandler } constructor TDrawCellEventHandler.Create(PyDelphiWrapper: TPyDelphiWrapper; Component: TObject; PropertyInfo: PPropInfo; Callable: PPyObject); var Method : TMethod; begin inherited; Method.Code := @TDrawCellEventHandler.DoEvent; Method.Data := Self; SetMethodProp(Component, PropertyInfo, Method); end; procedure TDrawCellEventHandler.DoEvent(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); Var PyObject, PyTuple, PyResult, PyCol, PyRow, PyRect, PyState: PPyObject; begin Assert(Assigned(PyDelphiWrapper)); if Assigned(Callable) and PythonOK then with GetPythonEngine do begin PyObject := PyDelphiWrapper.Wrap(Sender); PyCol := PyInt_FromLong(ACol); PyRow := PyInt_FromLong(ARow); PyRect := WrapRect(PyDelphiWrapper, Rect); PyState := MakeGridDrawState(State); PyTuple := PyTuple_New(5); GetPythonEngine.PyTuple_SetItem(PyTuple, 0, PyObject); GetPythonEngine.PyTuple_SetItem(PyTuple, 1, PyCol); GetPythonEngine.PyTuple_SetItem(PyTuple, 2, PyRow); GetPythonEngine.PyTuple_SetItem(PyTuple, 3, PyRect); GetPythonEngine.PyTuple_SetItem(PyTuple, 4, PyState); try PyResult := PyObject_CallObject(Callable, PyTuple); Py_XDECREF(PyResult); finally Py_DECREF(PyTuple); end; CheckError; end; end; class function TDrawCellEventHandler.GetTypeInfo: PTypeInfo; begin {$IFDEF FPC} Result := System.TypeInfo(TOnDrawCell); {$ELSE FPC} Result := System.TypeInfo(TDrawCellEvent); {$ENDIF FPC} end; { TSelectCellEventHandler } constructor TSelectCellEventHandler.Create( PyDelphiWrapper: TPyDelphiWrapper; Component: TObject; PropertyInfo: PPropInfo; Callable: PPyObject); var Method : TMethod; begin inherited; Method.Code := @TSelectCellEventHandler.DoEvent; Method.Data := Self; SetMethodProp(Component, PropertyInfo, Method); end; procedure TSelectCellEventHandler.DoEvent(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean); Var PyObject, PyTuple, PyResult, PyCol, PyRow, PyCanSelect: PPyObject; _varParam : TPyDelphiVarParameter; begin Assert(Assigned(PyDelphiWrapper)); if Assigned(Callable) and PythonOK then with GetPythonEngine do begin PyObject := PyDelphiWrapper.Wrap(Sender); PyCol := PyInt_FromLong(ACol); PyRow := PyInt_FromLong(ARow); PyCanSelect := CreateVarParam(PyDelphiWrapper, CanSelect); _varParam := PythonToDelphi(PyCanSelect) as TPyDelphiVarParameter; PyTuple := PyTuple_New(4); GetPythonEngine.PyTuple_SetItem(PyTuple, 0, PyObject); GetPythonEngine.PyTuple_SetItem(PyTuple, 1, PyCol); GetPythonEngine.PyTuple_SetItem(PyTuple, 2, PyRow); GetPythonEngine.PyTuple_SetItem(PyTuple, 3, PyCanSelect); try PyResult := PyObject_CallObject(Callable, PyTuple); if Assigned(PyResult) then begin Py_DECREF(PyResult); CanSelect := PyObject_IsTrue(_varParam.Value) = 1; end; finally Py_DECREF(PyTuple); end; CheckError; end; end; class function TSelectCellEventHandler.GetTypeInfo: PTypeInfo; begin {$IFDEF FPC} Result := System.TypeInfo(TOnSelectCellEvent); {$ELSE FPC} Result := System.TypeInfo(TSelectCellEvent); {$ENDIF FPC} end; { TGridColWidthsAccess } class function TGridColWidthsAccess.ExpectedContainerClass: TClass; begin result:=TCustomGrid; end; function TGridColWidthsAccess.GetContainer: TCustomDrawGrid; begin result:=TCustomDrawGrid(inherited Container); end; function TGridColWidthsAccess.GetItem(AIndex: Integer): PPyObject; begin with GetPythonEngine do Result:=PyInt_FromLong(Container.ColWidths[AIndex]); end; type TCustomDrawGridAccess = class(TCustomDrawGrid); function TGridColWidthsAccess.GetSize: Integer; begin result:=TCustomDrawGridAccess(Container).ColCount; end; class function TGridColWidthsAccess.Name: string; begin result:='TCustomGrid.ColWidths'; end; function TGridColWidthsAccess.SetItem(AIndex: Integer; AValue: PPyObject): Boolean; begin result:=True; with GetPythonEngine do Container.ColWidths[AIndex]:=PyInt_AsLong(AValue); end; class function TGridColWidthsAccess.SupportsWrite: Boolean; begin result:=True; end; { TPyDelphiCustomGrid } class function TPyDelphiCustomGrid.DelphiObjectClass: TClass; begin Result := TCustomGrid; end; function TPyDelphiCustomGrid.GetDelphiObject: TCustomGrid; begin Result := TCustomGrid(inherited DelphiObject); end; procedure TPyDelphiCustomGrid.SetDelphiObject(const Value: TCustomGrid); begin inherited DelphiObject := Value; end; { TPyDelphiCustomDrawGrid } class function TPyDelphiCustomDrawGrid.DelphiObjectClass: TClass; begin Result := TCustomDrawGrid; end; function TPyDelphiCustomDrawGrid.GetDelphiObject: TCustomDrawGrid; begin Result := TCustomDrawGrid(inherited DelphiObject); end; function TPyDelphiCustomDrawGrid.Get_Canvas(AContext: Pointer): PPyObject; begin Adjust(@Self); Result := Wrap(DelphiObject.Canvas); end; function TPyDelphiCustomDrawGrid.Get_ColWidths( AContext: Pointer): PPyObject; begin Adjust(@Self); Result := Self.PyDelphiWrapper.DefaultContainerType.CreateInstance; with PythonToDelphi(Result) as TPyDelphiContainer do Setup(Self.PyDelphiWrapper, TGridColWidthsAccess.Create(Self.PyDelphiWrapper, Self.DelphiObject)); end; function TPyDelphiCustomDrawGrid.Get_Col(AContext: Pointer): PPyObject; begin Adjust(@Self); Result := GetPythonEngine.PyInt_FromLong(DelphiObject.Col); end; function TPyDelphiCustomDrawGrid.Get_EditorMode( AContext: Pointer): PPyObject; begin Adjust(@Self); Result := GetPythonEngine.VariantAsPyObject(DelphiObject.EditorMode); end; function TPyDelphiCustomDrawGrid.Get_GridHeight( AContext: Pointer): PPyObject; begin Adjust(@Self); Result := GetPythonEngine.PyInt_FromLong(DelphiObject.GridHeight); end; function TPyDelphiCustomDrawGrid.Get_GridWidth( AContext: Pointer): PPyObject; begin Adjust(@Self); Result := GetPythonEngine.PyInt_FromLong(DelphiObject.GridWidth); end; function TPyDelphiCustomDrawGrid.Get_LeftCol(AContext: Pointer): PPyObject; begin Adjust(@Self); Result := GetPythonEngine.PyInt_FromLong(DelphiObject.LeftCol); end; function TPyDelphiCustomDrawGrid.Get_Row(AContext: Pointer): PPyObject; begin Adjust(@Self); Result := GetPythonEngine.PyInt_FromLong(DelphiObject.Row); end; function TPyDelphiCustomDrawGrid.Get_Selection( AContext: Pointer): PPyObject; begin Adjust(@Self); Result := WrapRect(PyDelphiWrapper, TRect(DelphiObject.Selection)); end; function TPyDelphiCustomDrawGrid.Get_TopRow(AContext: Pointer): PPyObject; begin Adjust(@Self); Result := GetPythonEngine.PyInt_FromLong(DelphiObject.TopRow); end; class function TPyDelphiCustomDrawGrid.GetTypeName : string; begin Result := 'CustomDrawGrid'; end; class procedure TPyDelphiCustomDrawGrid.RegisterGetSets( PythonType: TPythonType); begin inherited; with PythonType do begin AddGetSet('Canvas', @TPyDelphiCustomDrawGrid.Get_Canvas, nil, 'Specifies the TCanvas object that presents a drawing surface for the control.', nil); AddGetSet('Col', @TPyDelphiCustomDrawGrid.Get_Col, @TPyDelphiCustomDrawGrid.Set_Col, 'Specifies the index of the column that contains the selected cell.', nil); AddGetSet('ColWidths', @TPyDelphiCustomDrawGrid.Get_ColWidths, nil, 'Specifies column widths of the grid', nil); AddGetSet('EditorMode', @TPyDelphiCustomDrawGrid.Get_EditorMode, @TPyDelphiCustomDrawGrid.Set_EditorMode, 'Determines whether the current cell can be edited.', nil); AddGetSet('GridHeight', @TPyDelphiCustomDrawGrid.Get_GridHeight, nil, 'Specifies the height of the grid in pixels.', nil); AddGetSet('GridWidth', @TPyDelphiCustomDrawGrid.Get_GridWidth, nil, 'Specifies the width of the grid in pixels.', nil); AddGetSet('LeftCol', @TPyDelphiCustomDrawGrid.Get_LeftCol, @TPyDelphiCustomDrawGrid.Set_LeftCol, 'Specifies the index of the first visible scrollable column in the grid.', nil); AddGetSet('Selection', @TPyDelphiCustomDrawGrid.Get_Selection, @TPyDelphiCustomDrawGrid.Set_Selection, 'Indicates the boundaries of the current selection.', nil); AddGetSet('Row', @TPyDelphiCustomDrawGrid.Get_Row, @TPyDelphiCustomDrawGrid.Set_Row, 'Specifies the index of the row that contains the selected cell.', nil); AddGetSet('TopRow', @TPyDelphiCustomDrawGrid.Get_TopRow, @TPyDelphiCustomDrawGrid.Set_TopRow, 'Specifies the index of the first visible scrollable row in the grid.', nil); end; end; procedure TPyDelphiCustomDrawGrid.SetDelphiObject( const Value: TCustomDrawGrid); begin inherited DelphiObject := Value; end; function TPyDelphiCustomDrawGrid.Set_Col(AValue: PPyObject; AContext: Pointer): Integer; var _value : Integer; begin Adjust(@Self); if CheckIntAttribute(AValue, 'Col', _value) then begin DelphiObject.Col := _value; Result := 0; end else Result := -1; end; function TPyDelphiCustomDrawGrid.Set_EditorMode(AValue: PPyObject; AContext: Pointer): Integer; var _value : Boolean; begin Adjust(@Self); if CheckBoolAttribute(AValue, 'EditorMode', _value) then begin DelphiObject.EditorMode := _value; Result := 0; end else Result := -1; end; function TPyDelphiCustomDrawGrid.Set_LeftCol(AValue: PPyObject; AContext: Pointer): Integer; var _value : Integer; begin Adjust(@Self); if CheckIntAttribute(AValue, 'LeftCol', _value) then begin DelphiObject.LeftCol := _value; Result := 0; end else Result := -1; end; function TPyDelphiCustomDrawGrid.Set_Row(AValue: PPyObject; AContext: Pointer): Integer; var _value : Integer; begin Adjust(@Self); if CheckIntAttribute(AValue, 'Row', _value) then begin DelphiObject.Row := _value; Result := 0; end else Result := -1; end; function TPyDelphiCustomDrawGrid.Set_Selection(AValue: PPyObject; AContext: Pointer): Integer; var _value : TRect; begin Adjust(@Self); if CheckRectAttribute(AValue, 'Selection', _value) then begin DelphiObject.Selection := TGridRect(_value); Result := 0; end else Result := -1; end; function TPyDelphiCustomDrawGrid.Set_TopRow(AValue: PPyObject; AContext: Pointer): Integer; var _value : Integer; begin Adjust(@Self); if CheckIntAttribute(AValue, 'TopRow', _value) then begin DelphiObject.TopRow := _value; Result := 0; end else Result := -1; end; { TPyDelphiDrawGrid } class function TPyDelphiDrawGrid.DelphiObjectClass: TClass; begin Result := TDrawGrid; end; function TPyDelphiDrawGrid.GetDelphiObject: TDrawGrid; begin Result := TDrawGrid(inherited DelphiObject); end; class function TPyDelphiDrawGrid.GetTypeName : string; begin Result := 'DrawGrid'; end; procedure TPyDelphiDrawGrid.SetDelphiObject(const Value: TDrawGrid); begin inherited DelphiObject := Value; end; { TPyDelphiStringGrid } class function TPyDelphiStringGrid.DelphiObjectClass: TClass; begin Result := TStringGrid; end; function TPyDelphiStringGrid.GetDelphiObject: TStringGrid; begin Result := TStringGrid(inherited DelphiObject); end; class procedure TPyDelphiStringGrid.RegisterMethods( PythonType : TPythonType ); begin inherited; PythonType.AddMethod('GetCell', @TPyDelphiStringGrid.GetCell, 'TStringGrid.GetCell(col, row)'#10 + 'Returns the content of a cell'); PythonType.AddMethod('SetCell', @TPyDelphiStringGrid.SetCell, 'TStringGrid.SetCell(col, row, value)'#10 + 'Sets the content of a cell'); end; class function TPyDelphiStringGrid.GetTypeName : string; begin Result := 'StringGrid'; end; procedure TPyDelphiStringGrid.SetDelphiObject(const Value: TStringGrid); begin inherited DelphiObject := Value; end; function TPyDelphiStringGrid.GetCell(args: PPyObject): PPyObject; var col, row: integer; begin // adjust the transmitted self argument Adjust(@Self); with GetPythonEngine do begin if PyArg_ParseTuple( args, 'ii:GetCell',@col, @row ) <> 0 then Result := PyString_FromDelphiString(DelphiObject.Cells[col, row]) else Result := nil; end; end; function TPyDelphiStringGrid.SetCell(args: PPyObject): PPyObject; var col, row: integer; value: PPyObject; begin with GetPythonEngine do begin // adjust the transmitted self argument Adjust(@Self); if PyArg_ParseTuple( args, 'iiO:GetCell',@col, @row, @value ) <> 0 then begin DelphiObject.Cells[col, row]:= PyString_AsDelphiString(value); result:=ReturnNone; end else Result := nil; end; end; initialization RegisteredUnits.Add( TGridsRegistration.Create ); Classes.RegisterClasses([TDrawGrid, TStringGrid]); end.