fs_isysrtti.pas

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

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

unit fs_isysrtti;

interface

{$i fs.inc}

implementation

uses SysUtils, Classes, fs_iinterpreter, fs_itools
{$IFDEF CLX}
, QDialogs, MaskUtils
{$ELSE}
  {$IFNDEF NOFORMS}
, Dialogs
  {$ENDIF}
{$IFDEF Delphi6}
, MaskUtils, Variants
{$ELSE}
, Mask
{$ENDIF}
{$ENDIF}
{$IFDEF OLE}
, ComObj
{$ENDIF};

type
  TFunctions = class(TObject)
  private
    FCatConv: String;
    FCatDate: String;
    FCatFormat: String;
    FCatMath: String;
    FCatOther: String;
    FCatStr: String;
    function CallMethod1(Instance: TObject; ClassType: TClass;
      const MethodName: String; var Params: Variant): Variant;
    function CallMethod2(Instance: TObject; ClassType: TClass;
      const MethodName: String; var Params: Variant): Variant;
    function CallMethod3(Instance: TObject; ClassType: TClass;
      const MethodName: String; var Params: Variant): Variant;
    function CallMethod4(Instance: TObject; ClassType: TClass;
      const MethodName: String; var Params: Variant): Variant;
    function CallMethod5(Instance: TObject; ClassType: TClass;
      const MethodName: String; var Params: Variant): Variant;
    function CallMethod6(Instance: TObject; ClassType: TClass;
      const MethodName: String; var Params: Variant): Variant;
    function CallMethod7(Instance: TObject; ClassType: TClass;
      const MethodName: String; var Params: Variant): Variant;
  public
    constructor Create;
    destructor Destroy; override;
  end;

var
  Functions: TFunctions;


function FormatV(const Fmt: String; Args: Variant): String;
var
  ar: TVarRecArray;
begin
  VariantToVarRec(Args, ar);
  Result := Format(Fmt, ar);
  ClearVarRec(ar);
end;

function VArrayCreate(Args: Variant; Typ: Integer): Variant;
var
  i, n: Integer;
  ar: array of Integer;
begin
  n := VarArrayHighBound(Args, 1) + 1;
  SetLength(ar, n);
  for i := 0 to n - 1 do
    ar[i] := Args[i];

  Result := VarArrayCreate(ar, Typ);
  ar := nil;
end;

function NameCase(const s: String): String;
var
  i: Integer;
begin
  Result := AnsiLowercase(s);
  for i := 1 to Length(s) do
    if i = 1 then
      Result[i] := AnsiUpperCase(s[i])[1]
    else if i < Length(s) then
      if s[i] = ' ' then
        Result[i + 1] := AnsiUpperCase(s[i + 1])[1];
end;

function ValidInt(cInt: String): Boolean;
begin
  Result := True;
  try
    StrToInt(cInt);
  except
    Result := False;
  end;
end;

function ValidFloat(cFlt: String): Boolean;
begin
  Result := True;
  try
    StrToFloat(cFlt);
  except
    Result := False;
  end;
end;

function ValidDate(cDate: String) :Boolean;
begin
  Result := True;
  try
    StrToDate(cDate);
  except
    Result := False;
  end;
end;

function DaysInMonth(nYear, nMonth: Integer): Integer;
const
  Days: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
begin
  Result := Days[nMonth];
  if (nMonth = 2) and IsLeapYear(nYear) then Inc(Result);
end;


{ TFunctions }

