fs_isysrtti.pas

这个是功能强大的报表软件

    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);
    AddConst('varString', 'Integer', $0100);
    AddConst('varAny', 'Integer', $0101);
    AddConst('varTypeMask', 'Integer', $0FFF);
    AddConst('varArray', 'Integer', $2000);
    AddConst('varByRef', 'Integer', $4000);
  end;
end;

function TfsSysFunctions.CallMethod1(Instance: TObject; ClassType: TClass;
  const MethodName: String; Caller: TfsMethodHelper): Variant;
var
{$IFDEF Delphi6}
  i: Int64;
{$ELSE}
  i: Integer;
{$ENDIF}
begin
  if MethodName = 'INTTOSTR' then
  begin
    i := Caller.Params[0];
    Result := IntToStr(i)
  end
  else if MethodName = 'FLOATTOSTR' then
    Result := FloatToStr(Caller.Params[0])
  else if MethodName = 'DATETOSTR' then
    Result := DateToStr(Caller.Params[0])
  else if MethodName = 'TIMETOSTR' then
    Result := TimeToStr(Caller.Params[0])
  else if MethodName = 'DATETIMETOSTR' then
    Result := DateTimeToStr(Caller.Params[0])
end;

function TfsSysFunctions.CallMethod2(Instance: TObject; ClassType: TClass;
  const MethodName: String; Caller: TfsMethodHelper): Variant;
begin
  if MethodName = 'STRTOINT' then
    Result := StrToInt(Caller.Params[0])
{$IFDEF Delphi6}
  else if MethodName = 'STRTOINT64' then
    Result := StrToInt64(Caller.Params[0])
{$ENDIF}
  else if MethodName = 'STRTOFLOAT' then
    Result := StrToFloat(Caller.Params[0])
  else if MethodName = 'STRTODATE' then
    Result := StrToDate(Caller.Params[0])
  else if MethodName = 'STRTOTIME' then
    Result := StrToTime(Caller.Params[0])
  else if MethodName = 'STRTODATETIME' then
    Result := StrToDateTime(Caller.Params[0])
end;

function TfsSysFunctions.CallMethod3(Instance: TObject; ClassType: TClass;
  const MethodName: String; Caller: TfsMethodHelper): Variant;
begin
  if MethodName = 'FORMAT' then
    Result := FormatV(Caller.Params[0], Caller.Params[1])
  else if MethodName = 'FORMATFLOAT' then
    Result := FormatFloat(Caller.Params[0], Caller.Params[1])
  else if MethodName = 'FORMATDATETIME' then
    Result := FormatDateTime(Caller.Params[0], Caller.Params[1])
{$IFNDEF FPC}
// fpc still have no maskedit
  else if MethodName = 'FORMATMASKTEXT' then
    Result := FormatMaskText(Caller.Params[0], Caller.Params[1])
{$ENDIF}
end;

function TfsSysFunctions.CallMethod4(Instance: TObject; ClassType: TClass;
  const MethodName: String; Caller: TfsMethodHelper): Variant;
var
  w1, w2, w3, w4: Word;
begin
  if MethodName = 'ENCODEDATE' then
    Result := EncodeDate(Caller.Params[0], Caller.Params[1], Caller.Params[2])
  else if MethodName = 'ENCODETIME' then
    Result := EncodeTime(Caller.Params[0], Caller.Params[1], Caller.Params[2], Caller.Params[3])
  else if MethodName = 'DECODEDATE' then
  begin
    DecodeDate(Caller.Params[0], w1, w2, w3);
    Caller.Params[1] := w1;
    Caller.Params[2] := w2;
    Caller.Params[3] := w3;
  end
  else if MethodName = 'DECODETIME' then
  begin
    DecodeTime(Caller.Params[0], w1, w2, w3, w4);
    Caller.Params[1] := w1;
    Caller.Params[2] := w2;
    Caller.Params[3] := w3;
    Caller.Params[4] := w4;
  end
  else if MethodName = 'DATE' then
    Result := Date
  else if MethodName = 'TIME' then
    Result := Time
  else if MethodName = 'NOW' then
    Result := Now
  else if MethodName = 'DAYOFWEEK' then
    Result := DayOfWeek(Caller.Params[0])
  else if MethodName = 'ISLEAPYEAR' then
    Result := IsLeapYear(Caller.Params[0])
  else if MethodName = 'DAYSINMONTH' then
    Result := DaysInMonth(Caller.Params[0], Caller.Params[1])
end;

function TfsSysFunctions.CallMethod5(Instance: TObject; ClassType: TClass;
  const MethodName: String; Caller: TfsMethodHelper): Variant;
var
  s: String;
  v: Variant;
