Delphi实现Js中的Eval函数

代码

procedure Eval(Formula: string ; { 要计算的表达式 }
var Value: Real; { 返回数值 }
var ErrPos: Integer); { 错误信息 }
const
Digit: set of Char = [ ' 0 ' .. ' 9 ' ];
var
Posn: Integer; { 算式当前位置 }
CurrChar: Char; { 算式当前字符 }

procedure ParseNext;
begin
repeat
Posn : = Posn + 1 ;
if Posn <= Length(Formula) then
CurrChar : = Formula[Posn]
else
CurrChar : = ^M;
until CurrChar <> ' ' ;
end { ParseNext } ;

function add_subt: Real;
var
E: Real;
Opr: Char;

function mult_DIV: Real;
var
S: Real;
Opr: Char;

function Power: Real;
var
T: Real;

function SignedOp: Real;

function UnsignedOp: Real;
type
StdFunc = (fabs, fsqrt, fsqr, fsin, fcos,
farctan, fln, flog, fexp, ffact);
StdFuncList = array [StdFunc] of string [ 6 ];

const
StdFuncName: StdFuncList =
( ' ABS ' , ' SQRT ' , ' SQR ' , ' SIN ' , ' COS ' ,
' ARCTAN ' , ' LN ' , ' LOG ' , ' EXP ' , ' FACT ' );
var
E, L, Start: Integer;
Funnet: Boolean;
F: Real;
Sf: StdFunc;

function Fact(I: Integer): Real;
begin
if I > 0 then
begin
Fact : = I * Fact(I - 1 );
end
else
Fact : = 1 ;
end { Fact } ;

begin
if CurrChar in Digit then
begin
Start : = Posn;
repeat ParseNext until not (CurrChar in Digit);
if CurrChar = ' . ' then
repeat ParseNext until not (CurrChar in Digit);
if CurrChar = ' E ' then
begin
ParseNext;
repeat ParseNext until not (CurrChar in Digit);
end ;
Val(Copy(Formula, Start, Posn - Start), F, ErrPos);
end
else if CurrChar = ' ( ' then
begin
ParseNext;
F : = add_subt;
if CurrChar = ' ) ' then
ParseNext
else
ErrPos : = Posn;
end
else
begin
Funnet : = False;
for sf : = fabs to ffact do
if not Funnet then
begin
l : = Length(StdFuncName[sf]);
if Copy(Formula, Posn, l) = StdFuncName[sf] then
begin
Posn : = Posn + l - 1 ;
ParseNext;
f : = UnsignedOp;
case sf of
fabs: f : = abs(f);
fsqrt: f : = SqrT(f);
fsqr: f : = Sqr(f);
fsin: f : = Sin(f);
fcos: f : = Cos(f);
farctan: f : = ArcTan(f);
fln: f : = LN(f);
flog: f : = LN(f) / LN( 10 );
fexp: f : = EXP(f);
ffact: f : = fact(Trunc(f));
end ;
Funnet : = True;
end ;
end ;
if not Funnet then
begin
ErrPos : = Posn;
f : = 0 ;
end ;
end ;
UnsignedOp : = F;
end { UnsignedOp } ;

begin { SignedOp }
if CurrChar = ' - ' then
begin
ParseNext;
SignedOp : = - UnsignedOp;
end
else
SignedOp : = UnsignedOp;
end { SignedOp } ;

begin { Power }
T : = SignedOp;
while CurrChar = ' ^ ' do
begin
ParseNext;
if t <> 0 then
t : = EXP(LN(abs(t)) * SignedOp)
else
t : = 0 ;
end ;
Power : = t;
end { Power } ;

begin
s : = Power;
while CurrChar in [ ' * ' , ' / ' ] do
begin
Opr : = CurrChar;
ParseNext;
case Opr of
' * ' : s : = s * Power;
' / ' : s : = s / Power;
end ;
end ;
mult_DIV : = s;
end ;

begin
E : = mult_DIV;
while CurrChar in [ ' + ' , ' - ' ] do
begin
Opr : = CurrChar;
ParseNext;
case Opr of
' + ' : e : = e + mult_DIV;
' - ' : e : = e - mult_DIV;
end ;
end ;
add_subt : = E;
end ;

begin
if Formula[ 1 ] = ' . ' then
Formula : = ' 0 ' + Formula;
if Formula[ 1 ] = ' + ' then
Delete(Formula, 1 , 1 );
for Posn : = 1 to Length(Formula) do
Formula[Posn] : = Upcase(Formula[Posn]);
Posn : = 0 ;
ParseNext;
Value : = add_subt;
if CurrChar = ^M then
ErrPos : = 0
else
ErrPos : = Posn;
end ;

 

转载于:https://www.cnblogs.com/dyz/archive/2010/03/09/1681713.html