constructor TFunctions.Create;
begin
  FCatStr := 'ctString';
  FCatDate := 'ctDate';
  FCatConv := 'ctConv';
  FCatFormat := 'ctFormat';
  FCatMath := 'ctMath';
  FCatOther := 'ctOther';

  with fsGlobalUnit do
  begin
    AddedBy := Self;
    AddMethod('function IntToStr(i: Integer): String', CallMethod1, FCatConv);
    AddMethod('function FloatToStr(e: Extended): String', CallMethod1, FCatConv);
    AddMethod('function DateToStr(e: Extended): String', CallMethod1, FCatConv);
    AddMethod('function TimeToStr(e: Extended): String', CallMethod1, FCatConv);
    AddMethod('function DateTimeToStr(e: Extended): String', CallMethod1, FCatConv);
    AddMethod('function VarToStr(v: Variant): String', CallMethod7, FCatConv);

    AddMethod('function StrToInt(s: String): Integer', CallMethod2, FCatConv);
    AddMethod('function StrToFloat(s: String): Extended', CallMethod2, FCatConv);
    AddMethod('function StrToDate(s: String): Extended', CallMethod2, FCatConv);
    AddMethod('function StrToTime(s: String): Extended', CallMethod2, FCatConv);
    AddMethod('function StrToDateTime(s: String): Extended', CallMethod2, FCatConv);

    AddMethod('function Format(Fmt: String; Args: array): String', CallMethod3, FCatFormat);
    AddMethod('function FormatFloat(Fmt: String; Value: Extended): String', CallMethod3, FCatFormat);
    AddMethod('function FormatDateTime(Fmt: String; DateTime: TDateTime): String', CallMethod3, FCatFormat);
    AddMethod('function FormatMaskText(EditMask: string; Value: string): string', CallMethod3, FCatFormat);

    AddMethod('function EncodeDate(Year, Month, Day: Word): TDateTime', CallMethod4, FCatDate);
    AddMethod('procedure DecodeDate(Date: TDateTime; var Year, Month, Day: Word)', CallMethod4, FCatDate);
    AddMethod('function EncodeTime(Hour, Min, Sec, MSec: Word): TDateTime', CallMethod4, FCatDate);
    AddMethod('procedure DecodeTime(Time: TDateTime; var Hour, Min, Sec, MSec: Word)', CallMethod4, FCatDate);
    AddMethod('function Date: TDateTime', CallMethod4, FCatDate);
    AddMethod('function Time: TDateTime', CallMethod4, FCatDate);
    AddMethod('function Now: TDateTime', CallMethod4, FCatDate);
    AddMethod('function DayOfWeek(aDate: TDateTime): Integer', CallMethod4, FCatDate);
    AddMethod('function IsLeapYear(Year: Word): Boolean', CallMethod4, FCatDate);
    AddMethod('function DaysInMonth(nYear, nMonth: Integer): Integer', CallMethod4, FCatDate);

    AddMethod('function Length(s: Variant): Integer', CallMethod5, FCatStr);
    AddMethod('function Copy(s: String; from, count: Integer): String', CallMethod5, FCatStr);
    AddMethod('function Pos(substr, s: String): Integer', CallMethod5, FCatStr);
    AddMethod('procedure Delete(var s: String; from, count: Integer)', CallMethod5, FCatStr);
    AddMethod('procedure Insert(s: String; var s2: String; pos: Integer)', CallMethod5, FCatStr);
    AddMethod('function Uppercase(s: String): String', CallMethod5, FCatStr);
    AddMethod('function Lowercase(s: String): String', CallMethod5, FCatStr);
    AddMethod('function Trim(s: String): String', CallMethod5, FCatStr);
    AddMethod('function NameCase(s: String): String', CallMethod5, FCatStr);
    AddMethod('function CompareText(s, s1: String): Integer', CallMethod5, FCatStr);
    AddMethod('function Chr(i: Integer): Char', CallMethod5, FCatStr);
    AddMethod('function Ord(ch: Char): Integer', CallMethod5, FCatStr);
    AddMethod('procedure SetLength(var S: Variant; L: Integer)', CallMethod5, FCatStr);

    AddMethod('function Round(e: Extended): Integer', CallMethod6, FCatMath);
    AddMethod('function Trunc(e: Extended): Integer', CallMethod6, FCatMath);
    AddMethod('function Int(e: Extended): Integer', CallMethod6, FCatMath);
    AddMethod('function Frac(X: Extended): Extended', CallMethod6, FCatMath);
    AddMethod('function Sqrt(e: Extended): Extended', CallMethod6, FCatMath);
    AddMethod('function Abs(e: Extended): Extended', CallMethod6, FCatMath);
    AddMethod('function Sin(e: Extended): Extended', CallMethod6, FCatMath);
    AddMethod('function Cos(e: Extended): Extended', CallMethod6, FCatMath);
    AddMethod('function ArcTan(X: Extended): Extended', CallMethod6, FCatMath);
    AddMethod('function Tan(X: Extended): Extended', CallMethod6, FCatMath);
    AddMethod('function Exp(X: Extended): Extended', CallMethod6, FCatMath);
    AddMethod('function Ln(X: Extended): Extended', CallMethod6, FCatMath);
    AddMethod('function Pi: Extended', CallMethod6, FCatMath);

    AddMethod('procedure Inc(var i: Integer; incr: Integer = 1)', CallMethod7, FCatOther);
    AddMethod('procedure Dec(var i: Integer; decr: Integer = 1)', CallMethod7, FCatOther);
    AddMethod('procedure RaiseException(Param: String)', CallMethod7, FCatOther);
    AddMethod('procedure ShowMessage(Msg: Variant)', CallMethod7, FCatOther);
    AddMethod('procedure Randomize', CallMethod7, FCatOther);
    AddMethod('function Random: Extended', CallMethod7, FCatOther);
    AddMethod('function ValidInt(cInt: String): Boolean', CallMethod7, FCatOther);
    AddMethod('function ValidFloat(cFlt: String): Boolean', CallMethod7, FCatOther);
    AddMethod('function ValidDate(cDate: String): Boolean', CallMethod7, FCatOther);
{$IFDEF OLE}
    AddMethod('function CreateOleObject(ClassName: String): Variant', CallMethod7, FCatOther);
{$ENDIF};
    AddMethod('function VarArrayCreate(Bounds: Array; Typ: Integer): Variant', CallMethod7, FCatOther);
    AddMethod('function VarType(V: Variant): Integer', CallMethod7, FCatOther);

    AddConst('varEmpty', 'Integer', 0);
    AddConst('varNull', 'Integer', 1);
    AddConst('varSmallint', 'Integer', 2);
    AddConst('varInteger', 'Integer', 3);
    AddConst('varSingle', 'Integer', 4);
    AddConst('varDouble', 'Integer', 5);
    AddConst('varCurrency', 'Integer', 6);
    AddConst('varDate', 'Integer', 7);
    AddConst('varOleStr', 'Integer', 8);
    AddConst('varDispatch', 'Integer', 9);
    AddConst('varError', 'Integer', $000A);
    AddConst('varBoolean', 'Integer', $000B);
    AddConst('varVariant', 'Integer', $000C);
    AddConst('varUnknown', 'Integer', $000D);
    AddConst('varShortInt', 'Integer', $0010);
    AddConst('varByte', 'Integer', $0011);
    AddConst('varWord', 'Integer', $0012);
    AddConst('varLongWord', 'Integer', $0013);
    AddConst('varInt64', 'Integer', $0014);
    AddConst('varStrArg', 'Integer', $0048);