fs_idbrtti.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

{******************************************}
{                                          }
{             FastScript v1.8              }
{       DB.pas classes and functions       }
{                                          }
{  (c) 2003-2005 by Alexander Tzyganenko,  }
{             Fast Reports Inc             }
{                                          }
{******************************************}

unit fs_idbrtti;

interface

{$i fs.inc}

uses
  SysUtils, Classes, fs_iinterpreter, fs_itools, fs_iclassesrtti, fs_ievents, DB;

type
  TfsDBRTTI = class(TComponent); // fake component


implementation

type
  TFunctions = class(TObject)
  private
    function CallMethod(Instance: TObject; ClassType: TClass;
      const MethodName: String; var Params: Variant): 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;
    destructor Destroy; override;
  end;

var
  Functions: TFunctions;


{ TFunctions }

constructor TFunctions.Create;
begin
  with fsGlobalUnit do
  begin
    AddedBy := Self;

    AddEnum('TFieldType', 'ftUnknown, ftString, ftSmallint, ftInteger, ftWord,' +
      'ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,' +
      'ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo,' +
      'ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar, ftWideString,' +
      'ftLargeint, ftADT, ftArray, ftReference, ftDataSet, ftOraBlob, ftOraClob,' +
      'ftVariant, ftInterface, ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd');
    AddEnum('TBlobStreamMode', 'bmRead, bmWrite, bmReadWrite');
    AddEnumSet('TLocateOptions', 'loCaseInsensitive, loPartialKey');
    AddEnumSet('TFilterOptions', 'foCaseInsensitive, foNoPartialCompare');
    AddEnum('TParamType', 'ptUnknown, ptInput, ptOutput, ptInputOutput, ptResult');

    with AddClass(TField, 'TComponent') do
    begin
      AddProperty('AsBoolean', 'Boolean', GetProp, SetProp);
      AddProperty('AsCurrency', 'Currency', GetProp, SetProp);
      AddProperty('AsDateTime', 'TDateTime', GetProp, SetProp);
      AddProperty('AsFloat', 'Double', GetProp, SetProp);
      AddProperty('AsInteger', 'Integer', GetProp, SetProp);
      AddProperty('AsString', 'String', GetProp, SetProp);
      AddProperty('AsVariant', 'Variant', GetProp, SetProp);
      AddProperty('DataType', 'TFieldType', GetProp, nil);
      AddProperty('DisplayName', 'String', GetProp, nil);
      AddProperty('DisplayText', 'String', GetProp, nil);
      AddProperty('IsNull', 'Boolean', GetProp, nil);
      AddProperty('Size', 'Integer', GetProp, nil);
      AddProperty('Value', 'Variant', GetProp, SetProp);
    end;
    with AddClass(TFields, 'TObject') do
      AddDefaultProperty('Fields', 'Integer', 'TField', CallMethod, True);
    AddClass(TStringField, 'TField');
    AddClass(TNumericField, 'TField');
    AddClass(TIntegerField, 'TNumericField');
    AddClass(TSmallIntField, 'TIntegerField');
    AddClass(TWordField, 'TIntegerField');
    AddClass(TAutoIncField, 'TIntegerField');
    AddClass(TFloatField, 'TNumericField');
    AddClass(TCurrencyField, 'TFloatField');
    AddClass(TBooleanField, 'TField');
    AddClass(TDateTimeField, 'TField');
    AddClass(TDateField, 'TDateTimeField');
    AddClass(TTimeField, 'TDateTimeField');
    AddClass(TBinaryField, 'TField');
    AddClass(TBytesField, 'TBinaryField');
    AddClass(TVarBytesField, 'TBinaryField');
    AddClass(TBCDField, 'TNumericField');
    with AddClass(TBlobField, 'TField') do
    begin
      AddMethod('procedure LoadFromFile(const FileName: String)', CallMethod);
      AddMethod('procedure LoadFromStream(Stream: TStream)', CallMethod);
      AddMethod('procedure SaveToFile(const FileName: String)', CallMethod);
      AddMethod('procedure SaveToStream(Stream: TStream)', CallMethod);
    end;
    AddClass(TMemoField, 'TBlobField');
    AddClass(TGraphicField, 'TBlobField');
    AddClass(TFieldDef, 'TPersistent');
    with AddClass(TFieldDefs, 'TObject') do
    begin
      AddMethod('function AddFieldDef: TFieldDef', CallMethod);
      AddMethod('function Find(const Name: string): TFieldDef', CallMethod);
      AddMethod('procedure Add(const Name: string; DataType: TFieldType; Size: Word; Required: Boolean)', CallMethod);
      AddMethod('procedure Clear', CallMethod);
      AddMethod('procedure Update', CallMethod);
      AddDefaultProperty('Items', 'Integer', 'TFieldDef', CallMethod, True);
    end;
    AddClass(TDataSource, 'TComponent');
    AddType('TBookmark', fvtVariant);
    with AddClass(TDataSet, 'TComponent') do
    begin
      AddMethod('procedure Open', CallMethod);
      AddMethod('procedure Close', CallMethod);
      AddMethod('procedure First', CallMethod);
      AddMethod('procedure Last', CallMethod);
      AddMethod('procedure Next', CallMethod);
      AddMethod('procedure Prior', CallMethod);
      AddMethod('procedure Cancel', CallMethod);
      AddMethod('procedure Delete', CallMethod);
      AddMethod('procedure Post', CallMethod);
      AddMethod('procedure Append', CallMethod);
      AddMethod('procedure Insert', CallMethod);
      AddMethod('procedure Edit', CallMethod);

      AddMethod('function FieldByName(const FieldName: string): TField', CallMethod);
      AddMethod('procedure GetFieldNames(List: TStrings)', CallMethod);
      AddMethod('function FindFirst: Boolean', CallMethod);
      AddMethod('function FindLast: Boolean', CallMethod);
      AddMethod('function FindNext: Boolean', CallMethod);
      AddMethod('function FindPrior: Boolean', CallMethod);
      AddMethod('procedure FreeBookmark(Bookmark: TBookmark)', CallMethod);
      AddMethod('function GetBookmark: TBookmark', CallMethod);
      AddMethod('procedure GotoBookmark(Bookmark: TBookmark)', CallMethod);
      AddMethod('function Locate(const KeyFields: string; const KeyValues: Variant;' +
        'Options: TLocateOptions): Boolean', CallMethod);
      AddMethod('function IsEmpty: Boolean', CallMethod);

      AddProperty('Bof', 'Boolean', GetProp, nil);
      AddProperty('Eof', 'Boolean', GetProp, nil);
      AddProperty('FieldCount', 'Integer', GetProp, nil);
      AddProperty('FieldDefs', 'TFieldDefs', GetProp, nil);
      AddProperty('Fields', 'TFields', GetProp, nil);
      AddProperty('Filter', 'string', GetProp, SetProp);
      AddProperty('Filtered', 'Boolean', GetProp, SetProp);
      AddProperty('FilterOptions', 'TFilterOptions', GetProp, SetProp);
      AddProperty('Active', 'Boolean', GetProp, SetProp);

      AddEvent('BeforeOpen', TfsNotifyEvent);
      AddEvent('AfterOpen', TfsNotifyEvent);
      AddEvent('BeforeClose', TfsNotifyEvent);
      AddEvent('AfterClose', TfsNotifyEvent);
      AddEvent('BeforeInsert', TfsNotifyEvent);
      AddEvent('AfterInsert', TfsNotifyEvent);
      AddEvent('BeforeEdit', TfsNotifyEvent);
      AddEvent('AfterEdit', TfsNotifyEvent);
      AddEvent('BeforePost', TfsNotifyEvent);
      AddEvent('AfterPost', TfsNotifyEvent);
      AddEvent('BeforeCancel', TfsNotifyEvent);
      AddEvent('AfterCancel', TfsNotifyEvent);
      AddEvent('BeforeDelete', TfsNotifyEvent);
      AddEvent('AfterDelete', TfsNotifyEvent);
      AddEvent('BeforeScroll', TfsNotifyEvent);
      AddEvent('AfterScroll', TfsNotifyEvent);
      AddEvent('OnCalcFields', TfsNotifyEvent);
      AddEvent('OnFilterRecord', TfsNotifyEvent);
      AddEvent('OnNewRecord', TfsNotifyEvent);
    end;

    with AddClass(TParam, 'TPersistent') do
    begin
      AddMethod('procedure Clear', CallMethod);
      AddProperty('AsBoolean', 'Boolean', GetProp, SetProp);
      AddProperty('AsCurrency', 'Currency', GetProp, SetProp);
      AddProperty('AsDateTime', 'TDateTime', GetProp, SetProp);
      AddProperty('AsFloat', 'Double', GetProp, SetProp);
      AddProperty('AsInteger', 'Integer', GetProp, SetProp);
      AddProperty('AsDate', 'TDate', GetProp, SetProp);
      AddProperty('AsTime', 'TTime', GetProp, SetProp);
      AddProperty('AsString', 'String', GetProp, SetProp);
      AddProperty('Bound', 'Boolean', GetProp, SetProp);
      AddProperty('IsNull', 'Boolean', GetProp, nil);
      AddProperty('Text', 'String', GetProp, SetProp);
    end;
    with AddClass(TParams, 'TPersistent') do
    begin
      AddMethod('function ParamByName(const Value: string): TParam', CallMethod);
      AddMethod('function FindParam(const Value: string): TParam', CallMethod);
      AddDefaultProperty('Items', 'Integer', 'TParam', CallMethod, True);
    end;

    AddedBy := nil;
  end;
