表达式运算，四则混合运算

自己实现的四则表达式运算类，算是消遣吧，现只支持四则混合运算

View Code

type

 Topr = (opAdd, opSub, opMul, opDiv, opLbc, opRbc, opNum);
 PToken = ^TToken;
 TToken = record
   Tag: Topr;
   V: Double;
end;

 TExp = array of TToken;
 PExp = array of PToken;

 TCalc = class
 private
   FMsg: string;
 private
function ToInfix(const S: string; var E: TExp): Boolean;//字串转中缀表达式
procedure ToRPN(var E: TExp);                           //中缀表达式转逆波兰式
function CalcRPN(const E: TExp;var V: Double): Boolean; //运算
 public
function Calc(const S: string; var V: Double): Boolean;
   property Msg: string read FMsg;
end;

{ TCalc }

function TCalc.Calc(const S: string; var V: Double): Boolean;
var
  E: TExp;
begin
  V := 0;
  FMsg := '';
  Result := False;
if not ToInfix(S,E) then Exit;
  ToRPN(E);
  Result := CalcRPN(E,V);
end;

function TCalc.CalcRPN(const E: TExp; var V: Double): Boolean;
var
  M: PExp;
  I,J: Integer;
  A,B: Double;
begin
  Result := False;
  V := 0;
  SetLength(M,Length(E));
  J := -1;
for I := 0 to High(E) do
if E[I].Tag = opNum then
begin
    Inc(J);
    M[J] := @E[I];
end
else
begin
if J < 1 then
begin
      FMsg := '缺少运算对象';
      Exit;
end;
    A := M[J-1].V;
    B := M[J].V;
case E[I].Tag of
      opAdd: A := A + B;
      opSub: A := A - B;
      opMul: A := A * B;
      opDiv:
begin
if B = 0 then
begin
            FMsg := '除数不能为零';
            Exit;
end;
          A := A / B;
end;
end;
    Dec(J);
    M[J].V := A;
end;
  V := M[0].V;
  Result := True;
end;

function TCalc.ToInfix(const S: string; var E: TExp): Boolean;
var
  I,J,K,L,BC: Integer;
begin
  Result := False;
  L := Length(S);
if L = 0 then Exit;
  I := 1;
  J := 0;
  BC := 0;
  SetLength(E,L);
while I <= L do
case S[I] of
'+':
begin
        E[J].Tag := opAdd;
        Inc(I);
        Inc(J);
end;
'-':
begin
        E[J].Tag := opSub;
        Inc(I);
        Inc(J);
end;
'*':
begin
        E[J].Tag := opMul;
        Inc(I);
        Inc(J);
end;
'/':
begin
        E[J].Tag := opDiv;
        Inc(I);
        Inc(J);
end;
'(':
begin
        E[J].Tag := opLbc;
        Inc(I);
        Inc(J);
        Inc(BC);
end;
')':
begin
        E[J].Tag := opRbc;
        Inc(I);
        Inc(J);
        Dec(BC);
if BC < 0 then Break;
end;
'0'..'9':
begin
        K := I;
        Inc(I);
while (I <= L) and (S[I] in ['0'..'9']) do Inc(I);
if (I <= L) and (S[I] in ['.','e','E']) then
begin
if S[I] = '.' then
begin
            Inc(I);
while (I <= L) and (S[I] in ['0'..'9']) do Inc(I);
if (I <= L) and (S[I] in ['e','E']) then
begin
              Inc(I);
if S[I] in ['+','-'] then Inc(I);
while (I <= L) and (S[I] in ['0'..'9']) do Inc(I);
end;
end
else
begin
            Inc(I);
if S[I] in ['+','-'] then Inc(I);
while (I <= L) and (S[I] in ['0'..'9']) do Inc(I);
end;
end;
if not TryStrToFloat(Copy(S,K,I - K), E[J].V) then
begin
          FMsg := '不正确的数字';
          Exit;
end;
if (J > 0) and (E[J-1].Tag = opSub)and((J = 1) or (E[J-2].Tag = opLbc)) then
begin
          E[J-1].Tag := opNum;
          E[J-1].V := -E[J].V;
end
else
begin
          E[J].Tag := opNum;
          Inc(J);
end
end;
else
begin
        FMsg := '不支持的符号';
        Exit;
end;
end;
if BC <> 0 then
begin
    FMsg := '括号不匹配';
    Exit;
end;
  SetLength(E, J);
  Result := True;
end;

procedure TCalc.ToRPN(var E: TExp);
const
  T: array[Topr] of Byte = (1,1,2,2,0,3,255);
var
  M: TExp;
  S,N: PExp;
  I,Si,Ni: Integer;
begin
  SetLength(M, Length(E));
  SetLength(S, Length(E));
  SetLength(N, Length(E));
for I := 0 to Length(E) - 1 do
    M[I] := E[I];
  Si := -1;
  Ni := -1;
for I := Low(M) to High(M) do
with M[I] do
begin
if Tag = opNum then
begin
      Inc(Ni);
      N[Ni] := @M[I];
      Continue;
end;
    //右括号则在符号栈弹出直到栈顶为左括号，且二者均丢弃
if Tag = opRbc then
begin
while Si <> -1 do
begin
if S[Si].Tag = OpLbc then
begin
          Dec(Si);
          Break;
end;
        Inc(Ni);
        N[Ni] := S[Si];
        Dec(Si);
end;
      Continue;
end;
if (Tag = opLbc) or (Si = -1) or
      (T[Tag] > T[S[Si].tag])  then
begin
      Inc(Si);
      S[Si] := @M[I];
      Continue;
end;
  //反复退栈输出栈S中运算符，直到栈顶符<x。
while (Si <> -1) do
begin
if (T[S[Si].Tag] < T[Tag] )  then
        Break;
      Inc(Ni);
      N[Ni] := S[Si];
      Dec(Si);
end;
    Inc(Si);
    S[Si] := @M[I];
end;
while (Si <> -1) do
begin
    Inc(Ni);
    N[Ni] := S[Si];
    Dec(Si);
end;
  SetLength(E,Ni + 1);
for I := Ni downto 0 do
    E[I] := N[I]^;
end;

调用方法如下:

var
  S: string;
  V: Double;
  Calc: TCalc;
begin
  Calc := TCalc.Create;
  S := '8*(7-9)/(6-3*2)-9';
if Calc.Calc(S,V) then
    ShowMessageFmt('%s=%g',[S,V])
else
    ShowMessage(Calc.Msg);
  Calc.Free;
end;

转载于:https://www.cnblogs.com/chinyeh/archive/2012/04/06/2435033.html