begin
  if MethodName = 'LENGTH' then
  begin
    v := Caller.Params[0];
    if VarIsArray(v) then
      Result := VarArrayHighBound(v, 1) - VarArrayLowBound(v, 1) + 1
    else
      Result := Length(v)
  end
  else if MethodName = 'COPY' then
    Result := Copy(Caller.Params[0], Integer(Caller.Params[1]), Integer(Caller.Params[2]))
  else if MethodName = 'POS' then
  {$IFNDEF FPC}
    Result := Pos(Caller.Params[0], Caller.Params[1])
  {$ELSE}
    Result := Pos(AnsiString(Caller.Params[0]), AnsiString(Caller.Params[1]))
  {$ENDIF}
  else if (MethodName = 'DELETE') or (MethodName = 'DELETESTR') then
  begin
    s := Caller.Params[0];
    Delete(s, Integer(Caller.Params[1]), Integer(Caller.Params[2]));
    Caller.Params[0] := s;
  end
  else if MethodName = 'INSERT' then
  begin
    s := Caller.Params[1];
    Insert(Caller.Params[0], s, Integer(Caller.Params[2]));
    Caller.Params[1] := s;
  end
  else if MethodName = 'UPPERCASE' then
    Result := AnsiUppercase(Caller.Params[0])
  else if MethodName = 'LOWERCASE' then
    Result := AnsiLowercase(Caller.Params[0])
  else if MethodName = 'TRIM' then
    Result := Trim(Caller.Params[0])
  else if MethodName = 'NAMECASE' then
    Result := NameCase(Caller.Params[0])
  else if MethodName = 'COMPARETEXT' then
    Result := AnsiCompareText(Caller.Params[0], Caller.Params[1])
  else if MethodName = 'CHR' then
    Result := Chr(Integer(Caller.Params[0]))
  else if MethodName = 'ORD' then
    Result := Ord(String(Caller.Params[0])[1])
  else if MethodName = 'SETLENGTH' then
  begin
    if (TVarData(Caller.Params[0]).VType = varString) or
      (TVarData(Caller.Params[0]).VType = varOleStr) then
    begin
      s := Caller.Params[0];
      SetLength(s, Integer(Caller.Params[1]));
      Caller.Params[0] := s;
    end
    else
    begin
      v := Caller.Params[0];
      VarArrayRedim(v, Integer(Caller.Params[1]) - 1);
      Caller.Params[0] := v;
    end;
  end
end;

function TfsSysFunctions.CallMethod6(Instance: TObject; ClassType: TClass;
  const MethodName: String; Caller: TfsMethodHelper): Variant;
begin
  if MethodName = 'ROUND' then
    Result := Integer(Round(Caller.Params[0]))
  else if MethodName = 'TRUNC' then
    Result := Integer(Trunc(Caller.Params[0]))
  else if MethodName = 'INT' then
    Result := Int(Caller.Params[0])
  else if MethodName = 'FRAC' then
    Result := Frac(Caller.Params[0])
  else if MethodName = 'SQRT' then
    Result := Sqrt(Caller.Params[0])
  else if MethodName = 'ABS' then
    Result := Abs(Caller.Params[0])
  else if MethodName = 'SIN' then
    Result := Sin(Caller.Params[0])
  else if MethodName = 'COS' then
    Result := Cos(Caller.Params[0])
  else if MethodName = 'ARCTAN' then
    Result := ArcTan(Caller.Params[0])
  else if MethodName = 'TAN' then
    Result := Sin(Caller.Params[0]) / Cos(Caller.Params[0])
  else if MethodName = 'EXP' then
    Result := Exp(Caller.Params[0])
  else if MethodName = 'LN' then
    Result := Ln(Caller.Params[0])
  else if MethodName = 'PI' then
    Result := Pi
end;

function TfsSysFunctions.CallMethod7(Instance: TObject; ClassType: TClass;
  const MethodName: String; Caller: TfsMethodHelper): Variant;
begin
  if MethodName = 'INC' then
  begin
    Caller.Params[0] := Caller.Params[0] + Caller.Params[1];
  end
  else if MethodName = 'DEC' then
  begin
    Caller.Params[0] := Caller.Params[0] - Caller.Params[1];
  end
  else if MethodName = 'RAISEEXCEPTION' then
    raise Exception.Create(Caller.Params[0])
{$IFNDEF NOFORMS}
  else if MethodName = 'SHOWMESSAGE' then
    ShowMessage(Caller.Params[0])
{$ENDIF}
  else if MethodName = 'RANDOMIZE' then
    Randomize
  else if MethodName = 'RANDOM' then
    Result := Random
  else if MethodName = 'VALIDINT' then
    Result := ValidInt(Caller.Params[0])
  else if MethodName = 'VALIDFLOAT' then
    Result := ValidFloat(Caller.Params[0])
  else if MethodName = 'VALIDDATE' then
  begin
    if VarType(Caller.Params[0]) = varDate then
      Result := ValidDate(DateToStr(Caller.Params[0]))
    else Result := ValidDate(Caller.Params[0]);
  end
{$IFDEF OLE}
  else if MethodName = 'CREATEOLEOBJECT' then
    Result := CreateOleObject(Caller.Params[0])
{$ENDIF}
  else if MethodName = 'VARARRAYCREATE' then
    Result := VArrayCreate(Caller.Params[0], Caller.Params[1])
  else if MethodName = 'VARTOSTR' then
    Result := VarToStr(Caller.Params[0])
  else if MethodName = 'VARTYPE' then
    Result := VarType(Caller.Params[0])
end;


end.