Delphi实现Js中的Eval函数

最新推荐文章于 2025-11-30 12:40:05 发布

原创最新推荐文章于 2025-11-30 12:40:05 发布 · 524 阅读

7 ·

本内容遵循CC 4.0 BY-SA版权协议

标签

#javascript #开发语言 #ecmascript

本文介绍了一个用于解析并计算数学表达式的代码过程，包括处理数字、运算符、指数和标准函数的应用。函数逐字符分析算式并执行相应的加减乘除和数学运算。

代码
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;