四则运算(50分)

我想计算一个用户从Edit中输入的字符串，如 1+5*10（3+4）
怎样能把这个字符串转成表达式并计算出结果哪？

这是来自<a href="http://vcl.vclxx.com/delphigb">深度历险</a>的一组控件，试试看：

<font color="#000000">计算器类</font>

<font color="#000000"><a href="http://vcl.vclxx.com/DELPHI/D32FREE/4FCALC.ZIP">4FCALC.ZIP</a></font>
<p><font color="#000000">提供加减乘除四则运算的机算器 ( Calculator ) 构件( 附源码 )，作者: Leng Vang。</font>
<p><font color="#000000"><a href="http://vcl.vclxx.com/DELPHI/D32FREE/CALC.ZIP">CALC.ZIP</a></font>
<p><font color="#000000">代数算术式的计算机 ( Algebraic Calculator ) 构件，可以自定变量
( Variables ) 及函数 ( Functions ) ( 1.0 版，无源码 Delphi 2.0 适用)，作者
: Gerrit van Niekerk 。</font>
<p><a href="http://vcl.vclxx.com/DELPHI/D32FREE/DICALC.ZIP">DICALC.ZIP</a>
<p><font color="#000000">一个除了一般四则运算外，更提供了可做次方、布耳代数等逻辑运算的计算机程序，并可以用十六进位、二进位方式显示
( 1.1 版，附源码)，作者 : Dmitry M. Ivlev。</font>
<p><font color="#000000"><a href="http://vcl.vclxx.com/DELPHI/D32FREE/EXECALC.ZIP">EXECALC.ZIP</a></font>
<p><font color="#000000">一个 14 位精确度的机算机构件 ( 1.02 版，附源码)。作者: ExEntryC。</font>

有很多这样带源码的控件
在深度历险里有一个

<a href="http://vcl.vclxx.com/DELPHI/D32FREE/PARSE91.ZIP" >PARSER91.ZIP </a>

TParser 构件是於运行时刻解析、转换数学算式的构件， 此版本修正了
内存未回收的 Bug ( 9.1 版，附源码 ) ，作者 : Alin Flaider。

使用方法很简单：

Parser1.X := 100;
Parser1.Y := 200;
Parser1.Variable['z'] := 20;
Parser1.Expression := 'sin(x)*cos+z';
Result := Parser1.Value;



<a href="http://vcl.vclxx.com/DELPHI/D32FREE/PARSESRC.ZIP" >PARSESRC.ZIP </a>

TExprCalc 构件能够解析数学运算式并且计算其值，修改自 Ron Loewy
的 PARSE.DLL ( 附源码 )，作者 : Stuart Hedges。

Haha, it's easy:
You can build two stack:
one for number, the other for operator +, -, *, /, etc.
scan the string from left to right,
if encounter number, then let it pushed into number stack.
if it is an operator, then you need comparing the previllege
of the operator that at the top of the operator stack. If you
current operator is equal or less important than that, you should
pop that operator, and calculate it, this means, use the numbers
stored in number stack, and push back the result into number stack.
Otherwise, you just push your operator into opeartor stack.

There is a mathlib which can do this work, if you like, I can mail
to you,

看来pegasus理解了我的意思，我原想如你所说的写一个函数。
既然有人写过，那就请您给我 E-mail 过来。
不胜感激！！

pegasus 请快把你的 mathlib寄来，我急用！谢谢！！！
我的E-mail: sundaysun@263.net

Hi!

I choose a simplest one for you. It's a control, but you can simple cut the source code, there's a function which can caculate.

I have sent to sundaysun@263.net and sundaywind@263.net,

Enjoy it!

unit Z_parser;
{ Mathematical function parser : converts string expression to numerical result
by Antonie Baars <d950021@icpc00.icpc.fukui-u.ac.jp>
version 1.0 , 8 January 1998
If running in IDE, put break on exception off !
}
interface
uses sysutils,stdctrls,classes;

TYPE
EparserError=class(Exception);
Rparameters= record x,y,z:extended; end;
Const parameter:Rparameters=(x:1;y:1;z:1);
TYPE

TZMathEdit=class(TEdit)
private
function getEvaluatedString:string;
public
property TextValue:string read getEvaluatedString;
end;

