{******************************************}
{                                          }
{             FastReport VCL               }
{            Table Object RTTI             }
{                                          }
{         Copyright (c) 1998-2021          }
{            by Fast Reports Inc.          }
{                                          }
{******************************************}

unit frxTableObjectRTTI;

interface

{$I frx.inc}

implementation

uses
  Types, Classes, SysUtils,
  fs_iinterpreter, frxClassRTTI, frxTableObject, Variants;


type
  TFunctions = class(TfsRTTIModule)
  private
    function CallMethod(Instance: TObject; ClassType: TClass;
      const MethodName: String; Caller: TfsMethodHelper): Variant;
    function GetProp(Instance: TObject; ClassType: TClass;
      const PropName: String): Variant;
    procedure SetProp(Instance: TObject; ClassType: TClass;
      const PropName: String; Value: Variant);
  public
    constructor Create(AScript: TfsScript); override;
  end;


{ TFunctions }

constructor TFunctions.Create(AScript: TfsScript);
begin
  inherited Create(AScript);
  with AScript do
  begin
    AddEnum('TfrxTablePagination', 'tpAcrossThenDown, tpDownThenAcross, tpDownThenAcrossWrapped');
    AddEnum('TfrxTableBandType', 'tbData, tbHeader, tbFooter, tbAggregateFooter, tbLocalAggregateFooter');

    with AddClass(TfrxTableCell, 'TfrxCustomMemoView') do
    begin
      AddMethod('function ParentTable: TfrxTableObject', CallMethod);
      AddMethod('function ParentRow: TfrxTableRow', CallMethod);
    end;

    with AddClass(TfrxCellData, 'TObject') do
    begin
      AddProperty('ColSpan', 'Integer', GetProp, SetProp);
      AddProperty('RowSpan', 'Integer', GetProp, SetProp);
      AddProperty('Value', 'Variant', GetProp, SetProp);
      AddProperty('Text', 'String', GetProp, SetProp);
    end;

    with AddClass(TfrxCustomTableBuilder, 'TPersistent') do
    begin
      AddMethod('procedure PrintRow(Index: Integer; TableBandType: TfrxTableBandType = tbData)', CallMethod);
      AddMethod('procedure PrintRows(Index: Integer = 0)', CallMethod);
      AddMethod('procedure PrintColumn(Index: Integer; TableBandType: TfrxTableBandType = tbData)', CallMethod);
      AddMethod('procedure PrintColumns(Index: Integer = 0)', CallMethod);
      AddMethod('procedure PageBreak', CallMethod);
      AddMethod('function ColumnCount: Integer', CallMethod);
      AddMethod('function RowCount: Integer', CallMethod);
      AddIndexProperty('CellData', 'Integer,Integer', 'TfrxCellData', CallMethod);
      AddProperty('PaginationOrder', 'TfrxTablePagination', GetProp, SetProp);
      AddProperty('PrintingRowIndex', 'Integer', GetProp, nil);
      AddProperty('PrintingColumnIndex', 'Integer', GetProp, nil);
    end;

    with AddClass(TfrxTableRowColumnBase, 'TfrxComponent') do
    begin
      AddMethod('function ParentTable: TfrxTableObject', CallMethod);
      AddProperty('Index', 'Integer', GetProp, nil);
    end;

    AddClass(TfrxTableColumn, 'TfrxTableRowColumnBase');

    with AddClass(TfrxTableRow, 'TfrxTableRowColumnBase') do
    begin
      AddProperty('CellCount', 'Integer', GetProp, nil);
      AddIndexProperty('Cells', 'Integer', 'TfrxTableCell', CallMethod);
    end;

    with AddClass(TfrxTableObject, 'TfrxStretcheable') do
    begin
      AddMethod('function CreateNewColumn(Index: Integer): TfrxTableColumn', CallMethod);
      AddMethod('function CreateNewRow(Index: Integer): TfrxTableRow', CallMethod);
      AddMethod('procedure AddColumn(Value: TfrxTableColumn)', CallMethod);
      AddMethod('procedure InsertColumn(Index: Integer; Value: TfrxTableColumn)', CallMethod);
      AddMethod('procedure MoveColumn(Index, NewIndex: Integer)', CallMethod);
      AddMethod('procedure DeleteColumn(Index: Integer)', CallMethod);
      AddMethod('procedure AddRow(Value: TfrxTableRow)', CallMethod);
      AddMethod('procedure InsertRow(Index: Integer; Value: TfrxTableRow)', CallMethod);
      AddMethod('procedure SwapRows(Row1, Row2: Integer)', CallMethod);
      AddMethod('procedure DeleteRow(Index: Integer)', CallMethod);
      AddMethod('procedure UpdateBounds;', CallMethod);
      AddMethod('procedure JoinSelection(TopX: Integer; TopY: Integer; BottomX: Integer; BottomY: Integer)', CallMethod);
      AddMethod('procedure SplitCell(aCell: TfrxTableCell)', CallMethod);
      AddMethod('function Cells(X, Y: Integer): TfrxTableCell', CallMethod);

      AddIndexProperty('Columns', 'Integer', 'TfrxTableColumn', CallMethod);
      AddIndexProperty('Rows', 'Integer', 'TfrxTableRow', CallMethod);
      AddProperty('TableHeight', 'Extended', GetProp, SetProp);
      AddProperty('TableWidth', 'Extended', GetProp, SetProp);
      AddProperty('TableBuilder', 'TfrxCustomTableBuilder', GetProp, nil);
    end;
  end;
