如何做数学表达式的解析？UP有分(300分)

如何做一个数学表达式的解析？
没有学过“编译原理”，希望能都到大家的指点，能从解析原理上给我讲一讲
例如： a*（b+c）+(a*b)/c+200

UP有分

有两种方法，一是建立二叉树，一是用堆栈。我原来试过，后者简单一些

如何用堆栈的方法？

用堆栈
字符优先级

看看编译原理吧！ 以下是一个实现了的
数学表达式的解析， 可以处理 +-*/^() 函数，自定义函数

unit JvParsing;

interface

uses
SysUtils, Classes, JvTypes;

type
TParserFunc = (pfArcTan, pfCos, pfSin, pfTan, pfAbs, pfExp, pfLn, pfLog,
pfSqrt, pfSqr, pfInt, pfFrac, pfTrunc, pfRound, pfArcSin, pfArcCos,
pfSign, pfNot);
EJvParserError = class(EJVCLException);
{$IFDEF WIN32}
TUserFunction = function(Value: Extended): Extended;
{$ELSE}
TUserFunction = Pointer;
{$ENDIF}

TJvMathParser = class(TObject)
private
FCurPos: Cardinal;
FParseText: string;
function GetChar: Char;
procedure NextChar;
function GetNumber(var AValue: Extended): Boolean;
function GetConst(var AValue: Extended): Boolean;
function GetFunction(var AValue: TParserFunc): Boolean;
function GetUserFunction(var Index: Integer): Boolean;
function Term: Extended;
function SubTerm: Extended;
function Calculate: Extended;
public
function Exec(const AFormula: string): Extended;
class procedure RegisterUserFunction(const Name: string
Proc:
TUserFunction);
class procedure UnregisterUserFunction(const Name: string);
end;

function GetFormulaValue(const Formula: string): Extended;

{$IFNDEF WIN32}
function Power(Base, Exponent: Extended): Extended;
{$ENDIF}

implementation

uses JvTConst;

