昨天突然想写一个表达式计算器，幸好原来有段算法说明，然后温习一番，今天抽空将它简单实现出来。下面是源代码，直接编译后就可以了。
{*******************************************************}
{ }
{ Expression Calculate }
{ }
{ 版权所有 (C) 2003-2008 }
{ }
{*******************************************************}
program demo;
{===============================================================================
* 软件名称：demo /Expression
* 单元名称：表达式计算demo
* 单元作者：涂飞平
* 备 注：2008-10-16
* 开发平台：PWin2000SP4 + Delphi 11
===============================================================================}
{$APPTYPE CONSOLE}
uses
SysUtils,Classes,Math;
const SplitFlag=#13#10;
MaxArray=255;
var
CurrLevel,CurrPos:Integer;
CharArray:array [0..MaxArray] of Char;
ByteArray:array [0..MaxArray] of Byte;
RealArray:array [0..MaxArray] of Real;
procedure PushEx(value:real);
begin
if CurrPos>MaxArray then Exception.Create('PushEx Error:Out of Range 255');
RealArray[CurrPos]:=value;
CurrPos:=CurrPos+1;
end;
function PopEx():Real;
begin
CurrPos:=CurrPos-1;
if CurrPos<0 then raise Exception.Create('PopEx Error:Out of Range -1');
Result:=RealArray[CurrPos];
end;
procedure Push(oprator:Char;level:Byte);
begin
if CurrPos>MaxArray then Exception.Create('Push Error:Out of Range 255');
CharArray[CurrPos]:=oprator;
ByteArray[CurrPos]:=level;
CurrPos:=CurrPos+1;
end;
function Pop(var level:Byte):Char;
begin
CurrPos:=CurrPos-1;
if CurrPos<0 then raise Exception.Create('Pop Error:Out of Range -1');
Result:=CharArray[CurrPos];
level:=ByteArray[CurrPos];
end;
function GetOpratorIndex(oprator:Char):Integer;
begin
Result:=0;
case oprator of
'#'：Result:=-1;
'+','-':Result:=0;
'*','/':Result:=1;
'^':Result:=2;
end;
end;
function TestPop(oprator:Char):Boolean;
var
tmp:Char;level:Byte;
begin
tmp:=Pop(level);
Result:=False;
if (GetOpratorIndex(oprator)+CurrLevel)>(GetOpratorIndex(tmp)+Level) then
Result:=True;
Push(tmp,level);
end;
function depoland(S:string):string;
var
i:Integer;
tmp:Char;level:Byte;
begin
CurrLevel:=0;
CurrPos:=0;
Push('#',0);
for i:= 1 to Length(S) do
begin
case S[i] of
'+','-','*','/','^':
begin
Result:=Result+SplitFlag;
if TestPop(S[i]) then
Push(S[i],GetOpratorIndex(S[i])+CurrLevel)
else
begin
While not TestPop(S[i]) do
Result:=Result+Pop(level)+SplitFlag;
Push(S[i],GetOpratorIndex(S[i])+CurrLevel);
end;
Continue;
end;
'(':begin
Inc(CurrLevel,4);
Continue;
end;
')':begin
Result:=Result+SplitFlag;
Dec(CurrLevel,4);
Continue;
end;
else
Result:=Result+S[i];
end;
end;
tmp:=Pop(level);
while tmp<>'#' do
begin
Result:=Result+SplitFlag+tmp+SplitFlag;
tmp:=Pop(level);
end;
end;
function isDigit(S:string):Boolean;
begin
Result:=True;
if (S='+')or (S='-') or (S='*') or (S='/') or (S='^') then
Result:=False;
end;
function Calculate(S:string):Real;
var
StrList:TStringList;
i:Integer;
tmp:string;
xr1,xr2:Real;
begin
StrList:=TStringList.Create;
CurrPos:=0;
try
StrList.Text:=S;
for i := 0 to StrList.Count-1 do
begin
if Trim(StrList[i])='' then
Continue;
if isDigit(StrList[i]) then
PushEx(StrToFloat(StrList[i]))
else
begin
tmp:=StrList[i];
case Char(tmp[1]) of
'+':begin
xr1:=PopEx();
xr2:=PopEx();
xr1:=xr1+xr2;
PushEx(xr1);
end;
'-':begin
xr1:=PopEx();
xr2:=PopEx();
xr1:=xr2-xr1;
PushEx(xr1);
end;
'*':begin
xr1:=PopEx();
xr2:=PopEx();
xr1:=xr1*xr2;
PushEx(xr1);
end;
'/':begin
xr1:=PopEx();
xr2:=PopEx();
xr1:=xr2/xr1;
PushEx(xr1);
end;
'^':begin
xr1:=PopEx();
xr2:=PopEx();
xr1:=Power(xr2,xr1);
PushEx(xr1);
end;
end;
end;
end;
Result:=PopEx;
finally
StrList.Free;
end;
end;
var
input:array [0..MaxArray] of Char;
begin
try
{ TODO -oUser -cConsole Main : Insert code here }
Writeln('输入算术表达式：');
Readln(input);
if StrPas(input)<>'' then
Writeln('运算结果：'+format('%f',[Calculate(depoland(input))]));
Writeln('');
Writeln('按回车键退出');
Readln(input);
except
on E:Exception do
Writeln(E.Classname, ': ', E.Message);
end;
end.
支持()运算级，+-*/四则运算，还支持^指数运算，通过对这个例子的扩展，可以支持更多的运算类型，也可以将程序逻辑之类的也做后缀处理，这样就可以写出简单的解析器了，呵呵 希望对大家有用。（已经修改好了同优先级运算符右结合的问题了）
下面这个采用的是EBNF表示法来求表达式的值。
{*******************************************************}
{ }
{ Expression Calculate }
{ }
{ 版权所有 (C) 2003-2008 }
{ }
{*******************************************************}
unit CalcUnit;
{===============================================================================
* 软件名称：demo /Expression2
* 单元名称：表达式计算demo2
* 单元作者：涂飞平
* 备 注：2008-10-26
* 开发平台：PWin2000SP4 + Delphi 11
===============================================================================}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TCalcForm = class(TForm)
calcbtn: TButton;
exitbtn: TButton;
expressionmmo: TMemo;
resultedt: TEdit;
toplbl: TLabel;
centerlbl: TLabel;
procedure exitbtnClick(Sender: TObject);
procedure calcbtnClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TCalculation=class
private
FCurrPos:Integer;
FExpression:string;
protected
function getToken:string;
function Match(S:string):Boolean;
function _Expression():Real;
function Term():Real;
function Pow():Real;
function Factor():Real;
public
constructor Create(aStr:string='');
destructor Destroy;override;
function Calculate:Real;
property Expression:string read FExpression write FExpression;
end;
var
CalcForm: TCalcForm;
implementation
uses Math;
{$R *.dfm}
const spaceset = ['+','-','*','/','(',')','^'];
procedure TCalcForm.calcbtnClick(Sender: TObject);
var
calcobj:TCalculation;
begin
if expressionmmo.Text='' then Exit;
calcobj:=TCalculation.Create(expressionmmo.Text);
try
resultedt.Text:=Format('%f' ,[calcobj.Calculate()]);
finally
calcobj.Free();
end;
end;
procedure TCalcForm.exitbtnClick(Sender: TObject);
begin
Close();
end;
{ TCalculation }
constructor TCalculation.Create(aStr: string='');
begin
FCurrPos:=1;
FExpression:=aStr;
end;
destructor TCalculation.Destroy;
begin
inherited Destroy;
end;
function TCalculation.Calculate: Real;
begin
Result:=0;
if FExpression='' then Exit;
FCurrPos:=1;
Result:=_Expression();
end;
function TCalculation.getToken: string;
var
i,ipos:integer;
begin
ipos:=Fcurrpos;
Result:='';
for i :=0 to 100 do
begin
if Result='' then
begin
if FExpression[ipos+i] in spaceset then
begin
Result:=FExpression[ipos+i];
Exit;
end;
end;
if ipos+i>Length(FExpression) then
Exit;
if FExpression[ipos+i] in spaceset then
Exit;
Result:=Result+FExpression[ipos+i];
end;
end;
function TCalculation.Match(S: string): Boolean;
begin
if getToken()<>S then
raise Exception.Create('Match error.');
Fcurrpos:=Fcurrpos+Length(S);
end;
function TCalculation._Expression: Real;
var
tmp:Real;
begin
tmp:=Term();
while (getToken()='+') or (getToken()='-') do
begin
if getToken()='+' then
begin
Match('+');
tmp:=tmp+Term();
end
else if getToken()='-' then
begin
Match('-');
tmp:=tmp-Term();
end;
end;
Result:=tmp;
end;
function TCalculation.Term: Real;
var
tmp:Real;
begin
tmp:=Pow();
while (getToken()='*') or (getToken()='/') do
begin
if getToken()='*' then
begin
Match('*');
tmp:=tmp*Pow();
end
else if getToken()='/' then
begin
Match('/');
tmp:=tmp/Pow();
end;
end;
Result:=tmp;
end;
function TCalculation.Pow: Real;
var
tmp:Real;
begin
tmp:=Factor();
while (getToken()='^') do
begin
if getToken()='^' then
begin
Match('^');
tmp:=Power(tmp,Factor());
end;
end;
Result:=tmp;
end;
function TCalculation.Factor: Real;
var
tmp:Real;
str:string;
begin
if getToken()='(' then
begin
Match('(');
tmp:=_Expression();
Match(')');
end
else
begin
str:=getToken();
tmp:=StrToFloat(str);
Match(str);
end;
Result:=tmp;
end;
end.