end;

function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
  const MethodName: String; Caller: TfsMethodHelper): Variant;
begin
  Result := 0;
  if ClassType = TfrxCustomTableBuilder then
  begin
    if MethodName = 'PRINTROW' then
      TfrxCustomTableBuilder(Instance).PrintRow(Caller.Params[0], Caller.Params[1])
    else if MethodName = 'PRINTROWS' then
      TfrxCustomTableBuilder(Instance).PrintRows(Caller.Params[0])
    else if MethodName = 'PRINTCOLUMN' then
      TfrxCustomTableBuilder(Instance).PrintColumn(Caller.Params[0], Caller.Params[1])
    else if MethodName = 'PRINTCOLUMNS' then
      TfrxCustomTableBuilder(Instance).PrintColumns(Caller.Params[0])
    else if MethodName = 'PAGEBREAK' then
      TfrxCustomTableBuilder(Instance).PageBreak
    else if MethodName = 'COLUMNCOUNT' then
      Result := TfrxCustomTableBuilder(Instance).ColumnCount
    else if MethodName = 'ROWCOUNT' then
      Result := TfrxCustomTableBuilder(Instance).RowCount
    else if MethodName = 'CELLDATA.GET' then
      Result := frxInteger(TfrxCustomTableBuilder(Instance).CellData[Caller.Params[0], Caller.Params[1]])
  end
  else if ClassType = TfrxTableCell then
  begin
    if MethodName = 'PARENTTABLE' then
      Result := frxInteger(TfrxTableCell(Instance).ParentTable)
    else if MethodName = 'PARENTROW' then
      Result := frxInteger(TfrxTableCell(Instance).ParentRow)
  end
  else if ClassType = TfrxTableRowColumnBase then
  begin
    if MethodName = 'PARENTTABLE' then
      Result := frxInteger(TfrxTableRowColumnBase(Instance).ParentTable)
  end
  else if ClassType = TfrxTableRow then
  begin
    if MethodName = 'CELLS.GET' then
      Result := frxInteger(TfrxTableRow(Instance).Cells[Caller.Params[0]])
  end
  else if ClassType = TfrxTableObject then
  begin
    if MethodName = 'CREATENEWCOLUMN' then
      Result := frxInteger(TfrxTableObject(Instance).CreateNewColumn(Caller.Params[0]))
    else if MethodName = 'CREATENEWROW' then
      Result := frxInteger(TfrxTableObject(Instance).CreateNewRow(Caller.Params[0]))
    else if MethodName = 'ADDCOLUMN' then
      TfrxTableObject(Instance).AddColumn(TfrxTableColumn(frxInteger(Caller.Params[0])))
    else if MethodName = 'INSERTCOLUMN' then
      TfrxTableObject(Instance).InsertColumn(Caller.Params[0], TfrxTableColumn(frxInteger(Caller.Params[1])))
    else if MethodName = 'MOVECOLUMN' then
      TfrxTableObject(Instance).MoveColumn(Caller.Params[0], Caller.Params[1])
    else if MethodName = 'DELETECOLUMN' then
      TfrxTableObject(Instance).DeleteColumn(Caller.Params[0])
    else if MethodName = 'ADDROW' then
      TfrxTableObject(Instance).AddRow(TfrxTableRow(frxInteger(Caller.Params[0])))
    else if MethodName = 'INSERTROW' then
      TfrxTableObject(Instance).InsertRow(Caller.Params[0], TfrxTableRow(frxInteger(Caller.Params[1])))
    else if MethodName = 'SWAPROWS' then
      TfrxTableObject(Instance).SwapRows(Caller.Params[0], Caller.Params[1])
    else if MethodName = 'DELETEROW' then
      TfrxTableObject(Instance).DeleteRow(Caller.Params[0])
    else if MethodName = 'UPDATEBOUNDS' then
      TfrxTableObject(Instance).UpdateBounds
    else if MethodName = 'JOINSELECTION' then
      TfrxTableObject(Instance).JoinSelection(Caller.Params[0], Caller.Params[1], Caller.Params[2], Caller.Params[3])
    else if MethodName = 'SPLITCELL' then
      TfrxTableObject(Instance).SplitCell(TfrxTableCell(frxInteger(Caller.Params[0])))
    else if MethodName = 'CELLS' then
      Result := frxInteger(TfrxTableObject(Instance).Cells[Caller.Params[0], Caller.Params[1]])
    else if MethodName = 'COLUMNS.GET' then
      Result := frxInteger(TfrxTableObject(Instance).Columns[Caller.Params[0]])
    else if MethodName = 'ROWS.GET' then
      Result := frxInteger(TfrxTableObject(Instance).Rows[Caller.Params[0]])
  end
