Problem using fr3 and FastScript

Comments

• gordk St.Catherines On. Canada.

  November 2005 edited 1:50PM

  there has been a change fr no longer uses the fs global unit
  so you must modify the scipt files
  an example of new way
  
  unit gkfunctions;
  
  interface
  
  implementation
  uses SysUtils, Classes, fs_iinterpreter, esbdates;
  
  type
  TFunctions = class(TfsRTTIModule)
  private
  function CallMethod(Instance: TObject; ClassType: TClass; const
  MethodName: String; var Params: Variant): Variant;
  
  public
  constructor Create(AScript: TfsScript); override;
  end;
  
  
  
  function DaysBetween(Olddate: Tdatetime; NewDate: Tdatetime): integer;
  begin
  Result := Trunc(Newdate) - Trunc(Olddate);
  if Result < 0 then Result := 0;
  end;
  
  function GetNumber(sNum: string; iPos: integer; var bThousand, bMillion:
  boolean): string;
  begin
  Result:='';
  if (iPos=1) or (iPos=3) or (iPos=4) or (iPos=6) or (iPos=7) then begin
  Case StrtoInt(sNum) of
  1: Result:='One ';
  2: Result:='Two ';
  3: Result:='Three ';
  4: Result:='Four ';
  5: Result:='Five ';
  6: Result:='Six ';
  7: Result:='Seven ';
  8: Result:='Eight ';
  9: Result:='Nine ';
  end;
  if sNum<>'0' then begin
  if (iPos=3) or (iPos=6) then
  Result:=Result+'Hundred ';
  if (iPos=4) or (iPos=6) then begin
  if not bThousand then begin
  Result:=Result+'Thousand ';
  bThousand:=True;
  end
  else
  Result:=Result+' '; {and}
  end;
  if iPos=7 then begin
  if not bMillion then begin
  Result:=Result+'Million ';
  bMillion:=True;
  end
  else
  Result:=Result+' ';{and}
  end;
  end;
  end
  else if ((iPos=2) or (iPos=5) or (iPos=8)) and (length(sNum)=2) then begin
  Case StrtoInt(sNum) of
  10: Result:='Ten ';
  11: Result:='Eleven ';
  12: Result:='Twelve ';
  13: Result:='Thirteen ';
  14: Result:='Fourteen ';
  15: Result:='Fifteen ';
  16: Result:='Sixteen ';
  17: Result:='Seventeen ';
  18: Result:='Eighteen ';
  19: Result:='Nineteen ';
  end;
  if sNum<>'0' then begin
  if (iPos=5) and (not bThousand) then begin
  Result:=Result+'Thousand ';
  bThousand:=True;
  end
  else if (iPos=8) and (not bMillion) then begin
  Result:=Result+'Million ';
  bMillion:=True;
  end;
  end;
  end
  else if (iPos=2) or (iPos=5) or (iPos=8) then begin
  Case StrtoInt(sNum) of
  2: Result:='Twenty ';
  3: Result:='Thirty ';
  4: Result:='Forty ';
  5: Result:='Fifty ';
  6: Result:='Sixty ';
  7: Result:='Seventy ';
  8: Result:='Eighty ';
  9: Result:='Ninety ';
  end;
  if sNum<>'0' then begin
  if (iPos=5) and (not bThousand) then begin
  Result:=Result+'Thousand ';
  bThousand:=True;
  end
  else if (iPos=8) and (not bMillion) then begin
  Result:=Result+'Million ';
  bMillion:=True;
  end;
  end;
  end;
  end;
  
  
  function CurrencytoText(rAmt: real):string;
  var
  sAmt, s1Amt, cents: string;
  x, test, index: integer;
  bThousand, bMillion: boolean;
  begin
  if rAmt >0 then
  begin
  Result:='';
  s1Amt := floattostrf(rAmt,ffcurrency,19,2);
  x := pos('.',s1amt);
  cents := copy(s1amt,x+1,2);
  cents := cents + '/100';
  sAmt:=InttoStr(Trunc(rAmt));
  bThousand:=False;
  bMillion:=False;
  x:=length(sAmt);
  case x of
  
  1:begin
  if Copy(sAmt,x-1,1)='0' then
  Result := 'Zero' else
  Result:= GetNumber(Copy(sAmt,x-1,2),1,bThousand,bMillion)+Result
  end;
  else
  if Copy(sAmt,x-1,1)='1' then
  Result:=GetNumber(Copy(sAmt,x-1,2),2,bThousand,bMillion)+Result
  else
  Result:=GetNumber(Copy(sAmt,x-1,1),2,bThousand,bMillion)+GetNumber(Copy(sAmt
  ,x,1),1,bThousand,bMillion);
  if x>2 then begin
  if Result<>'' then
  Result:=GetNumber(Copy(sAmt,x-2,1),3,bThousand,bMillion)+' '+Result {and}
  else
  Result:=GetNumber(Copy(sAmt,x-2,1),3,bThousand,bMillion);
  end;
  if (x=4) or ((x>4) and (Copy(sAmt,x-4,1)<>'1')) then begin
  if x>4 then begin
  Result:=GetNumber(Copy(sAmt,x-3,1),4,bThousand,bMillion)+Result;
  Result:=GetNumber(Copy(sAmt,x-4,1),5,bThousand,bMillion)+Result;
  end
  else
  Result:=GetNumber(Copy(sAmt,x-3,1),4,bThousand,bMillion)+Result;
  end
  else if x>4 then
  Result:=GetNumber(Copy(sAmt,x-4,2),5,bThousand,bMillion)+Result;
  if x>5 then begin
  Result:=GetNumber(Copy(sAmt,x-5,1),6,bThousand,bMillion)+Result;
  end;
  if (x=7) or ((x>7) and (Copy(sAmt,x-7,1)<>'1')) then begin
  if x>4 then begin
  Result:=GetNumber(Copy(sAmt,x-6,1),7,bThousand,bMillion)+Result;
  Result:=GetNumber(Copy(sAmt,x-7,1),8,bThousand,bMillion)+Result;
  end
  else
  Result:=GetNumber(Copy(sAmt,x-6,1),7,bThousand,bMillion)+Result;
  end
  else if x>7 then
  Result:=GetNumber(Copy(sAmt,x-7,2),8,bThousand,bMillion)+Result;
  end;{end case}
  Result := Result +' and '+cents + ' dollars';
  Insert('***', result, 1);
  // ************
  if (length(result) < 75) then
  begin
  index := length(result) - 14;
  test := 75 - length(result);
  repeat
  begin
  Insert('*',result, Index);
  dec(test);
  end;
  until test = 0;
  result := uppercase(result);
  end
  else
  result := uppercase(result);
  end
  else{if rnum = 0}
  result := 'zero';
  result := uppercase(result);
  end;
  
  
  { TFunctions }
  constructor TFunctions.Create(AScript: TfsScript);
  begin
  inherited Create(AScript);
  with AScript do
  begin
  AddMethod('function DaysBetween(Olddate: Tdatetime; NewDate: Tdatetime): Integer',
  CallMethod, 'Extra functions', 'DaysBetween returns integer');
  
  addMethod('function CurrencytoText(rAmt: real):string',
  CallMethod, 'Extra functions', 'CurrencytoText returns string of chars used for cheque writing NAmer');
  
  AddMethod('function TimeApartInMins(Date1: Tdatetime; Date2: Tdatetime): Double',
  CallMethod, 'Extra functions','TimeApartInMins returns integer');
  
  // add more here using add method
  end;
  end;
  
  function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
  const MethodName: String; var Params: Variant): Variant;
  begin
  if MethodName = 'DAYSBETWEEN' then
  Result := DaysBetween(Params[0], Params[1])
  else if Methodname = 'CURRENCYTOTEXT' THEN
  Result := CurrencytoText(Params[0])
  else if Methodname = 'TIMEAPARTINMINS' then
  // this one passes params to esbdates
  result := TimeApartInMins(Params[0], Params[1])
  // add more here
  {else if MethodName = 'MYFUNC' then
  MyFunc(Params[0]);}
  end;
  
  initialization
  fsRTTIModules.Add(TFunctions);
  end.
  
• EresInformatica

  December 2005 edited 1:50PM

  Okay, that??s works in Fr3 reports and scripting (in reports).
  
  But, like i said, i??m using only script (isolated from fr reports) too... in this case, how to add these functions ? the same code is not working... help.
  
  I??m using scripts not in report, but in my application.
  
  Thanks!