unit uDAPascalScript;

{----------------------------------------------------------------------------}
{ Data Abstract Library - Core Library                                       }
{                                                                            }
{ compiler: Delphi 6 and up, Kylix 3 and up                                  }
{ platform: Win32, Linux                                                     }
{                                                                            }
{ (c)opyright RemObjects Software. all rights reserved.                      }
{                                                                            }
{ Using this code requires a valid license of the Data Abstract              }
{ which can be obtained at http://www.remobjects.com.                        }
{----------------------------------------------------------------------------}

{$I DataAbstract.inc}

interface

uses
  SysUtils, Classes, uPSComponent, uPSCompiler, uPSRuntime, uDADataTable,
  uDAInterfaces, db;

type
  TDAPSDataTableRulesPlugin = class;
  TDAPSDataTableRules = class(TDADataTableRules)
  private
    FSE: TPSScript;
    procedure SetSE(const Value: TPSScript);
  protected
    procedure BeforeOpen(Sender: TDADataTable); override;
    procedure AfterOpen(Sender: TDADataTable); override;
    procedure BeforeClose(Sender: TDADataTable); override;
    procedure AfterClose(Sender: TDADataTable); override;
    procedure BeforeInsert(Sender: TDADataTable); override;
    procedure AfterInsert(Sender: TDADataTable); override;
    procedure BeforeEdit(Sender: TDADataTable); override;
    procedure AfterEdit(Sender: TDADataTable); override;
    procedure BeforePost(Sender: TDADataTable); override;
    procedure AfterPost(Sender: TDADataTable); override;
    procedure BeforeCancel(Sender: TDADataTable); override;
    procedure AfterCancel(Sender: TDADataTable); override;
    procedure BeforeDelete(Sender: TDADataTable); override;
    procedure AfterDelete(Sender: TDADataTable); override;
    procedure BeforeScroll(Sender: TDADataTable); override;
    procedure AfterScroll(Sender: TDADataTable); override;
    procedure BeforeRefresh(Sender: TDADataTable); override;
    procedure AfterRefresh(Sender: TDADataTable); override;
    procedure OnCalcFields(Sender: TDADataTable); override;
    procedure OnNewRecord(Sender: TDADataTable); override;

    procedure Setup(const Dataset: TDADataTable);
    procedure ExecuteProc(Dataset: TDADataTable; const Name: string);
  public
    property SE: TPSScript read FSE write SetSE;
  end;

  TDAPSDataTableRulesPlugin = class(TPsPlugin)
  private
    fDataTable: TDADataTable;
    fScriptEngine: TPSScript;
    procedure SetDataTable(const Value: TDADataTable);
  public
    procedure CompOnUses(CompExec: TPSScript); override;
    procedure CompileImport1(CompExec: TPSScript); override;
    procedure ExecImport2(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override;
    property DataTable: TDADataTable read fDataTable write SetDataTable;
  end;

implementation

uses
{$IFDEF FPC}
  fpgtkext,
{$ENDIF}
  uDAScriptingProvider, Dialogs, uROClasses;
//uses
//  uDADataTable;

procedure SIRegister_TDADataTable(CL: TIFPSPascalCompiler);
begin
  //with RegClassS(CL,'TComponent', 'TDADataTable') do
  with CL.AddClassN(CL.FindClass('TComponent'), 'TDADataTable') do begin
    RegisterProperty('Active', 'boolean', iptrw);
    RegisterProperty('Fields', 'TDAFieldCollection', iptrw);
    RegisterProperty('Params', 'TDAParamCollection', iptrw);
    RegisterProperty('LogChanges', 'boolean', iptrw);
    RegisterProperty('RemoteFetchEnabled', 'boolean', iptrw);
    RegisterProperty('MasterFields', 'string', iptrw);
    RegisterProperty('DetailFields', 'string', iptrw);
    RegisterProperty('MasterRequestMappings', 'TStrings', iptrw);
    RegisterProperty('DetailOptions', 'TDADetailOptions', iptrw);
    RegisterProperty('MasterOptions', 'TDAMasterOptions', iptrw);
    RegisterProperty('Filtered', 'boolean', iptrw);
    RegisterProperty('Filter', 'string', iptrw);
    RegisterProperty('LogicalName', 'string', iptrw);
    RegisterProperty('BusinessRulesID', 'string', iptrw);
    RegisterProperty('State','TDataSetState',iptR);
  end;
end;

procedure SIRegister_TDAParamCollection(CL: TIFPSPascalCompiler);
begin
  //with RegClassS(CL,'TSearcheableInterfacedCollection', 'TDAParamCollection') do
  with CL.AddClassN(CL.FindClass('TSearcheableInterfacedCollection'), 'TDAParamCollection') do begin
    RegisterMethod('Constructor Create( aOwner : TPersistent)');
    RegisterMethod('Procedure WriteValues( OutputParams : TParams)');
    RegisterMethod('Procedure ReadValues( InputParams : TParams)');
    RegisterMethod('Function Add : TDAParam');
    RegisterMethod('Function ParamByName( const aName : string) : TDAParam');
    RegisterMethod('Function FindParam( const aParamName : string) : TDAParam');
    RegisterMethod('Procedure AssignParamCollection( Source : TDAParamCollection)');
    RegisterProperty('Params', 'TDAParam integer', iptrw);
    SetDefaultPropery('Params');
    RegisterProperty('HasInputParams', 'boolean', iptr);
  end;
end;

procedure SIRegister_TDAParam(CL: TIFPSPascalCompiler);
begin
  //with RegClassS(CL,'TDABaseField', 'TDAParam') do
  with CL.AddClassN(CL.FindClass('TDABaseField'), 'TDAParam') do begin
    RegisterMethod('Procedure SaveToStream( const aStream : IROStream)');
    RegisterMethod('Procedure LoadFromStream( const aStream : IROStream)');
    RegisterMethod('Procedure SaveToFile( const aFileName : string)');
    RegisterMethod('Procedure LoadFromFile( const aFileName : string)');
    RegisterProperty('ParamType', 'TDAParamType', iptrw);
  end;
end;

procedure SIRegister_TDAFieldCollection(CL: TIFPSPascalCompiler);
begin
  //with RegClassS(CL,'TDACustomFieldCollection', 'TDAFieldCollection') do
  with CL.AddClassN(CL.FindClass('TDACustomFieldCollection'), 'TDAFieldCollection') do begin
    RegisterMethod('Constructor Create( aOwner : TPersistent)');
    RegisterMethod('Function FieldByName( const aName : string) : TDAField');
    RegisterMethod('Function FindField( const aName : string) : TDAField');
    RegisterProperty('Fields', 'TDAField integer', iptrw);
    SetDefaultPropery('Fields');
  end;
end;

procedure SIRegister_TDACustomFieldCollection(CL: TIFPSPascalCompiler);
begin
  //with RegClassS(CL,'TSearcheableInterfacedCollection', 'TDACustomFieldCollection') do
  with CL.AddClassN(CL.FindClass('TSearcheableInterfacedCollection'), 'TDACustomFieldCollection') do begin
    RegisterMethod('Procedure Bind( aDataset : TDataset)');
    RegisterMethod('Procedure Unbind');
    RegisterProperty('FieldEventsDisabled', 'boolean', iptrw);
    RegisterMethod('Procedure AssignFieldCollection( Source : TDACustomFieldCollection)');
    RegisterMethod('Function FieldByName( const aName : string) : TDACustomField');
    RegisterMethod('Function FindField( const aName : string) : TDACustomField');
    RegisterMethod('Procedure MoveItem( iFromIndex, iToIndex : integer)');
    RegisterProperty('DataDictionary', 'IDADataDictionary', iptrw);
    RegisterProperty('Fields', 'TDACustomField integer', iptrw);
    SetDefaultPropery('Fields');
  end;
end;

procedure SIRegister_TDADataDictionaryField(CL: TIFPSPascalCompiler);
begin
  //with RegClassS(CL,'TDACustomField', 'TDADataDictionaryField') do
  with CL.AddClassN(CL.FindClass('TDACustomField'), 'TDADataDictionaryField') do begin
  end;
end;

procedure SIRegister_TDAField(CL: TIFPSPascalCompiler);
begin
  //with RegClassS(CL,'TDACustomField', 'TDAField') do
  with CL.AddClassN(CL.FindClass('TDACustomField'), 'TDAField') do begin
  end;
end;

procedure SIRegister_TDACustomField(CL: TIFPSPascalCompiler);
begin
  //with RegClassS(CL,'TDABaseField', 'TDACustomField') do
  with CL.AddClassN(CL.FindClass('TDABaseField'), 'TDACustomField') do begin
    RegisterMethod('Procedure Bind( aField : TField)');
    RegisterMethod('Procedure Unbind');
    RegisterMethod('Procedure SaveToStream( const aStream : IROStream)');
    RegisterMethod('Procedure LoadFromStream( const aStream : IROStream)');
    RegisterMethod('Procedure SaveToFile( const aFileName : string)');
    RegisterMethod('Procedure LoadFromFile( const aFileName : string)');
    RegisterProperty('FieldCollection', 'TDACustomFieldCollection', iptr);
    RegisterProperty('TableField', 'string', iptrw);
    RegisterProperty('IsNull', 'boolean', iptr);
    RegisterProperty('InPrimaryKey', 'boolean', iptrw);
    RegisterProperty('Calculated', 'boolean', iptrw);
    RegisterProperty('Lookup', 'boolean', iptrw);
    RegisterProperty('LookupSource', 'TDataSource', iptrw);
    RegisterProperty('LookupKeyFields', 'string', iptrw);
    RegisterProperty('LookupResultField', 'string', iptrw);
    RegisterProperty('KeyFields', 'string', iptrw);
    RegisterProperty('LookupCache', 'boolean', iptrw);
    RegisterProperty('LogChanges', 'boolean', iptrw);
    RegisterProperty('RegExpression', 'string', iptrw);
    RegisterProperty('DefaultValue', 'string', iptrw);
    RegisterProperty('Required', 'boolean', iptrw);
    RegisterProperty('DisplayWidth', 'integer', iptrw);
    RegisterProperty('DisplayLabel', 'string', iptrw);
    RegisterProperty('EditMask', 'string', iptrw);
    RegisterProperty('Visible', 'boolean', iptrw);
    RegisterProperty('ReadOnly', 'boolean', iptrw);
    RegisterProperty('CustomAttributes', 'TStrings', iptrw);
    RegisterProperty('DisplayFormat', 'string', iptrw);
    RegisterProperty('BusinessRulesID', 'string', iptrw);
    RegisterProperty('EditFormat', 'string', iptrw);
    RegisterProperty('Alignment', 'TAlignment', iptrw);
  end;
end;

procedure SIRegister_TDABaseField(CL: TIFPSPascalCompiler);
begin
  //with RegClassS(CL,'TCollectionItem', 'TDABaseField') do
  with CL.AddClassN(CL.FindClass('TCollectionItem'), 'TDABaseField') do begin
    RegisterProperty('Value', 'Variant', iptrw);
    RegisterMethod('Procedure AssignField( Source : TDABaseField)');
    RegisterMethod('Function HasValidDictionaryField : Boolean');
    RegisterProperty('AsBoolean', 'boolean', iptrw);
    RegisterProperty('AsCurrency', 'currency', iptrw);
    RegisterProperty('AsDateTime', 'TDateTime', iptrw);
    RegisterProperty('AsFloat', 'double', iptrw);
    RegisterProperty('AsInteger', 'integer', iptrw);
    RegisterProperty('AsString', 'string', iptrw);
    RegisterProperty('AsVariant', 'variant', iptrw);
    RegisterProperty('DictionaryEntry', 'string', iptrw);
    RegisterProperty('Name', 'string', iptrw);
    RegisterProperty('DataType', 'TDADataType', iptrw);
    RegisterProperty('Size', 'integer', iptrw);
    RegisterProperty('Description', 'string', iptrw);
    RegisterProperty('BlobType', 'TDABlobType', iptrw);
  end;
end;

procedure SIRegister_uDA(CL: TIFPSPascalCompiler);
begin
  CL.AddTypeS('TDAPersistFormat', '( pfBinary, pfXML )');
  CL.AddTypeS('TDAParamType', '( daptUnknown, daptInput, daptOutput, daptInputO'
    + 'utput, daptResult )');
  CL.AddTypeS('TDADataType', '( datUnknown, datString, datDateTime, datFloat, d'
    + 'atCurrency, datAutoInc, datInteger, datLargeInt, datBoolean, datMemo, datB'
    + 'lob, datWideString, datWideMemo, datLargeAutoInc, datByte, datShortInt, '
    +  'datWord, datSmallInt, datCardinal, datLargeUInt, datGuid, datXml, datDecimal, datSingleFloat )');
  CL.AddTypeS('TDABlobType', '( dabtUnknown, dabtBlob, dabtMemo, dabtOraBlob, d'
    + 'abtOraClob, dabtGraphic,dabtTypedBinary)');
  SIRegister_TDABaseField(CL);
  CL.AddClassN(CL.FindClass('TOBJECT'), 'TDACustomFieldCollection');
  SIRegister_TDACustomField(CL);
  SIRegister_TDAField(CL);
  SIRegister_TDADataDictionaryField(CL);
  SIRegister_TDACustomFieldCollection(CL);
  SIRegister_TDAFieldCollection(CL);
  SIRegister_TDAParam(CL);
  SIRegister_TDAParamCollection(CL);
  SIRegister_TDADataTable(CL);
end;

(* === run-time registration functions === *)

procedure TDADataTableBusinessRulesID_W(Self: TDADataTable; const T: string);
begin
  Self.BusinessRulesID := T;
end;

procedure TDADataTableBusinessRulesID_R(Self: TDADataTable; var T: string);
begin
  T := Self.BusinessRulesID;
end;

procedure TDADataTableLogicalName_W(Self: TDADataTable; const T: string);
begin
  Self.LogicalName := T;
end;

procedure TDADataTableLogicalName_R(Self: TDADataTable; var T: string);
begin
  T := Self.LogicalName;
end;

procedure TDADataTableFilter_W(Self: TDADataTable; const T: string);
begin
  Self.Filter := T;
end;

procedure TDADataTableFilter_R(Self: TDADataTable; var T: string);
begin
  T := Self.Filter;
end;

procedure TDADataTableFiltered_W(Self: TDADataTable; const T: boolean);
begin
  Self.Filtered := T;
end;

procedure TDADataTableFiltered_R(Self: TDADataTable; var T: boolean);
begin
  T := Self.Filtered;
end;

procedure TDADataTableMasterOptions_W(Self: TDADataTable; const T: TDAMasterOptions);
begin
  Self.MasterOptions := T;
end;

procedure TDADataTableMasterOptions_R(Self: TDADataTable; var T: TDAMasterOptions);
begin
  T := Self.MasterOptions;
end;

procedure TDADataTableDetailOptions_W(Self: TDADataTable; const T: TDADetailOptions);
begin
  Self.DetailOptions := T;
end;

procedure TDADataTableDetailOptions_R(Self: TDADataTable; var T: TDADetailOptions);
begin
  T := Self.DetailOptions;
end;

procedure TDADataTableMasterRequestMappings_W(Self: TDADataTable; const T: TStrings);
begin
  Self.MasterRequestMappings := T;
end;

procedure TDADataTableMasterRequestMappings_R(Self: TDADataTable; var T: TStrings);
begin
  T := Self.MasterRequestMappings;
end;

procedure TDADataTableDetailFields_W(Self: TDADataTable; const T: string);
begin
  Self.DetailFields := T;
end;

procedure TDADataTableDetailFields_R(Self: TDADataTable; var T: string);
begin
  T := Self.DetailFields;
end;

procedure TDADataTableMasterFields_W(Self: TDADataTable; const T: string);
begin
  Self.MasterFields := T;
end;

procedure TDADataTableMasterFields_R(Self: TDADataTable; var T: string);
begin
  T := Self.MasterFields;
end;

procedure TDADataTableRemoteFetchEnabled_W(Self: TDADataTable; const T: boolean);
begin
  Self.RemoteFetchEnabled := T;
end;

procedure TDADataTableRemoteFetchEnabled_R(Self: TDADataTable; var T: boolean);
begin
  T := Self.RemoteFetchEnabled;
end;

procedure TDADataTableLogChanges_W(Self: TDADataTable; const T: boolean);
begin
  Self.LogChanges := T;
end;

procedure TDADataTableLogChanges_R(Self: TDADataTable; var T: boolean);
begin
  T := Self.LogChanges;
end;

procedure TDADataTableParams_W(Self: TDADataTable; const T: TDAParamCollection);
begin
  Self.Params := T;
end;

procedure TDADataTableParams_R(Self: TDADataTable; var T: TDAParamCollection);
begin
  T := Self.Params;
end;

procedure TDADataTableFields_W(Self: TDADataTable; const T: TDAFieldCollection);
begin
  Self.Fields := T;
end;

procedure TDADataTableFields_R(Self: TDADataTable; var T: TDAFieldCollection);
begin
  T := Self.Fields;
end;

procedure TDADataTableActive_W(Self: TDADataTable; const T: boolean);
begin
  Self.Active := T;
end;

procedure TDADataTableActive_R(Self: TDADataTable; var T: boolean);
begin
  T := Self.Active;
end;

procedure TDAParamCollectionHasInputParams_R(Self: TDAParamCollection; var T: boolean);
begin
  T := Self.HasInputParams;
end;

procedure TDAParamCollectionParams_W(Self: TDAParamCollection; const T: TDAParam; const t1: integer);
begin
  Self.Params[t1] := T;
end;

procedure TDAParamCollectionParams_R(Self: TDAParamCollection; var T: TDAParam; const t1: integer);
begin
  T := Self.Params[t1];
end;

procedure TDAParamParamType_W(Self: TDAParam; const T: TDAParamType);
begin
  Self.ParamType := T;
end;

procedure TDAParamParamType_R(Self: TDAParam; var T: TDAParamType);
begin
  T := Self.ParamType;
end;

procedure TDAFieldCollectionFields_W(Self: TDAFieldCollection; const T: TDAField; const t1: integer);
begin
  Self.Fields[t1] := T;
end;

procedure TDAFieldCollectionFields_R(Self: TDAFieldCollection; var T: TDAField; const t1: integer);
begin
  T := Self.Fields[t1];
end;

procedure TDACustomFieldCollectionFields_W(Self: TDACustomFieldCollection; const T: TDACustomField; const t1: integer);
begin
  Self.Fields[t1] := T;
end;

procedure TDACustomFieldCollectionFields_R(Self: TDACustomFieldCollection; var T: TDACustomField; const t1: integer);
begin
  T := Self.Fields[t1];
end;

procedure TDACustomFieldCollectionDataDictionary_W(Self: TDACustomFieldCollection; const T: IDADataDictionary);
begin
  Self.DataDictionary := T;
end;

procedure TDACustomFieldCollectionDataDictionary_R(Self: TDACustomFieldCollection; var T: IDADataDictionary);
begin
  T := Self.DataDictionary;
end;

procedure TDACustomFieldCollectionFieldEventsDisabled_W(Self: TDACustomFieldCollection; const T: boolean);
begin
  Self.FieldEventsDisabled := T;
end;

procedure TDACustomFieldCollectionFieldEventsDisabled_R(Self: TDACustomFieldCollection; var T: boolean);
begin
  T := Self.FieldEventsDisabled;
end;

procedure TDACustomFieldAlignment_W(Self: TDACustomField; const T: TAlignment);
begin
  Self.Alignment := T;
end;

procedure TDACustomFieldAlignment_R(Self: TDACustomField; var T: TAlignment);
begin
  T := Self.Alignment;
end;

procedure TDACustomFieldEditFormat_W(Self: TDACustomField; const T: string);
begin
  Self.EditFormat := T;
end;

procedure TDACustomFieldEditFormat_R(Self: TDACustomField; var T: string);
begin
  T := Self.EditFormat;
end;

procedure TDACustomFieldBusinessRulesID_W(Self: TDACustomField; const T: string);
begin
  Self.BusinessClassID := T;
end;

procedure TDACustomFieldBusinessRulesID_R(Self: TDACustomField; var T: string);
begin
  T := Self.BusinessClassID;
end;

procedure TDACustomFieldDisplayFormat_W(Self: TDACustomField; const T: string);
begin
  Self.DisplayFormat := T;
end;

procedure TDACustomFieldDisplayFormat_R(Self: TDACustomField; var T: string);
begin
  T := Self.DisplayFormat;
end;

procedure TDACustomFieldCustomAttributes_W(Self: TDACustomField; const T: TStrings);
begin
  Self.CustomAttributes := T;
end;

procedure TDACustomFieldCustomAttributes_R(Self: TDACustomField; var T: TStrings);
begin
  T := Self.CustomAttributes;
end;

procedure TDACustomFieldReadOnly_W(Self: TDACustomField; const T: boolean);
begin
  Self.ReadOnly := T;
end;

procedure TDACustomFieldReadOnly_R(Self: TDACustomField; var T: boolean);
begin
  T := Self.ReadOnly;
end;

procedure TDACustomFieldVisible_W(Self: TDACustomField; const T: boolean);
begin
  Self.Visible := T;
end;

procedure TDACustomFieldVisible_R(Self: TDACustomField; var T: boolean);
begin
  T := Self.Visible;
end;

procedure TDACustomFieldEditMask_W(Self: TDACustomField; const T: string);
begin
  Self.EditMask := T;
end;

procedure TDACustomFieldEditMask_R(Self: TDACustomField; var T: string);
begin
  T := Self.EditMask;
end;

procedure TDACustomFieldDisplayLabel_W(Self: TDACustomField; const T: string);
begin
  Self.DisplayLabel := T;
end;

procedure TDACustomFieldDisplayLabel_R(Self: TDACustomField; var T: string);
begin
  T := Self.DisplayLabel;
end;

procedure TDACustomFieldDisplayWidth_W(Self: TDACustomField; const T: integer);
begin
  Self.DisplayWidth := T;
end;

procedure TDACustomFieldDisplayWidth_R(Self: TDACustomField; var T: integer);
begin
  T := Self.DisplayWidth;
end;

procedure TDACustomFieldRequired_W(Self: TDACustomField; const T: boolean);
begin
  Self.Required := T;
end;

procedure TDACustomFieldRequired_R(Self: TDACustomField; var T: boolean);
begin
  T := Self.Required;
end;

procedure TDACustomFieldDefaultValue_W(Self: TDACustomField; const T: string);
begin
  Self.DefaultValue := T;
end;

procedure TDACustomFieldDefaultValue_R(Self: TDACustomField; var T: string);
begin
  T := Self.DefaultValue;
end;

procedure TDACustomFieldRegExpression_W(Self: TDACustomField; const T: string);
begin
  Self.RegExpression := T;
end;

procedure TDACustomFieldRegExpression_R(Self: TDACustomField; var T: string);
begin
  T := Self.RegExpression;
end;

procedure TDACustomFieldLogChanges_W(Self: TDACustomField; const T: boolean);
begin
  Self.LogChanges := T;
end;

procedure TDACustomFieldLogChanges_R(Self: TDACustomField; var T: boolean);
begin
  T := Self.LogChanges;
end;

procedure TDACustomFieldLookupCache_W(Self: TDACustomField; const T: boolean);
begin
  Self.LookupCache := T;
end;

procedure TDACustomFieldLookupCache_R(Self: TDACustomField; var T: boolean);
begin
  T := Self.LookupCache;
end;

procedure TDACustomFieldKeyFields_W(Self: TDACustomField; const T: string);
begin
  Self.KeyFields := T;
end;

procedure TDACustomFieldKeyFields_R(Self: TDACustomField; var T: string);
begin
  T := Self.KeyFields;
end;

procedure TDACustomFieldLookupResultField_W(Self: TDACustomField; const T: string);
begin
  Self.LookupResultField := T;
end;

procedure TDACustomFieldLookupResultField_R(Self: TDACustomField; var T: string);
begin
  T := Self.LookupResultField;
end;

procedure TDACustomFieldLookupKeyFields_W(Self: TDACustomField; const T: string);
begin
  Self.LookupKeyFields := T;
end;

procedure TDACustomFieldLookupKeyFields_R(Self: TDACustomField; var T: string);
begin
  T := Self.LookupKeyFields;
end;

procedure TDACustomFieldLookupSource_W(Self: TDACustomField; const T: TDataSource);
begin
  Self.LookupSource := T;
end;

procedure TDACustomFieldLookupSource_R(Self: TDACustomField; var T: TDataSource);
begin
  T := Self.LookupSource;
end;

procedure TDACustomFieldLookup_W(Self: TDACustomField; const T: boolean);
begin
  Self.Lookup := T;
end;

procedure TDACustomFieldLookup_R(Self: TDACustomField; var T: boolean);
begin
  T := Self.Lookup;
end;

procedure TDACustomFieldCalculated_W(Self: TDACustomField; const T: boolean);
begin
  Self.Calculated := T;
end;

procedure TDACustomFieldCalculated_R(Self: TDACustomField; var T: boolean);
begin
  T := Self.Calculated;
end;

procedure TDACustomFieldInPrimaryKey_W(Self: TDACustomField; const T: boolean);
begin
  Self.InPrimaryKey := T;
end;

procedure TDACustomFieldInPrimaryKey_R(Self: TDACustomField; var T: boolean);
begin
  T := Self.InPrimaryKey;
end;

procedure TDACustomFieldIsNull_R(Self: TDACustomField; var T: boolean);
begin
  T := Self.IsNull;
end;

procedure TDACustomFieldTableField_W(Self: TDACustomField; const T: string);
begin
  Self.TableField := T;
end;

procedure TDACustomFieldTableField_R(Self: TDACustomField; var T: string);
begin
  T := Self.TableField;
end;

procedure TDACustomFieldFieldCollection_R(Self: TDACustomField; var T: TDACustomFieldCollection);
begin
  T := Self.FieldCollection;
end;

procedure TDABaseFieldBlobType_W(Self: TDABaseField; const T: TDABlobType);
begin
  Self.BlobType := T;
end;

procedure TDABaseFieldBlobType_R(Self: TDABaseField; var T: TDABlobType);
begin
  T := Self.BlobType;
end;

procedure TDABaseFieldDescription_W(Self: TDABaseField; const T: string);
begin
  Self.Description := T;
end;

procedure TDABaseFieldDescription_R(Self: TDABaseField; var T: string);
begin
  T := Self.Description;
end;

procedure TDABaseFieldSize_W(Self: TDABaseField; const T: integer);
begin
  Self.Size := T;
end;

procedure TDABaseFieldSize_R(Self: TDABaseField; var T: integer);
begin
  T := Self.Size;
end;

procedure TDABaseFieldDataType_W(Self: TDABaseField; const T: TDADataType);
begin
  Self.DataType := T;
end;

procedure TDABaseFieldDataType_R(Self: TDABaseField; var T: TDADataType);
begin
  T := Self.DataType;
end;

procedure TDABaseFieldName_W(Self: TDABaseField; const T: string);
begin
  Self.Name := T;
end;

procedure TDABaseFieldName_R(Self: TDABaseField; var T: string);
begin
  T := Self.Name;
end;

procedure TDABaseFieldDictionaryEntry_W(Self: TDABaseField; const T: string);
begin
  Self.DictionaryEntry := T;
end;

procedure TDABaseFieldDictionaryEntry_R(Self: TDABaseField; var T: string);
begin
  T := Self.DictionaryEntry;
end;

procedure TDABaseFieldAsVariant_W(Self: TDABaseField; const T: variant);
begin
  Self.AsVariant := T;
end;

procedure TDABaseFieldAsVariant_R(Self: TDABaseField; var T: variant);
begin
  T := Self.AsVariant;
end;

procedure TDABaseFieldAsString_W(Self: TDABaseField; const T: string);
begin
  Self.AsString := T;
end;

procedure TDABaseFieldAsString_R(Self: TDABaseField; var T: string);
begin
  T := Self.AsString;
end;

procedure TDABaseFieldAsInteger_W(Self: TDABaseField; const T: integer);
begin
  Self.AsInteger := T;
end;

procedure TDABaseFieldAsInteger_R(Self: TDABaseField; var T: integer);
begin
  T := Self.AsInteger;
end;

procedure TDABaseFieldAsFloat_W(Self: TDABaseField; const T: double);
begin
  Self.AsFloat := T;
end;

procedure TDABaseFieldAsFloat_R(Self: TDABaseField; var T: double);
begin
  T := Self.AsFloat;
end;

procedure TDABaseFieldAsDateTime_W(Self: TDABaseField; const T: TDateTime);
begin
  Self.AsDateTime := T;
end;

procedure TDABaseFieldAsDateTime_R(Self: TDABaseField; var T: TDateTime);
begin
  T := Self.AsDateTime;
end;

procedure TDABaseFieldAsCurrency_W(Self: TDABaseField; const T: currency);
begin
  Self.AsCurrency := T;
end;

procedure TDABaseFieldAsCurrency_R(Self: TDABaseField; var T: currency);
begin
  T := Self.AsCurrency;
end;

procedure TDABaseFieldAsBoolean_W(Self: TDABaseField; const T: boolean);
begin
  Self.AsBoolean := T;
end;

procedure TDABaseFieldAsBoolean_R(Self: TDABaseField; var T: boolean);
begin
  T := Self.AsBoolean;
end;

procedure TDABaseFieldValue_W(Self: TDABaseField; const T: Variant);
begin
  Self.Value := T;
end;

procedure TDABaseFieldValue_R(Self: TDABaseField; var T: Variant);
begin
  T := Self.Value;
end;

procedure TDADataTableState_R(Self: TDADataTable; var T: TDataSetState);
begin
  T := Self.State;
end;

procedure RIRegister_TDADataTable(CL: TIFPSRuntimeClassImporter);
begin
  with CL.Add(TDADataTable) do begin
    RegisterPropertyHelper(@TDADataTableActive_R, @TDADataTableActive_W, 'Active');
    RegisterPropertyHelper(@TDADataTableFields_R, @TDADataTableFields_W, 'Fields');
    RegisterPropertyHelper(@TDADataTableParams_R, @TDADataTableParams_W, 'Params');
    RegisterPropertyHelper(@TDADataTableLogChanges_R, @TDADataTableLogChanges_W, 'LogChanges');
    RegisterPropertyHelper(@TDADataTableRemoteFetchEnabled_R, @TDADataTableRemoteFetchEnabled_W, 'RemoteFetchEnabled');
    RegisterPropertyHelper(@TDADataTableMasterFields_R, @TDADataTableMasterFields_W, 'MasterFields');
    RegisterPropertyHelper(@TDADataTableDetailFields_R, @TDADataTableDetailFields_W, 'DetailFields');
    RegisterPropertyHelper(@TDADataTableMasterRequestMappings_R, @TDADataTableMasterRequestMappings_W, 'MasterRequestMappings');
    RegisterPropertyHelper(@TDADataTableDetailOptions_R, @TDADataTableDetailOptions_W, 'DetailOptions');
    RegisterPropertyHelper(@TDADataTableMasterOptions_R, @TDADataTableMasterOptions_W, 'MasterOptions');
    RegisterPropertyHelper(@TDADataTableFiltered_R, @TDADataTableFiltered_W, 'Filtered');
    RegisterPropertyHelper(@TDADataTableFilter_R, @TDADataTableFilter_W, 'Filter');
    RegisterPropertyHelper(@TDADataTableLogicalName_R, @TDADataTableLogicalName_W, 'LogicalName');
    RegisterPropertyHelper(@TDADataTableBusinessRulesID_R, @TDADataTableBusinessRulesID_W, 'BusinessRulesID');
    RegisterPropertyHelper(@TDADataTableState_R, nil, 'State');
  end;
end;

procedure RIRegister_TDAParamCollection(CL: TIFPSRuntimeClassImporter);
begin
  with CL.Add(TDAParamCollection) do begin
    RegisterConstructor(@TDAParamCollection.Create, 'Create');
    RegisterMethod(@TDAParamCollection.WriteValues, 'WriteValues');
    RegisterMethod(@TDAParamCollection.ReadValues, 'ReadValues');
    RegisterMethod(@TDAParamCollection.Add, 'Add');
    RegisterMethod(@TDAParamCollection.ParamByName, 'ParamByName');
    RegisterMethod(@TDAParamCollection.FindParam, 'FindParam');
    RegisterMethod(@TDAParamCollection.AssignParamCollection, 'AssignParamCollection');
    RegisterPropertyHelper(@TDAParamCollectionParams_R, @TDAParamCollectionParams_W, 'Params');
    RegisterPropertyHelper(@TDAParamCollectionHasInputParams_R, nil, 'HasInputParams');
  end;
end;

procedure RIRegister_TDAParam(CL: TIFPSRuntimeClassImporter);
begin
  with CL.Add(TDAParam) do begin
    RegisterMethod(@TDAParam.SaveToStream, 'SaveToStream');
    RegisterMethod(@TDAParam.LoadFromStream, 'LoadFromStream');
    RegisterMethod(@TDAParam.SaveToFile, 'SaveToFile');
    RegisterMethod(@TDAParam.LoadFromFile, 'LoadFromFile');
    RegisterPropertyHelper(@TDAParamParamType_R, @TDAParamParamType_W, 'ParamType');
  end;
end;

procedure RIRegister_TDAFieldCollection(CL: TIFPSRuntimeClassImporter);
begin
  with CL.Add(TDAFieldCollection) do begin
    RegisterConstructor(@TDAFieldCollection.Create, 'Create');
    RegisterMethod(@TDAFieldCollection.FieldByName, 'FieldByName');
    RegisterMethod(@TDAFieldCollection.FindField, 'FindField');
    RegisterPropertyHelper(@TDAFieldCollectionFields_R, @TDAFieldCollectionFields_W, 'Fields');
  end;
end;

procedure RIRegister_TDACustomFieldCollection(CL: TIFPSRuntimeClassImporter);
begin
  with CL.Add(TDACustomFieldCollection) do begin
    RegisterMethod(@TDACustomFieldCollection.Bind, 'Bind');
    RegisterMethod(@TDACustomFieldCollection.Unbind, 'Unbind');
    RegisterPropertyHelper(@TDACustomFieldCollectionFieldEventsDisabled_R, @TDACustomFieldCollectionFieldEventsDisabled_W, 'FieldEventsDisabled');
    RegisterMethod(@TDACustomFieldCollection.AssignFieldCollection, 'AssignFieldCollection');
    RegisterMethod(@TDACustomFieldCollection.FieldByName, 'FieldByName');
    RegisterMethod(@TDACustomFieldCollection.FindField, 'FindField');
    RegisterMethod(@TDACustomFieldCollection.MoveItem, 'MoveItem');
    RegisterPropertyHelper(@TDACustomFieldCollectionDataDictionary_R, @TDACustomFieldCollectionDataDictionary_W, 'DataDictionary');
    RegisterPropertyHelper(@TDACustomFieldCollectionFields_R, @TDACustomFieldCollectionFields_W, 'Fields');
  end;
end;

procedure RIRegister_TDADataDictionaryField(CL: TIFPSRuntimeClassImporter);
begin
  with CL.Add(TDADataDictionaryField) do begin
  end;
end;

procedure RIRegister_TDAField(CL: TIFPSRuntimeClassImporter);
begin
  with CL.Add(TDAField) do begin
  end;
end;

procedure RIRegister_TDACustomField(CL: TIFPSRuntimeClassImporter);
begin
  with CL.Add(TDACustomField) do begin
    RegisterMethod(@TDACustomField.Bind, 'Bind');
    RegisterMethod(@TDACustomField.Unbind, 'Unbind');
    RegisterMethod(@TDACustomField.SaveToStream, 'SaveToStream');
    RegisterMethod(@TDACustomField.LoadFromStream, 'LoadFromStream');
    RegisterMethod(@TDACustomField.SaveToFile, 'SaveToFile');
    RegisterMethod(@TDACustomField.LoadFromFile, 'LoadFromFile');
    RegisterPropertyHelper(@TDACustomFieldFieldCollection_R, nil, 'FieldCollection');
    RegisterPropertyHelper(@TDACustomFieldTableField_R, @TDACustomFieldTableField_W, 'TableField');
    RegisterPropertyHelper(@TDACustomFieldIsNull_R, nil, 'IsNull');
    RegisterPropertyHelper(@TDACustomFieldInPrimaryKey_R, @TDACustomFieldInPrimaryKey_W, 'InPrimaryKey');
    RegisterPropertyHelper(@TDACustomFieldCalculated_R, @TDACustomFieldCalculated_W, 'Calculated');
    RegisterPropertyHelper(@TDACustomFieldLookup_R, @TDACustomFieldLookup_W, 'Lookup');
    RegisterPropertyHelper(@TDACustomFieldLookupSource_R, @TDACustomFieldLookupSource_W, 'LookupSource');
    RegisterPropertyHelper(@TDACustomFieldLookupKeyFields_R, @TDACustomFieldLookupKeyFields_W, 'LookupKeyFields');
    RegisterPropertyHelper(@TDACustomFieldLookupResultField_R, @TDACustomFieldLookupResultField_W, 'LookupResultField');
    RegisterPropertyHelper(@TDACustomFieldKeyFields_R, @TDACustomFieldKeyFields_W, 'KeyFields');
    RegisterPropertyHelper(@TDACustomFieldLookupCache_R, @TDACustomFieldLookupCache_W, 'LookupCache');
    RegisterPropertyHelper(@TDACustomFieldLogChanges_R, @TDACustomFieldLogChanges_W, 'LogChanges');
    RegisterPropertyHelper(@TDACustomFieldRegExpression_R, @TDACustomFieldRegExpression_W, 'RegExpression');
    RegisterPropertyHelper(@TDACustomFieldDefaultValue_R, @TDACustomFieldDefaultValue_W, 'DefaultValue');
    RegisterPropertyHelper(@TDACustomFieldRequired_R, @TDACustomFieldRequired_W, 'Required');
    RegisterPropertyHelper(@TDACustomFieldDisplayWidth_R, @TDACustomFieldDisplayWidth_W, 'DisplayWidth');
    RegisterPropertyHelper(@TDACustomFieldDisplayLabel_R, @TDACustomFieldDisplayLabel_W, 'DisplayLabel');
    RegisterPropertyHelper(@TDACustomFieldEditMask_R, @TDACustomFieldEditMask_W, 'EditMask');
    RegisterPropertyHelper(@TDACustomFieldVisible_R, @TDACustomFieldVisible_W, 'Visible');
    RegisterPropertyHelper(@TDACustomFieldReadOnly_R, @TDACustomFieldReadOnly_W, 'ReadOnly');
    RegisterPropertyHelper(@TDACustomFieldCustomAttributes_R, @TDACustomFieldCustomAttributes_W, 'CustomAttributes');
    RegisterPropertyHelper(@TDACustomFieldDisplayFormat_R, @TDACustomFieldDisplayFormat_W, 'DisplayFormat');
    RegisterPropertyHelper(@TDACustomFieldBusinessRulesID_R, @TDACustomFieldBusinessRulesID_W, 'BusinessRulesID');
    RegisterPropertyHelper(@TDACustomFieldEditFormat_R, @TDACustomFieldEditFormat_W, 'EditFormat');
    RegisterPropertyHelper(@TDACustomFieldAlignment_R, @TDACustomFieldAlignment_W, 'Alignment');
  end;
end;

procedure RIRegister_TDABaseField(CL: TIFPSRuntimeClassImporter);
begin
  with CL.Add(TDABaseField) do begin
    RegisterPropertyHelper(@TDABaseFieldValue_R, @TDABaseFieldValue_W, 'Value');
    RegisterVirtualMethod(@TDABaseField.AssignField, 'AssignField');
    RegisterMethod(@TDABaseField.HasValidDictionaryField, 'HasValidDictionaryField');
    RegisterPropertyHelper(@TDABaseFieldAsBoolean_R, @TDABaseFieldAsBoolean_W, 'AsBoolean');
    RegisterPropertyHelper(@TDABaseFieldAsCurrency_R, @TDABaseFieldAsCurrency_W, 'AsCurrency');
    RegisterPropertyHelper(@TDABaseFieldAsDateTime_R, @TDABaseFieldAsDateTime_W, 'AsDateTime');
    RegisterPropertyHelper(@TDABaseFieldAsFloat_R, @TDABaseFieldAsFloat_W, 'AsFloat');
    RegisterPropertyHelper(@TDABaseFieldAsInteger_R, @TDABaseFieldAsInteger_W, 'AsInteger');
    RegisterPropertyHelper(@TDABaseFieldAsString_R, @TDABaseFieldAsString_W, 'AsString');
    RegisterPropertyHelper(@TDABaseFieldAsVariant_R, @TDABaseFieldAsVariant_W, 'AsVariant');
    RegisterPropertyHelper(@TDABaseFieldDictionaryEntry_R, @TDABaseFieldDictionaryEntry_W, 'DictionaryEntry');
    RegisterPropertyHelper(@TDABaseFieldName_R, @TDABaseFieldName_W, 'Name');
    RegisterPropertyHelper(@TDABaseFieldDataType_R, @TDABaseFieldDataType_W, 'DataType');
    RegisterPropertyHelper(@TDABaseFieldSize_R, @TDABaseFieldSize_W, 'Size');
    RegisterPropertyHelper(@TDABaseFieldDescription_R, @TDABaseFieldDescription_W, 'Description');
    RegisterPropertyHelper(@TDABaseFieldBlobType_R, @TDABaseFieldBlobType_W, 'BlobType');
  end;
end;

procedure RIRegister_uDA(CL: TIFPSRuntimeClassImporter);
begin
  RIRegister_TDABaseField(CL);
  RIRegister_TDACustomField(CL);
  RIRegister_TDAField(CL);
  RIRegister_TDADataDictionaryField(CL);
  RIRegister_TDACustomFieldCollection(CL);
  RIRegister_TDAFieldCollection(CL);
  RIRegister_TDAParam(CL);
  RIRegister_TDAParamCollection(CL);
  RIRegister_TDADataTable(CL);
end;

{ TDAPSDataTableRulesPlugin }

function PSNewGuid: string;
begin
  result := NewGuidAsString();
end;

procedure PSRaiseError(const aMsg: string);
begin
  raise EDAScriptError.Create(aMsg);
end;

procedure PSAbort;
begin
  Abort;
end;

{$IFDEF FPC}
Procedure ShowMessage(const msg: string);
begin
 fpgtkext.ShowMessage('',msg);
end;
{$ENDIF}

procedure TDAPSDataTableRulesPlugin.CompileImport1(CompExec: TPSScript);
begin
  fScriptEngine := CompExec;
  SIRegister_uDA(CompExec.Comp);
  CompExec.AddRegisteredVariable('Table', 'TDADataTable');
  CompExec.AddFunction(@ShowMessage,'procedure ShowMessage(const Msg: string);');
  CompExec.AddFunction(@PSRaiseError,'procedure RaiseError(const aMsg: string);');
  CompExec.AddFunction(@PSAbort,'procedure Abort;');
  CompExec.AddFunction(@PSNewGuid,'function NewGuid: string;');
end;

procedure TDAPSDataTableRulesPlugin.CompOnUses(CompExec: TPSScript);
begin
  fScriptEngine := CompExec;
end;

procedure TDAPSDataTableRulesPlugin.ExecImport2(CompExec: TPSScript;
  const ri: TPSRuntimeClassImporter);
begin
  fScriptEngine := CompExec;
  RIRegister_uDA(ri);
  CompExec.SetVarToInstance('Table', fDataTable);
end;

procedure TDAPSDataTableRulesPlugin.SetDataTable(
  const Value: TDADataTable);
begin
  fDataTable := Value;
  if (fScriptEngine <> nil) then
    fScriptEngine.SetVarToInstance('Table', fDataTable);
end;

{ TDAPSDataTableRules }

procedure TDAPSDataTableRules.AfterCancel(Sender: TDADataTable);
begin
  ExecuteProc(Sender, 'AfterCancel');
end;

procedure TDAPSDataTableRules.AfterClose(Sender: TDADataTable);
begin
  ExecuteProc(Sender, 'AfterClose');
end;

procedure TDAPSDataTableRules.AfterDelete(Sender: TDADataTable);
begin
  ExecuteProc(Sender, 'AfterDelete');
end;

procedure TDAPSDataTableRules.AfterEdit(Sender: TDADataTable);
begin
  ExecuteProc(Sender, 'AfterEdit');
end;

procedure TDAPSDataTableRules.AfterInsert(Sender: TDADataTable);
begin
  ExecuteProc(Sender, 'AfterInsert');
end;

procedure TDAPSDataTableRules.AfterOpen(Sender: TDADataTable);
begin
  ExecuteProc(Sender, 'AfterOpen');
end;

procedure TDAPSDataTableRules.AfterPost(Sender: TDADataTable);
begin
  ExecuteProc(Sender, 'AfterPost');
end;

procedure TDAPSDataTableRules.AfterRefresh(Sender: TDADataTable);
begin
  ExecuteProc(Sender, 'AfterRefresh');
end;

procedure TDAPSDataTableRules.AfterScroll(Sender: TDADataTable);
begin
  ExecuteProc(Sender, 'AfterScroll');
end;

procedure TDAPSDataTableRules.BeforeCancel(Sender: TDADataTable);
begin
  ExecuteProc(Sender, 'BeforeCancel');
end;

procedure TDAPSDataTableRules.BeforeClose(Sender: TDADataTable);
begin
  ExecuteProc(Sender, 'BeforeClose');
end;

procedure TDAPSDataTableRules.BeforeDelete(Sender: TDADataTable);
begin
  ExecuteProc(Sender, 'BeforeDelete');
end;

procedure TDAPSDataTableRules.BeforeEdit(Sender: TDADataTable);
begin
  ExecuteProc(Sender, 'BeforeEdit');
end;

procedure TDAPSDataTableRules.BeforeInsert(Sender: TDADataTable);
begin
  ExecuteProc(Sender, 'BeforeInsert');
end;

procedure TDAPSDataTableRules.BeforeOpen(Sender: TDADataTable);
begin
  ExecuteProc(Sender, 'BeforeOpen');
end;

procedure TDAPSDataTableRules.BeforePost(Sender: TDADataTable);
begin
  ExecuteProc(Sender, 'BeforePost');
end;

procedure TDAPSDataTableRules.BeforeRefresh(Sender: TDADataTable);
begin
  ExecuteProc(Sender, 'BeforeRefresh');
end;

procedure TDAPSDataTableRules.BeforeScroll(Sender: TDADataTable);
begin
  ExecuteProc(Sender, 'BeforeScroll');
end;

procedure TDAPSDataTableRules.ExecuteProc(Dataset: TDADataTable;
  const Name: string);
var
  ProcNo: Cardinal;
begin
  if FSE = nil then raise Exception.Create('No script engine attached');
  Setup(Dataset);
  ProcNo := FSE.Exec.GetProc(Name);
  if ProcNo <> InvalidVal then {// Nothing to do} begin
    FSE.Exec.RunProc(nil, ProcNo);
    FSE.Exec.RaiseCurrentException;
  end;
end;

procedure TDAPSDataTableRules.OnCalcFields(Sender: TDADataTable);
begin
  ExecuteProc(Sender, 'OnCalcFields');
end;

procedure TDAPSDataTableRules.OnNewRecord(Sender: TDADataTable);
begin
  ExecuteProc(Sender, 'OnNewRecord');
end;

procedure TDAPSDataTableRules.SetSE(const Value: TPSScript);
var
  lPlugin: TPSPlugin;
  i: Integer;
begin
  if Value = nil then begin
    FSE := nil
  end
  else begin
    // ToDo: use GetPlugin() lateron.
    lPlugin := nil;
    for i := 0 to Value.Plugins.Count-1 do begin
      if Assigned(Value.Plugins.Items[i]) and ((Value.Plugins.Items[i] as TPSPluginItem).Plugin is TDAPSDataTableRulesPlugin) then
        lPlugin := (Value.Plugins.Items[i] as TPSPluginItem).Plugin;
    end; { for }
    if lPlugin = nil then begin
      FSE := nil;
      raise Exception.Create('No TDAPSDataTableRulesPlugin plugin attached to the script engine.');
    end;
    FSE := Value;
  end;
end;

procedure TDAPSDataTableRules.Setup(const Dataset: TDADataTable);
begin
  FSE.SetVarToInstance('Table', Dataset);
end;

end.