自己实现的四则表达式运算类,算是消遣吧,现只支持四则混合运算
![](https://images.cnblogs.com/OutliningIndicators/ContractedBlock.gif)
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;