end;

destructor TFunctions.Destroy;
begin
  if fsGlobalUnit <> nil then
    fsGlobalUnit.RemoveItems(Self);
  inherited;
end;

function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
  const MethodName: String; var Params: Variant): Variant;
var
  _TDataSet: TDataSet;

  function IntToLocateOptions(i: Integer): TLocateOptions;
  begin
    Result := [];
    if (i and 1) <> 0 then
      Result := Result + [loCaseInsensitive];
    if (i and 2) <> 0 then
      Result := Result + [loPartialKey];
  end;

begin
  Result := 0;

  if ClassType = TFields then
  begin
    if MethodName = 'FIELDS.GET' then
      Result := Integer(TFields(Instance)[Params[0]])
  end
  else if ClassType = TFieldDefs then
  begin
    if MethodName = 'ITEMS.GET' then
      Result := Integer(TFieldDefs(Instance)[Params[0]])
    else if MethodName = 'ADD' then
      TFieldDefs(Instance).Add(Params[0], TFieldType(Params[1]), Params[2], Params[3])
    else if MethodName = 'ADDFIELDDEF' then
      Result := Integer(TFieldDefs(Instance).AddFieldDef)
    else if MethodName = 'CLEAR' then
      TFieldDefs(Instance).Clear
    else if MethodName = 'FIND' then
      Result := Integer(TFieldDefs(Instance).Find(Params[0]))
    else if MethodName = 'UPDATE' then
      TFieldDefs(Instance).Update
  end
  else if ClassType = TBlobField then
  begin
    if MethodName = 'LOADFROMFILE' then
      TBlobField(Instance).LoadFromFile(Params[0])
    else if MethodName = 'LOADFROMSTREAM' then
      TBlobField(Instance).LoadFromStream(TStream(Integer(Params[0])))
    else if MethodName = 'SAVETOFILE' then
      TBlobField(Instance).SaveToFile(Params[0])