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;
全部代码如下,谁对这个东东比较熟悉,指导一下,多谢
====================================================================
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;
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货