end;

function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
  const PropName: String): Variant;
var
  cData: TfrxCellData;
begin
  Result := 0;

  if ClassType = TfrxTableRowColumnBase then
  begin
    if PropName = 'INDEX' then
      Result := TfrxTableRowColumnBase(Instance).Index
  end
  else if ClassType = TfrxTableRow then
  begin
    if PropName = 'CELLCOUNT' then
      Result := TfrxTableRow(Instance).CellCount
  end
  else if ClassType = TfrxTableObject then
  begin
    if PropName = 'TABLEHEIGHT' then
      Result := TfrxTableObject(Instance).TableHeight
    else if PropName = 'TABLEWIDTH' then
      Result := TfrxTableObject(Instance).TableWidth
   else if PropName = 'TABLEBUILDER' then
      Result := frxInteger(TfrxTableObject(Instance).TableBuilder);
  end
  else if ClassType = TfrxCustomTableBuilder then
  begin
    if PropName = 'PAGINATIONORDER' then
      Result := TfrxCustomTableBuilder(Instance).PaginationOrder
    else if PropName = 'PRINTINGROWINDEX' then
      Result := TfrxCustomTableBuilder(Instance).PrintingRowIndex
    else if PropName = 'PRINTINGCOLUMNINDEX' then
      Result := TfrxCustomTableBuilder(Instance).PrintingColumnIndex
  end
  else if ClassType = TfrxCellData then
  begin
    cData := TfrxCellData(Instance);
    if PropName = 'COLSPAN' then
      Result := cData.ColSpan
    else if PropName = 'COLSPAN' then
      Result := cData.ColSpan
    else if PropName = 'ROWSPAN' then
      Result := cData.RowSpan
    else if PropName = 'VALUE' then
      Result := cData.Value
    else if PropName = 'TEXT' then
      Result := cData.Text
  end
end;

procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
  const PropName: String; Value: Variant);
var
  cData: TfrxCellData;
begin
  if ClassType = TfrxTableObject then
  begin
    if PropName = 'TABLEHEIGHT' then
      TfrxTableObject(Instance).TableHeight := Value
    else if PropName = 'TABLEWIDTH' then
      TfrxTableObject(Instance).TableWidth := Value;
  end
  else if ClassType = TfrxCustomTableBuilder then
  begin
    if PropName = 'PAGINATIONORDER' then
      TfrxCustomTableBuilder(Instance).PaginationOrder := Value
  end
  else if ClassType = TfrxCellData then
  begin
    cData := TfrxCellData(Instance);
    if PropName = 'COLSPAN' then
      cData.ColSpan := Value
    else if PropName = 'COLSPAN' then
      cData.ColSpan := Value
    else if PropName = 'ROWSPAN' then
      cData.RowSpan := Value
    else if PropName = 'VALUE' then
      cData.Value := Value
    else if PropName = 'TEXT' then
      cData.Text := Value
  end
end;

initialization
  fsRTTIModules.Add(TFunctions);

finalization
  fsRTTIModules.Remove(TFunctions);

end.