const
SpecialChars = [#0..' ', '+', '-', '/', '*', ')', '^'];

FuncNames: array[TParserFunc] of PChar =
('ARCTAN', 'COS', 'SIN', 'TAN', 'ABS', 'EXP', 'LN', 'LOG',
'SQRT', 'SQR', 'INT', 'FRAC', 'TRUNC', 'ROUND', 'ARCSIN', 'ARCCOS',
'SIGN', 'NOT');

{ Parser errors }

procedure InvalidCondition(Str: Word);
begin
raise EJvParserError.Create(LoadStr(Str));
end;

{ IntPower and Power functions are copied from Borland's MATH.PAS unit }

function IntPower(Base: Extended
Exponent: Integer): Extended;
{$IFDEF WIN32}
asm
mov ecx, eax
cdq
fld1 { Result := 1 }
xor eax, edx
sub eax, edx { eax := Abs(Exponent) }
jz @@3
fld Base
jmp @@2
@@1: fmul ST, ST { X := Base * Base }
@@2: shr eax,1
jnc @@1
fmul ST(1),ST { Result := Result * X }
jnz @@1
fstp st { pop X from FPU stack }
cmp ecx, 0
jge @@3
fld1
fdivrp { Result := 1 / Result }
@@3:
fwait
end;
{$ELSE}
var
Y: Longint;
begin
Y := Abs(Exponent);
Result := 1.0;
while Y > 0 do
begin
while not Odd(Y) do
begin
Y := Y shr 1;
Base := Base * Base;
end;
Dec(Y);
Result := Result * Base;
end;
if Exponent < 0 then
Result := 1.0 / Result;
end;
{$ENDIF WIN32}

function Power(Base, Exponent: Extended): Extended;
begin
if Exponent = 0.0 then
Result := 1.0
else if (Base = 0.0) and (Exponent > 0.0) then
Result := 0.0
else if (Frac(Exponent) = 0.0) and (Abs(Exponent) <= MaxInt) then
Result := IntPower(Base, Trunc(Exponent))
else
Result := Exp(Exponent * Ln(Base))
end;

{ User defined functions }

type
{$IFDEF WIN32}
TFarUserFunction = TUserFunction;
{$ELSE}
TFarUserFunction = function(Value: Extended): Extended;
{$ENDIF}

var
UserFuncList: TStrings;

function GetUserFuncList: TStrings;
begin
if not Assigned(UserFuncList) then
begin
UserFuncList := TStringList.Create;
with TStringList(UserFuncList) do
begin
Sorted := True;
Duplicates := dupIgnore;
end;
end;
Result := UserFuncList;
end;

procedure FreeUserFunc
far;
begin
UserFuncList.Free;
UserFuncList := nil;
end;

{ Parsing routines }

function GetFormulaValue(const Formula: string): Extended;
begin
with TJvMathParser.Create do
try
Result := Exec(Formula);
finally
Free;
end;
end;

{ TJvMathParser }

function TJvMathParser.GetChar: Char;
begin
Result := FParseText[FCurPos];
end;

procedure TJvMathParser.NextChar;
begin
Inc(FCurPos);
end;

function TJvMathParser.GetNumber(var AValue: Extended): Boolean;
var
C: Char;
SavePos: Cardinal;
Code: Integer;
IsHex: Boolean;
TmpStr: string;
begin
Result := False;
C := GetChar;
SavePos := FCurPos;
TmpStr := '';
IsHex := False;
if C = '$' then
begin
TmpStr := C;
NextChar;
C := GetChar;
while C in ['0'..'9', 'A'..'F', 'a'..'f'] do
begin
TmpStr := TmpStr + C;
NextChar;
C := GetChar;
end;
IsHex := True;
Result := (Length(TmpStr) > 1) and (Length(TmpStr) <= 9);
end
else if C in ['+', '-', '0'..'9', '.', DecimalSeparator] then
begin
if (C in ['.', DecimalSeparator]) then
TmpStr := '0' + '.'
else
TmpStr := C;
NextChar;
C := GetChar;
if (Length(TmpStr) = 1) and (TmpStr[1] in ['+', '-']) and
(C in ['.', DecimalSeparator]) then
TmpStr := TmpStr + '0';
while C in ['0'..'9', '.', 'E', 'e', DecimalSeparator] do
begin
if C = DecimalSeparator then
TmpStr := TmpStr + '.'
else
TmpStr := TmpStr + C;
if (C = 'E') then
begin
if (Length(TmpStr) > 1) and (TmpStr[Length(TmpStr) - 1] = '.') then
Insert('0', TmpStr, Length(TmpStr));
NextChar;
C := GetChar;
if (C in ['+', '-']) then
begin
TmpStr := TmpStr + C;
NextChar;
end;
end
else
NextChar;
C := GetChar;
end;
if (TmpStr[Length(TmpStr)] = '.') and (Pos('E', TmpStr) = 0) then
TmpStr := TmpStr + '0';
Val(TmpStr, AValue, Code);
Result := (Code = 0);
end;
Result := Result and (FParseText[FCurPos] in SpecialChars);
if Result then
begin
if IsHex then
AValue := StrToInt(TmpStr)
{ else AValue := StrToFloat(TmpStr) };
end
else
begin
AValue := 0;
FCurPos := SavePos;
end;
end;

function TJvMathParser.GetConst(var AValue: Extended): Boolean;
begin
Result := False;
case FParseText[FCurPos] of
'E':
if FParseText[FCurPos + 1] in SpecialChars then
begin
AValue := Exp(1);
Inc(FCurPos);
Result := True;
end;
'P':
if (FParseText[FCurPos + 1] = 'I') and
(FParseText[FCurPos + 2] in SpecialChars) then
begin
AValue := Pi;
Inc(FCurPos, 2);
Result := True;
end;
end
end;

function TJvMathParser.GetUserFunction(var Index: Integer): Boolean;
var
TmpStr: string;
I: Integer;
begin
Result := False;
if (FParseText[FCurPos] in ['A'..'Z', 'a'..'z', '_']) and
Assigned(UserFuncList) then
begin
with UserFuncList do
for I := 0 to Count - 1 do
begin
TmpStr := Copy(FParseText, FCurPos, Length(Strings));
if (CompareText(TmpStr, Strings) = 0) and
(Objects <> nil) then
begin
if FParseText[FCurPos + Cardinal(Length(TmpStr))] = '(' then
begin
Result := True;
Inc(FCurPos, Length(TmpStr));
Index := I;
Exit;
end;
end;
end;
end;
Index := -1;
end;

function TJvMathParser.GetFunction(var AValue: TParserFunc): Boolean;
var
I: TParserFunc;
TmpStr: string;
begin
Result := False;
AValue := Low(TParserFunc);
if FParseText[FCurPos] in ['A'..'Z', 'a'..'z', '_'] then
begin
for I := Low(TParserFunc) to High(TParserFunc) do
begin
TmpStr := Copy(FParseText, FCurPos, StrLen(FuncNames));
if CompareText(TmpStr, StrPas(FuncNames)) = 0 then
begin
AValue := I;
if FParseText[FCurPos + Cardinal(Length(TmpStr))] = '(' then
begin
Result := True;
Inc(FCurPos, Length(TmpStr));
Break;
end;
end;
end;
end;
end;

function TJvMathParser.Term: Extended;
var
Value: Extended;
NoFunc: TParserFunc;
UserFunc: Integer;
Func: Pointer;
begin
if FParseText[FCurPos] = '(' then
begin
Inc(FCurPos);
Value := Calculate;
if FParseText[FCurPos] <> ')' then
InvalidCondition(SParseNotCramp);
Inc(FCurPos);
end
else
begin
if not GetNumber(Value) then
if not GetConst(Value) then
if GetUserFunction(UserFunc) then
begin
Inc(FCurPos);
Func := UserFuncList.Objects[UserFunc];
Value := TFarUserFunction(Func)(Calculate);
if FParseText[FCurPos] <> ')' then
InvalidCondition(SParseNotCramp);
Inc(FCurPos);
end
else if GetFunction(NoFunc) then
begin
Inc(FCurPos);
Value := Calculate;
try
case NoFunc of
pfArcTan: Value := ArcTan(Value);
pfCos: Value := Cos(Value);
pfSin: Value := Sin(Value);
pfTan:
if Cos(Value) = 0 then
InvalidCondition(SParseDivideByZero)
else
Value := Sin(Value) / Cos(Value);
pfAbs: Value := Abs(Value);
pfExp: Value := Exp(Value);
pfLn:
if Value <= 0 then
InvalidCondition(SParseLogError)
else
Value := Ln(Value);
pfLog:
if Value <= 0 then
InvalidCondition(SParseLogError)
else
Value := Ln(Value) / Ln(10);
pfSqrt:
if Value < 0 then
InvalidCondition(SParseSqrError)
else
Value := Sqrt(Value);
pfSqr: Value := Sqr(Value);
pfInt: Value := Round(Value);
pfFrac: Value := Frac(Value);
pfTrunc: Value := Trunc(Value);
pfRound: Value := Round(Value);
pfArcSin:
if Value = 1 then
Value := Pi / 2
else
Value := ArcTan(Value / Sqrt(1 - Sqr(Value)));
pfArcCos:
if Value = 1 then
Value := 0
else
Value := Pi / 2 - ArcTan(Value / Sqrt(1 - Sqr(Value)));
pfSign:
if Value > 0 then
Value := 1
else if Value < 0 then
Value := -1;
pfNot: Value := not Trunc(Value);
end;
except
on E: EJvParserError do
raise
else
InvalidCondition(SParseInvalidFloatOperation);
end;
if FParseText[FCurPos] <> ')' then
InvalidCondition(SParseNotCramp);
Inc(FCurPos);
end
else
InvalidCondition(SParseSyntaxError);
end;
Result := Value;
end;

function TJvMathParser.SubTerm: Extended;
var
Value: Extended;
begin
Value := Term;
while FParseText[FCurPos] in ['*', '^', '/'] do
begin
Inc(FCurPos);
if FParseText[FCurPos - 1] = '*' then
Value := Value * Term
else if FParseText[FCurPos - 1] = '^' then
Value := Power(Value, Term)
else if FParseText[FCurPos - 1] = '/' then
try
Value := Value / Term;
except
InvalidCondition(SParseDivideByZero);
end;
end;
Result := Value;
end;

function TJvMathParser.Calculate: Extended;
var
Value: Extended;
begin
Value := SubTerm;
while FParseText[FCurPos] in ['+', '-'] do
begin
Inc(FCurPos);
if FParseText[FCurPos - 1] = '+' then
Value := Value + SubTerm
else
Value := Value - SubTerm;
end;
if not (FParseText[FCurPos] in [#0, ')', '>', '<', '=', ',']) then
InvalidCondition(SParseSyntaxError);
Result := Value;
end;

function TJvMathParser.Exec(const AFormula: string): Extended;
var
I, J: Integer;
begin
J := 0;
Result := 0;
FParseText := '';
for I := 1 to Length(AFormula) do
begin
case AFormula of
'(': Inc(J);
')': Dec(J);
end;
if AFormula > ' ' then
FParseText := FParseText + UpCase(AFormula);
end;
if J = 0 then
begin
FCurPos := 1;
FParseText := FParseText + #0;
if (FParseText[1] in ['-', '+']) then
FParseText := '0' + FParseText;
Result := Calculate;
end
else
InvalidCondition(SParseNotCramp);
end;

class procedure TJvMathParser.RegisterUserFunction(const Name: string;
Proc: TUserFunction);
var
I: Integer;
begin
if (Length(Name) > 0) and (Name[1] in ['A'..'Z', 'a'..'z', '_']) then
begin
if not Assigned(Proc) then
UnregisterUserFunction(Name)
else
begin
with GetUserFuncList do
begin
I := IndexOf(Name);
if I < 0 then
I := Add(Name);
{$IFDEF WIN32}
Objects := @Proc;
{$ELSE}
Objects := Proc;
{$ENDIF}
end;
end;
end
else
InvalidCondition(SParseSyntaxError);
end;

class procedure TJvMathParser.UnregisterUserFunction(const Name: string);
var
I: Integer;
begin
if Assigned(UserFuncList) then
with UserFuncList do
begin
I := IndexOf(Name);
if I >= 0 then
Delete(I);
if Count = 0 then
FreeUserFunc;
end;
end;

initialization
UserFuncList := nil;
{$IFDEF WIN32}
finalization
FreeUserFunc;
{$ELSE}
AddExitProc(FreeUserFunc);
{$ENDIF}
end.

能详细点么？

能详细点么？

to xuri:这是RX的PAS么。
我更想知道原理,

1。 自己看源代码，结合 编译原理中 的 正则表达式
2。 打开 Delphi 的调试器， 单步执行，看看解析过程

靠，这么长的代码拿来吓人呀
还有汇编，
给他思路就是了，这种冗长的代码简直就是垃圾，还不如我当年的C++代码呢

一个DLL,用来接收函数表达式和变量值,并返回函数值
如: result:= fun('sin(x)*exp(x)',0.1);


library fun;
uses
sharemem,
SysUtils,
StdCtrls,
math;
function rapidstrtofun(s:string;x:double):double;
var
posi:array[1..50]of integer;
data:array[1..50]of double;
mulsign,plusign:array[1..50]of char;
muldev,addmin:array[1..50]of integer;
{point to the position of data,index of data}
n,n2,n3:integer;
len,i,j:integer;
s1:string;
begin
s:=lowercase(s);
len:=length(s);
if len=1 then
begin
if s='x' then begin result:=x;exit;end;
result:=strtofloat(s);exit;
end;
n:=0;{number of operater=n2+n3}
n2:=0;{number of * and /}
n3:=0;{number of + and -}
{find out the operater}
for i:=2 to len do begin
case s of
'*':
begin
inc;inc(n2);mulsign[n2]:='*';muldev[n2]:=n;
posi[n]:=i;
end;
'/':
begin
inc;inc(n2);mulsign[n2]:='/';muldev[n2]:=n;
posi[n]:=i;
end;
'+':
if (s[i-1]<>'e')=true then
begin
inc;inc(n3);plusign[n3]:='+';addmin[n3]:=n;
posi[n]:=i;
end;
'-':
if (s[i-1]<>'e')=true then
begin
inc;inc(n3);plusign[n3]:='-';addmin[n3]:=n;
posi[n]:=i;
end;
end;
end;
{pick out the data}
if n=0 then begin result:=strtofloat(s);exit;end;
s1:='';
for i:=1 to posi[1]-1 do begin
s1:=s1+s;
end;

if s1='x' then data[1]:=x
else if s1='-x' then data[1]:=-x
else data[1]:=strtofloat(s1);

for i:=1 to n-1 do begin
s1:='';
for j:=posi+1 to posi[i+1]-1 do begin
s1:=s1+s[j];
end;
if s1='x' then data:=x
else data[i+1]:=strtofloat(s1);
end;
s1:='';
for i:=posi[n]+1 to len do begin
s1:=s1+s;
end;
if s1='x' then data[n+1]:=x
else data[n+1]:=strtofloat(s1);
{calculate * and /}
for i:=1 to n2 do begin
if mulsign='*' then
data[muldev+1]:=data[muldev]*data[muldev+1]
else
data[muldev+1]:=data[muldev]/data[muldev+1];
end;
for i:=1 to n3-1 do begin
if plusign='+' then
data[addmin[1]]:=data[addmin[1]]+data[addmin[i+1]]
else
data[addmin[1]]:=data[addmin[1]]-data[addmin[i+1]];
end;
if n3=0 then result:=data[n2+1]
else result:=data[1]+data[n+1];
end;

function brackets(s:string;x:double):double;register;
var
s0,s1:string;
time:integer;
i,j,k,order,l0:integer;
med:double;
med1,value2:double;
value1:integer;
count:array[1..1000]of integer;
judge:boolean;
Label line1;
begin
line1: order:=pos('((',s);
if(order>0)then begin
insert('1*',s,order+1);
goto line1;
end;
time:=0;
s0:=s;
judge:=false;
l0:=length(s);
for i:=1 to l0 do
begin
if(s='(')then time:=time+1;
end;
if(time=0)then judge:=true;
if(time>0)then
begin
for i:=1 to time do
begin
j:=0;
for order:=1 to l0 do
begin
if((s[order]='(')=true)or((s[order]=')')=true)then
begin
j:=j+1;
count[j]:=order;
end;
end;
for k:=1 to j-1 do
begin
if(((s[count[k]]='(')=true)and
((s[count[k+1]]=')')=true))then
begin
order:=count[k]
{keep the location of ( }
break;
end;
end;
if(order=1)then begin
delete(s,count[k+1],l0-count[k+1]+1);
delete(s,1,count[k]);
med:=rapidstrtofun(s,x);
s1:=floattostr(med);
s:=s0;
delete(s,count[k],count[k+1]-count[k]+1);
insert(s1,s,count[k]);
s0:=s;
l0:=length(s);
end
else
begin
if(((s[count[k]-1]='*')=true)or((s[count[k]-1]='/')=true)or
((s[count[k]-1]='+')=true)or((s[count[k]-1]='-')=true))then begin
delete(s,count[k+1],l0-count[k+1]+1);
delete(s,1,count[k]);
med:=rapidstrtofun(s,x);
s:=s0;
s1:=floattostr(med);
delete(s,count[k],count[k+1]-count[k]+1);
insert(s1,s,count[k]);
s0:=s;
l0:=length(s);
continue;
end;

if(s[count[k]-1]='p')then begin
delete(s,count[k+1],l0-count[k+1]+1);
delete(s,1,count[k]);
med:=rapidstrtofun(s,x);
med:=exp(med);
s1:=floattostr(med);
s:=s0;
delete(s,count[k]-3,count[k+1]-count[k]+4);
insert(s1,s,count[k]-3);
s0:=s;
l0:=length(s);
continue;
end;

if(s[count[k]-1]='g')then begin
delete(s,count[k+1],l0-count[k+1]+1);
delete(s,1,count[k]);
med:=rapidstrtofun(s,x);
s:=s0;
if(s[count[k]-2]='l')then begin
med:=Log10(med);
s:=s0;
s1:=floattostr(med);
delete(s,count[k]-2,count[k+1]-count[k]+3);
insert(s1,s,count[k]-2);
s0:=s;
l0:=length(s);
end
else begin
if(s[count[k]-2]='t')then begin
delete(s,count[k]-2,l0-count[k]+3);
if((s='')=false)then begin
if(s[count[k]-3]='c')then
begin
med:=cotan(med);
s:=s0;
s1:=floattostr(med);
delete(s,count[k]-3,count[k+1]-count[k]+4);
insert(s1,s,count[k]-3);
s0:=s;
l0:=length(s);
end
else begin
med:=tan(med);
s:=s0;
s1:=floattostr(med);
delete(s,count[k]-2,count[k+1]-count[k]+3);
insert(s1,s,count[k]-2);
s0:=s;
l0:=length(s);
end;
end
else
begin
med:=tan(med);
s:=s0;
s1:=floattostr(med);

delete(s,count[k]-2,count[k+1]-count[k]+3);
insert(s1,s,count[k]-2);
s0:=s;
l0:=length(s);
end;
end;
end;
continue;
end;
if(s[count[k]-1]='^')then begin
value1:=pos(',',s);
delete(s,count[k+1],l0-count[k+1]+1);
delete(s,1,value1);
value2:=rapidstrtofun(s,x);
s:=s0;
delete(s,value1,l0-value1+1);
delete(s,1,count[k]);
med1:=rapidstrtofun(s,x);
med:=power(med1,value2);
s:=s0;
s1:=floattostr(med);
delete(s,count[k]-1,count[k+1]-count[k]+2);
insert(s1,s,count[k]-1);
s0:=s;
l0:=length(s);
continue;
end;
if(s[count[k]-1]='s')then begin
delete(s,count[k+1],l0-count[k+1]+1);
delete(s,1,count[k]);
med:=rapidstrtofun(s,x);
med:=cos(med);
s:=s0;
s1:=floattostr(med);
delete(s,count[k]-3,count[k+1]-count[k]+4);
insert(s1,s,count[k]-3);
s0:=s;
l0:=length(s);
continue;
end;
if(s[count[k]-1]='h')then begin
delete(s,count[k+1],l0-count[k+1]+1);
delete(s,1,count[k]);
med:=rapidstrtofun(s,x);
s:=s0;
if(s[count[k]-2]='s')then begin
med:=cosh(med);
end
else begin
med:=sinh(med);
end;
s:=s0;
s1:=floattostr(med);
delete(s,count[k]-4,count[k+1]-count[k]+5);
insert(s1,s,count[k]-4);
s0:=s;
l0:=length(s);
continue;
end;
if(s[count[k]-1]='t')then begin
delete(s,count[k+1],l0-count[k+1]+1);
delete(s,1,count[k]);
med:=rapidstrtofun(s,x);
med:=sqrt(med);
s:=s0;
s1:=floattostr(med);
delete(s,count[k]-4,count[k+1]-count[k]+5);
insert(s1,s,count[k]-4);
s0:=s;
l0:=length(s);
continue;
end;
if(s[count[k]-1]='r')then begin
delete(s,count[k+1],l0-count[k+1]+1);
delete(s,1,count[k]);
med:=rapidstrtofun(s,x);
med:=sqr(med);
s:=s0;
s1:=floattostr(med);
delete(s,count[k]-3,count[k+1]-count[k]+4);
insert(s1,s,count[k]-3);
s0:=s;
l0:=length(s);
continue;
end;
if(s[count[k]-1]='n')then begin
delete(s,count[k+1],l0-count[k+1]+1);
delete(s,1,count[k]);
med:=rapidstrtofun(s,x);
s:=s0;
if(s[count[k]-2]='l')then begin
med:=ln(med);
s:=s0;
s1:=floattostr(med);
delete(s,count[k]-2,count[k+1]-count[k]+3);
insert(s1,s,count[k]-2);
s0:=s;
l0:=length(s);
end
else begin
med:=sin(med);
s:=s0;
s1:=floattostr(med);
delete(s,count[k]-3,count[k+1]-count[k]+4);
insert(s1,s,count[k]-3);
s0:=s;
l0:=length(s);
end;
continue;
end;
end;
end;
brackets:=rapidstrtofun(s,x);
end;

if(judge=true)then brackets:=rapidstrtofun(s,x);
end;
exports
brackets name 'fun';
begin
end.

来如风：
我只是提供一种可用的代码， 互相学习嘛，你没有必要那么激动
如果你觉得你的能力不错，那你就讲出你的思路？？[?]

大家到这里无非是学习进步，解析源码我也有，可惜看不懂，我想得到各位仁兄的帮助，把
它搞明白，所以我想知道基础一些的

到这里找一找,绝对不让你失望
http://www.playicq.com/fold.php?t=27&amp;id=79&amp;Folder_name=算法大全

算符优先法。建立算符优先表
+ - * / ( )
+ > > < < < >
- > > < < < >
* > > > > < >
/ > > > > < >
( < < < < < <
) > > > > ！ >

（）下班了待续。
continue:
算法描述 （伪pascal）
begin
初始化数字栈；
初始化符号栈；
符号栈压入结束符；
while 取单词<>结束符 do
begin
if 单词=数字 then
单词进数字栈；
if 单词=运算符号 then
case 比较优先级（符号栈顶元素，当前单词）of
>：计算表达式（数字出栈，数字出栈，当前运算符{即当前单词}）；计算结果进数字栈；continue；
<：运算符号进符号栈 ；continue；
!：表达式错；
end；
end;
end;

网上有现成的代码，你自己去找吧

我有一个这方面的组件
oldplantegg@163.com

二叉树容易理解，画出来比较直观

EForumLib上有控件，网址我想不起来了

DevExpress EForumLib v1.3 / Serial : DCTGJKMPEQNTCM
http://www.devexpress.com