RemObjects Pascal Script在进行整数计算时,可以正常计算,但改成浮点数(Double,Currency,Single都一样),就报错Invalid floating point operation.
全部代码如下,谁对这个东东比较熟悉,指导一下,多谢
====================================================================
unit BizFunctionIntr;interfaceuses
  uPSCompiler,  uPSRuntime, uPSUtils, SysUtils;function getFunctionResult(sFormula:string):Double;implementationuses
  BizFunction;const
  Script = 'function GetFormulaResult: Double; begin result:= %s;  end;';function ScriptOnExportCheck(Sender: TPSPascalCompiler; Proc: TPSInternalProcedure; const ProcDecl: string): Boolean;
begin
  if UpperCase(Proc.Name) = UpperCase('GetFormulaResult') then
    begin
      if not ExportCheck(Sender, Proc, [btDouble], []) then
      begin
        Sender.MakeError('', ecTypeMismatch, '');
        Result := False;
        Exit;
      end;
      Result := True;
    end
  else
    Result := True;
end;function ScriptOnUses(Sender: TPSPascalCompiler; const Name: string): Boolean;
begin
  if Name = 'SYSTEM' then
    begin
      Sender.AddDelphiFunction('function FeeItemBudgetAmt(BookId,Year,Month:Integer;const OrgId,ItemId:string):Double;');
      Sender.AddDelphiFunction('function FeeItemRealAmt(BookId,Year,Month:Integer;const OrgId,ItemId:string):Double;');
      Sender.AddDelphiFunction('function Test(i:Integer):Double;');      Result := True;
    end
  else
    Result := False;
end;type
  TGetFormulaResultFunction = function : Double of object;function ExecuteScript(const Script: string):Double;
var
  Compiler: TPSPascalCompiler;
  Exec: TPSExec;
  Data: string;  GetFormulaResultFunc: TGetFormulaResultFunction;
begin
  Compiler := TPSPascalCompiler.Create; // create an instance of the compiler.
  Compiler.OnUses := ScriptOnUses;      // assign the OnUses event.  Compiler.OnExportCheck := ScriptOnExportCheck; // Assign the onExportCheck event.  Compiler.AllowNoBegin := True;
  Compiler.AllowNoEnd := True;  if not Compiler.Compile(Script) then begin  // 编译出错.
    Compiler.Free;
    Exit;
  end;  Compiler.GetOutput(Data); // Save the output of the compiler in the string Data.
  Compiler.Free;            // After compiling the script, there is no need for the compiler anymore.  Exec := TPSExec.Create;   // Create an instance of the executer.  Exec.RegisterDelphiFunction(@FeeItemBudgetAmt, 'FeeItemBudgetAmt', cdRegister);
  Exec.RegisterDelphiFunction(@FeeItemRealAmt, 'FeeItemRealAmt', cdRegister);
  Exec.RegisterDelphiFunction(@Test, 'Test', cdRegister);  if not Exec.LoadData(Data) then begin // Load the data from the Data string.
    Exec.Free;
    Exit;
  end;  GetFormulaResultFunc := TGetFormulaResultFunction(Exec.GetProcAsMethodN('GetFormulaResult'));
  if @GetFormulaResultFunc <> nil then
    result:=GetFormulaResultFunc;  Exec.Free; // Free the executer.
end;function getFunctionResult(sFormula:string):Double;
var
  s:string;
begin
  s:=Format(Script,[sFormula]);
  Result:=ExecuteScript(s);
end;end.
=====================================================
unit BizFunction;interfacefunction FeeItemBudgetAmt(BookId,Year,Month:Integer;const OrgId,ItemId:string):Double;
function FeeItemRealAmt(BookId,Year,Month:Integer;const OrgId,ItemId:string):Double;
function Test(i:Integer):Double;implementationfunction FeeItemBudgetAmt(BookId,Year,Month:Integer;const OrgId,ItemId:string):Double;
begin
  Result:=12345.0;
end;function FeeItemRealAmt(BookId,Year,Month:Integer;const OrgId,ItemId:string):Double;
begin
  Result:=23456.0;
end;function Test(i:Integer):Double;
begin
  if i=1 then
    Result:=1.0
  else
    Result:=99999.0;
end;end.
===========================================================
调用代码:
var
  x:Double;
  s:string;
begin
  s:='Test(1)';//*2+FeeItemBudgetAmt(1,1,1,''1'',''1'')';
  x:=getFunctionResult(s);  ShowMessage(Floattostr(x));
end;