表达式计算函数


function GetExpressionValue(ExpressionStr: string; var E: string; Rvn: boolean = false): extended;
{
//
/                                                                            /
/ 此为早期VB的练习作品,使用了大量的goto,使程序非常难读,改为delphi后有许多 /
/     编译警告,但没有功能上及内存泄漏的问题 2001-06-22                      /
/                                                                            /
/ 函数功能:表达式求解                                                       /
/ 参    数:<ExpressionStr>必要,字符串类型,是一个以##为标界(可省略)包    /
/           含数字及运算符优先符的字符串                                     /
/           [Rvn]可省略,布尔类型,选择异常返回值类型,Ture 返回代码异常     /
/           值,False 返回中文异常值                                         /
/           运算符支持 +、-、*、/、^、(、)、+(正)、-(负) (注:正    /
/           负号必须与其后的数字包含在(、)内才会优先运算) 的运算,括号     /
/           之间的*可以省略,字符串中的空格将被忽略,任何其他非算符字符     /
/           会返回错误。                                                     /
/ 返回值说明: #+)n 表示在n处多出),#-)n 表示在n处缺少),#E 表示表达式     /
/           为空,#Zm.n表示从m至n的除数为0,#Pm.n表示从m至n的底数为0而指     /
/           数为负数,#n 表示在n有无法识别的符号                             /
/ 其他说明:本函数调用了自定义函数 Repl,用于除去字符串中的空格和将)(、    /
/           (+、(- 分别解释为)*(、(0+及(0-。                      /
/           本函数调用的其他自定义函数有 VAL()、MID()、LEFT()、RIGHT()       /
/                                                                            /
/                          算符优先级表:                                    /
/                                                                            /
/                   + - * / ^ ( ) #                           /
/               + > > < < < < > >                           /
/               - > > < < < < > >                           /
/               * > > > > < < > >                           /
/               / > > > > < < > >                           /
/               ^ > > > > > < > >                           /
/               ( < < < < > < =  #)                           /
/               ) > > > > > ? > >                           /
/               # < < < < < < #( >                           /
/                                                                            /
/ 例: GetExpressionValue("#1.2+4^4*7+2/(7-3)#")                             /
/      返回 1793.7     ,正确的结果                                          /
/      GetExpressionValue("1.2+4^4*7+2/(7-3)#")                              /
/      返回 1793.7     ,任一标界均省略                                      /
/      GetExpressionValue("1.2+4^4*7+2/(7-3))")                              /
/      返回 “在 18 处多出 )”                                               /
/      GetExpressionValue("1.2+4^4*7+2/(7-3))",True)                         /
/      返回 #+)18      ,在 18 处多出 )                                      /
/      GetExpressionValue("1.2+4^4*7+2/((7-3)")                              /
/      返回 “在 19 处缺少)”                                                /
/      GetExpressionValue("1.2+4^4*7+2/((7-3)",True)                         /
/      返回 #-)19      ,在 19 处缺少                                        /
/      GetExpressionValue("1,2+4^4*7+2/((7-3)")                              /
/      返回 “在 2 处有无法识别的符号”                                      /
/      GetExpressionValue("1,2+4^4*7+2/((7-3)",Ture)                         /
/      返回 #2         ,第2个字符无法识别                                   /
/      GetExpressionValue("1.    2+4 ^4*7+ 2/(7 -3)")                        /
/      返回 1793.7     ,空格被忽略                                          /
/      GetExpressionValue("")                                                /
/      返回“表达式为空”                                                    /
/      GetExpressionValue("",Ture)                                           /
/      返回 #E                                                               /
//
}
const
  OperateSYN: set of char = ['+', '-', '*', '/', '^', '(', ')', '#'];           //操作符集
  //    OperateNUM:set of char=['0','1','2','3','4','5','6','7','8','9','.'];
var
  Optr: TStack;                                                                 //操作符栈
  OptrS: ^Integer;                                                              //用于
  OptrP: char;                                                                  //用于暂存操作符进行比较
  Opdn: TStack;                                                                 //操作数及结果栈
  LineNo: TStack;                                                               //保存函数的返回地址
  Opri: array[0..7, 1..2] of string;                                            //存储操作符的优先级,第○列表示该操作符的符号,
  //第一列表示该操作符的类别,第二列表示该操作符的优先级
  Xs: string;                                                                   //暂存输入
  Theta: ^integer;                                                              //获得参与运算的操作符
  a: ^extended;                                                                 //操作数a
  b: ^extended;                                                                 //操作数b
  c: ^extended;                                                                 //运算返回值
  i: integer;                                                                   //字符串的当前位置
  j: integer;                                                                   //用于判断取操作数的位数
  k: Integer;                                                                   //仅用于 AllLine 部分
  iP: ^extended;                                                                //用于操作数压栈
  jP: ^integer;                                                                 //用于操作符压栈及与栈有关的整型变量
  LsOptr: ^integer;                                                             //获得操作符栈栈顶元素
  Cinb: boolean;                                                                //用于判断输入是否为操作符,Ture 为操作符 False 为操作数
  Prec: char;                                                                   //用于保存操作符的比较结果
  Pn: boolean;
  Ex: string;
label
  10, 20, 30, 40, 50, 60, 70, 80, 90, 100, Precede, Operate, JudgeNumber, AllLine, ConvOperateSYN, ExitTF, ReturnR;
begin
  Ex := '';
  Optr := TStack.Create;
  Opdn := TStack.Create;
  LineNo := TStack.Create;
  New(iP);
  //    Opri[0, 0] := '(';                    // (
  Opri[0, 1] := 'P';                                                            // P 表示是优先符
  Opri[0, 2] := 'L';                                                            // L 表示是左优先符
  //    Opri[1, 0] := ')';                    // )
  Opri[1, 1] := 'P';
  Opri[1, 2] := 'R';                                                            // R 表示是右优先符

  //    Opri[2, 0] := '^';                    // ^
  Opri[2, 1] := 'O';                                                            // O 表示是运算符
  Opri[2, 2] := '10';                                                           // 0
  //    Opri[3, 0] := '*';                    // *
  Opri[3, 1] := 'O';
  Opri[3, 2] := '20';                                                           // 1
  //    Opri[4, 0] := '/';                    // /
  Opri[4, 1] := 'O';
  Opri[4, 2] := '20';                                                           // 1
  //    Opri[5, 0] := '+';                    // +
  Opri[5, 1] := 'O';
  Opri[5, 2] := '30';                                                           // 2
  //    Opri[6, 0] := '-';                    // -
  Opri[6, 1] := 'O';
  Opri[6, 2] := '30';                                                           // 2
  //    Opri[7, 0] := '#';                    // #
  Opri[7, 1] := 'S';                                                            // S 表示是结束符
  Opri[7, 2] := '40';                                                           // 3

  {    0, '(';
       1, ')';
       2, '^';
       3, '*';
       4, '/';
       5, '+';
       6, '-';
       7, '#';}

  ///

  if Length(ExpressionStr) = 0 then
  begin
    Ex := CxFFPC.IIf(Rvn, '#E', '表达式为空');
    iP^ := 0;
    Opdn.Push(iP);
    goto ReturnR;
  end
  else begin
    if CxFFPC.CRight(ExpressionStr, 1) <> '#' then ExpressionStr := ExpressionStr + '#';
    if CxFFPC.CLeft(ExpressionStr, 1) = '#' then ExpressionStr := CxFFPC.Mid(ExpressionStr, 2);
  end;
  ExpressionStr := CxFFPC.Repl(ExpressionStr, ')(', ')*(');
  ExpressionStr := CxFFPC.Repl(ExpressionStr, '(-', '(0-');
  ExpressionStr := CxFFPC.Repl(ExpressionStr, '(+', '(0+');
  ExpressionStr := CxFFPC.Repl(ExpressionStr, ' ', '');
  i := 1;
  Pn := false;
  New(OptrS);
  OptrS^ := 7;
  Optr.Push(OptrS);                                                             // '#'
  iP^ := 0;
  Opdn.Push(iP);
  New(OptrS);
  OptrS^ := 40;
  LineNo.Push(OptrS);
  goto JudgeNumber;
  40:
  Xs := CxFFPC.Mid(ExpressionStr, i, j);
  i := i + j;
  OptrS := Optr.Peek;
  while not ((Xs = '#') and (OptrS^ = 7)) do
  begin
    10:
    if not Cinb then                                                            //如果是操作数
    begin
      Opdn.Push(iP);
      Pn := false;
      New(OptrS);
      OptrS^ := 50;
      LineNo.Push(OptrS);
      goto JudgeNumber;
      50:
      Xs := CxFFPC.Mid(ExpressionStr, i, j);
      i := i + j;
    end
    else begin
      New(OptrS);
      OptrS^ := 20;
      LineNo.Push(OptrS);
      OptrP := Xs[1];
      goto Precede;                                                             //判断操作符的优先级
      20:
      case Prec of
        '<':
          begin
            90:
            Optr.Push(jP);
            Pn := true;
            New(OptrS);
            OptrS^ := 60;
            LineNo.Push(OptrS);
            goto JudgeNumber;
            60:
            Xs := CxFFPC.Mid(ExpressionStr, i, j);
            i := i + j;
          end;
        '=':
          begin
            OptrS := Optr.Pop;
            Dispose(OptrS);
            New(OptrS);
            OptrS^ := 70;
            LineNo.Push(OptrS);
            goto JudgeNumber;
            70:
            Xs := CxFFPC.Mid(ExpressionStr, i, j);
            i := i + j;
          end;
        '>':
          begin
            Theta := Optr.Pop;
            b := Opdn.Pop;
            a := Opdn.Pop;
            New(OptrS);
            OptrS^ := 30;
            LineNo.Push(OptrS);
            goto Operate;
            30:
            Dispose(Theta);
            Dispose(a);
            Dispose(b);
          end;
      else
        goto ReturnR;
      end;
    end;
    OptrS := Optr.Peek;
  end;                                                                          //while

  ReturnR:
  iP := Opdn.Pop;
  Result := CxFFPC.IIf(Ex = '', iP^, 0);
  E := Ex;
  Dispose(iP);
  goto ExitTF;

  ///函数区
  Precede:                                                                      //判断两个操作符的优先级,返回值寄存在变量 Prec 中
  LsOptr := Optr.Peek;
  New(OptrS);
  OptrS^ := 100;
  LineNo.Push(OptrS);
  goto ConvOperateSYN;
  100:
  if LsOptr^ = 7 then
    if jP^ = 7 then
      Prec := '='
    else begin
      if Opri[jP^, 2] = 'R' then
      begin
        Prec := ' ';
        Ex := CxFFPC.IIf(Rvn, '#+)' + IntToStr(i - 1),
          ' 在 ' + IntToStr(i - 1) + ' 位多出 ) ');                             // # 表示表达式在此位置多 )
      end
      else
        Prec := '<';                                                            // # 表示表达式在此位置缺少 Opri(OP(Xs), 0)
      goto AllLine;
    end
  else
    if jP^ = 7 then
    begin
      if Opri[LsOptr^, 2] = 'L' then
      begin
        Prec := ' ';
        Ex := CxFFPC.IIf(Rvn, '#-)' + IntToStr(i - 1), ' 在 ' + IntToStr(i - 1) + ' 位缺少 ) ');
      end
      else
        Prec := '>';                                                            // # 表示表达式在此位置缺少 )
      goto AllLine;
    end;
  if (Opri[LsOptr^, 1] = 'O') and (Opri[jP^, 1] = 'O') then
  begin
    Prec := CxFFPC.IIf((StrToInt(Opri[LsOptr^, 2]) - StrToInt(Opri[jP^, 2])) <= 0, '>', '<');
    goto AllLine;
  end
  else
    if Opri[LsOptr^, 2] = 'L' then
      if Opri[jP^, 1] = 'P' then
      begin
        Prec := CxFFPC.IIf(Opri[jP^, 2] = 'R', '=', '<');
        goto AllLine;
      end
      else begin
        Prec := '<';
        goto AllLine;
      end
    else
      if Opri[LsOptr^, 2] = 'R' then
      begin
        if Opri[jP^, 2] = 'L' then
        begin
          Prec := ' ';
          Ex := 'Error';
        end
        else
          Prec := '>';
        goto AllLine;
      end
      else begin
        Prec := CxFFPC.IIf(Opri[jP^, 2] = 'L', '<', '>');
        goto AllLine;
      end;
  goto AllLine;

  Operate:                                                                      //对操作数求值,返回值压回 Opdn 栈
  case Theta^ of
    5:                                                                          // +
      begin
        New(c);
        c^ := a^ + b^;
        Opdn.Push(c);
      end;
    6:                                                                          // -
      begin
        New(c);
        c^ := a^ - b^;
        Opdn.Push(c);
      end;
    3:                                                                          // *
      begin
        New(c);
        c^ := a^ * b^;
        Opdn.Push(c);
      end;
    4:                                                                          // /
      begin
        if b^ = 0 then
        begin
          Ex := CxFFPC.IIf(Rvn, '#Z' + IntToStr(i - 1 - Length(VarToStr(b^))) + '.'
            + IntToStr(Length(VarToStr(b^))), '从第 ' +
            IntToStr(i - 1 - Length(VarToStr(b^))) + ' 位开始的 ' +
            IntToStr(Length(VarToStr(b^))) + ' 位数据为零');
          goto ReturnR;
        end;
        New(c);
        c^ := a^ / b^;
        Opdn.Push(c);
      end;
    2:                                                                          //  ^
      begin
        if (a^ = 0) and (b^ < 0) then
        begin
          Ex := CxFFPC.IIf(Rvn, '#P' + IntToStr(i - 1 - Length(VarToStr(b^))) + '.'
            + IntToStr(Length(VarToStr(b^))), '从第 ' +
            IntToStr(i - 1 - Length(VarToStr(b^))) + ' 位开始的 ' +
            IntToStr(Length(VarToStr(b^))) + ' 位的指数为负,而底数为零');
          goto ReturnR;
        end;
        New(c);
        c^ := Math.Power(a^, b^);
        Opdn.Push(c);
      end;
  end;                                                                          //case
  goto AllLine;

  JudgeNumber:                                                                  //判断数字,返回值寄存在变量 j 中
  j := i;
  while (CxFFPC.Asc(CxFFPC.Mid(ExpressionStr, j, 1)) = 46) or ((CxFFPC.Asc(CxFFPC.Mid(ExpressionStr, j, 1)) >= 48) and (CxFFPC.Asc(CxFFPC.Mid(ExpressionStr, j, 1)) <= 57)) do
    j := j + 1;
  if j > i then
  begin
    Cinb := false;
    j := j - i;
  end
  else begin
    OptrP := ExpressionStr[j];
    Cinb := OptrP in OperateSYN;
    if Cinb then
    begin
      New(OptrS);
      OptrS^ := 80;
      LineNo.Push(OptrS);
      goto ConvOperateSYN;
      80:
      if Pn and (jP^ <> 0) then
      begin
        Ex := CxFFPC.IIf(Rvn, '#' + IntToStr(j), '在 ' + IntToStr(j - 1) + ' 位有的多余运算符');
        goto ReturnR;
      end
    end
    else begin
      Ex := CxFFPC.IIf(Rvn, '#' + IntToStr(j), '在 ' + IntToStr(j) + ' 位有无法识别的符号');
      goto ReturnR;
    end;
    j := 1;
  end;
  New(iP);
  iP^ := CxFFPC.CVal(CxFFPC.Mid(ExpressionStr, i, j));
  goto AllLine;

  ConvOperateSYN:                                                               //将操作符转换为优先级,返回值寄存在变量 jP^ 中
  New(jP);
  case OptrP of
    '(':
      jP^ := 0;
    ')':
      jP^ := 1;
    '^':
      jP^ := 2;
    '*':
      jP^ := 3;
    '/':
      jP^ := 4;
    '+':
      jP^ := 5;
    '-':
      jP^ := 6;
    '#':
      jP^ := 7;
  end;

  goto AllLine;
  ///返回区
  AllLine:
  OptrS := LineNo.Pop;
  k := OptrS^;
  Dispose(OptrS);
  case k of
    10:
      goto 10;
    20:
      goto 20;
    30:
      goto 30;
    40:
      goto 40;
    50:
      goto 50;
    60:
      goto 60;
    70:
      goto 70;
    80:
      goto 80;
    90:
      goto 90;
    100:
      goto 100;
  end;
  ///释放资源区
  ExitTF:
  for k := 1 to Optr.Count do
    Dispose(Optr.Pop);
  for k := 1 to Opdn.Count do
    Dispose(Opdn.Pop);
  for k := 1 to LineNo.Count do
    Dispose(LineNo.Pop);
  Optr.Free;
  Opdn.Free;
  LineNo.Free;
end;  

  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值