function EvaluateToFloat(s0:string):extended;
Function GetEvaluationError:string;
procedure Register;

implementation
const sopps:string=('+-*/^');
var EvaluationError:string;

procedure Register;
begin
RegisterComponents('Samples', [TZMathEdit]);
end;
function evaluate(s0:string):extended;forward;

procedure matchbracket(var i:integer;s0:string);
var j,len:integer;
begin j:=1;len:=length(s0);
repeat inc(i);
if i>len then raise EparserError.Create('missing '')''');
if s0='(' then inc(j);
if s0=')' then dec(j);
if j<0 then raise EparserError.Create('missing ''(''');
until j=0;
end;

function getvalue(s0:string):extended;
begin
if length(s0)<1 then raise EparserError.Create('syntax error');
if length(s0)=1 then result:=strtofloat(s0) else
case s0[1] of
'x':result:=parameter.x;
'y':result:=parameter.y;
'z':result:=parameter.z;
else result:=strtofloat(s0);
end;
end;

function specialF(p1:integer;s0:string):extended;
var operstr:string;arg:extended;
begin
operstr:=copy(s0,1,p1-1);
if s0[length(s0)]<>')' then EparserError.CreateFmt('incorrect syntax %s',[s0]);
arg:=evaluate(copy(s0,p1+1,length(s0)-p1-1));
if operstr ='sin' then result:=sin(arg)
else if operstr ='cos' then result:=cos(arg)
else if operstr ='tan' then result:=sin(arg)/cos(arg)
else if operstr ='arctan' then result:=arctan(arg)
else if operstr ='log' then result:=ln(arg)/ln(10)
else if operstr ='ln' then result:=ln(arg)
else if operstr ='exp' then result:=exp(arg)
else if operstr ='sqrt' then result:=sqrt(arg)
{enter additional functions here}
else raise EparserError.CreateFmt('unknown function %s',[s0]);
end;

function calculate(p1:integer;s0:string):extended;
var v1,v2:extended;
begin
v1:=evaluate(copy(s0,1,p1-1));
v2:=evaluate(copy(s0,p1+1,length(s0)-p1));
case s0[p1] of
'+': result:=v1+v2;
'-': result:=v1-v2;
'/': result:=v1/v2;
'*': result:=v1*v2;
'^': result:=exp(v2*ln(v1));
else raise EparserError.CreateFmt('invalid operation %s',[s0]);
end;
end;

function getfirstopp(tot:integer;s0:string):integer;
var i:integer;
begin
if tot=0 then tot:=length(s0);
for i:=1 to 5 do
begin
result:=pos(sopps,s0);
if ((i<3) and (result>0)) then
if ((result=1) or (pos(s0[result-1],sopps)>0)) then result:=0;
if result>0 then if result<tot then exit;
end;
if result>tot then result:=0;
end;

function evaluate(s0:string):extended;
var p1,p2,q1:integer;
begin
p1:=pos('(',s0);p2:=p1;
if p2>0 then matchbracket(p2,s0);
if p1=1 then begin
if p2=length(s0) then begin
delete(s0,p2,1);delete(s0,1,1);
result:=evaluate(s0);
end
else result:=calculate(p2+1,s0);
exit;
end; q1:=getfirstopp(p1,s0);
if (p1+q1=0) then begin
result:=getvalue(s0);
exit;
end;
if q1<>0 then result:=calculate(q1,s0)
else if length(s0)>p2 then result:=calculate(p2+1,s0)
else result:=specialF(p1,s0);
end;
procedure cleanup(var s0:string);
var i:integer;
begin
s0:=lowercase(s0);
i:=pos(' ',s0);while i>0 do begin delete(s0,i,1);i:=pos(' ',s0);end;
end;
function TZMathEdit.getevaluatedString:string;
var s0:string;
begin s0:=text;
TRY
cleanup(s0);
result:=floattostr(evaluate(s0));
EXCEPT
on e:exception do result:=e.message;
END;
end;

function evaluateToFloat(s0:string):extended;
begin
TRY
evaluationerror:='';
cleanup(s0);
result:=evaluate(s0);
EXCEPT
on e:exception do begin
evaluationerror:=e.message;
result:=0;
end;
END;
end;

Function GetEvaluationError:string;
begin
result:=evaluationerror;
end;

多人接受答案了。