怎么把字符串转成计算公式(50分)

在delphi中怎么把字符串转成计算公式啊？
我现在输入是s:='l1=l2+l3+l4'怎么把它转成表达式：l1=l2+l3+l4;又怎么存储它？？

我认为应当是一个简单问题，
但我不会，up

单元一：
(******************************************************************************
* parser *
* Modified by Stuart Hedges *
* Version 4.0, Sep 1996 *
* Ron Loewy, 1992. A mathematical recursive decent parser +-/*^ and functions *
* Version 3.0, Sep. 1994. *
******************************************************************************)
unit parser;

interface

uses Classes,SysUtils;

{$ifdef dll}
function GetExpr(s : PChar; var valid : Boolean) : double; export;
procedure ClearExprVars;export;
{$else}
function GetExpr(const s : string; var valid : Boolean) : double;
procedure ClearExprVars;
{$endif}


implementation

type
TokenType = (Delimiter,Non,variable,Digit,endExpr,Error,Func);
TokenPtr = ^TokenRec;
TokenRec = Record
Next : TokenPtr;
Start,Close : Byte;
end;

PValueRec = ^ValueRec;
ValueRec = Record
Name : String;
Value: Double;
End;

var
{parserErrStr : string; }
ErrAt : Byte;


var
macro : string;
i, m : byte;
ppText : string; { holds var of function .. }
VarList : TList;
VRec : PValueRec;
type
charSet = set of char;
const
seperators : charSet = [' ', #9, '/', ';', '*', '/', '^',
'+', '=', '-', '%', ')'];

(******************************************************************************)
{$IFDEF DLL}
procedure ClearExprVars;export;
{$ELSE}
procedure ClearExprVars;
{$ENDIF}
Var
i : Integer;
Begin
for i := 0 to VarList.Count-1 Do Begin
Dispose( VarList.Items );
VarList.Items := Nil;
End;
VarList.Pack;
End;
function GetVar(AVar:String)ValueRec;
Var
i : Integer;
Begin
AVar := UpperCase(AVar);
Result := Nil;
for i := 0 to VarList.Count-1 Do
if ( PValueRec(VarList.Items)^.Name = AVar ) Then Begin
Result := PValueRec(VarList.Items);
Break;
End;
if ( Result = Nil ) Then Begin
GetMem(Result,sizeof(ValueRec));
Result^.Name := AVar;
Result^.Value := 0;
VarList.Add(Result);
End;
End;
(******************************************************************************
* skipBlanks *
* skip blanks defined in the seperators variables, and update o *
******************************************************************************)
procedure skipBlanks(var s : string; var o : byte);
var
ls : byte;
const
seperators : charSet = [' ', #9];
begin
ls := length(S);
while((s[o] in seperators) and
(o <= ls)) do
inc(o);
end; {skipBlanks}

(******************************************************************************
* makeUpper *
* receive a string, and convert it to upper-case *
******************************************************************************)
function makeUpper(s : string) : string;
var
i : byte;
begin
for i := 1 to length(s) do
if (s in ['a' .. 'z']) then
s := upCase(s);
makeUpper := s;
end; {makeUpper}

(******************************************************************************
* readWord *
* Return the next word found from the current string, and updates the offset *
* variable. if mu is true, return the upper case word. *
******************************************************************************)
function readWord(var s : string; var o : byte; mu : boolean;
const seperators : charSet) : string;
var
v : string;
ls : byte;
begin
skipBlanks(s, o);
v := '';
ls := length(s);
while ((not (s[o] in seperators)) and
(o <= ls)) do begin
v := v + s[o];
inc(o);
end;
if (mu) then
v := makeUpper(v);
if ((v[length(v)] = #255) and (v <> #255)) then begin
v := copy(v, 1, length(v) - 1);
dec(o);
end;
readWord := v;
end; {readWord}

(******************************************************************************
* DoErr *
******************************************************************************)
procedure DoErr(var n : TokenType);
begin
n := Error;
ErrAt := i; {globl err pos}
end; {doErr}

(******************************************************************************
* doReadWord *
******************************************************************************)
function doReadWord : string;
var
WordIn : string;
begin
WordIn := '';
While (not(Macro in
[' ','/',';','*','/','^','+','=','-','%','(',')']))
and (i <= Length(Macro)) do
begin
WordIn := WordIn + UpCase(Macro);
Inc(i);
end;
doReadWord := WordIn;
end; {doreadWord}

(******************************************************************************
* ReadNumber *
******************************************************************************)
function ReadNumber : double;
var
Number : double;
Code : Integer;
StrNum : string;
begin
StrNum := doReadWord;
if StrNum[1] = '.' then StrNum := '0' + StrNum;
Val(StrNum,Number,Code);
if Code <> 0 then Number := 0;
ReadNumber := Number;
end; {readNumber}

procedure Level1(var AResult : double; var n : TokenType) ; forward;

(******************************************************************************
* getFuncOrVar *
******************************************************************************)
procedure getFuncOrVar(var n : tokenType);
begin
m := i;
ppText := readWord(macro, m, true, seperators);
if ((pos('(', ppText) <> 0) or (ppText = 'PI') or (ppText = 'E')) then
n := func
else
n := variable;
end; {getFuncOrVar}

(******************************************************************************
* GetToken *
******************************************************************************)
function GetToken : TokenType;
var
n : TokenType;
begin
SkipBlanks(macro, i);
if (Macro in ['+','-','/','*','=','^','%','(',')']) then
n := Delimiter
else if (Macro in ['0'..'9','.']) then
n := Digit
else if (Macro = ';') then
n := endExpr
else if (Macro in ['a'..'z','A'..'Z'])
then getFuncOrVar
else
n := Non;
GetToken := n;
end; {getToken}

(******************************************************************************
* MatchFunc *
******************************************************************************)
function MatchFunc(Match : string; var AResult : double; var n : TokenType) :
Boolean;
var
j : Byte;
begin
j := i; {restore i if no match}
if (doReadWord = Match) then begin
MatchFunc := True;
skipblanks(macro, i);
if (Macro <> '(') then DoErr
else begin
Inc(i);
n := GetToken;
Level1(AResult,n);
SkipBlanks(macro, i); {Reach closing parenthasis}
if Macro <> ')' then DoErr;
Inc(i);
SkipBlanks(macro, i);
end;
end else begin
MatchFunc := False;
i := j; {no Func Match, restore}
end;
end; {matchFunc}

(******************************************************************************
* MatchToken *
******************************************************************************)
function MatchToken(Match : string) : boolean;
var
j : byte;
begin
j := i;
if (doreadWord = match) then MatchToken := True
else begin
MatchToken := False;
i := j;
end; {else}
end; {matchToken}

(******************************************************************************
* doPI *
******************************************************************************)
function doPI(var r:double) : boolean;
begin
doPI := matchToken('PI');
r := pi;
end; {doPI}

(******************************************************************************
* doE *
******************************************************************************)
function doE(var r:double) : boolean;
begin
doE := matchToken('E');
r := exp(1.0);
end; {doE}

(******************************************************************************
* DoSin *
******************************************************************************)
function DoSin(var AResult : double; var n : TokenType) : Boolean;
var
r : Boolean;
begin
r := MatchFunc('SIN',AResult,n);
AResult := sin(AResult);
DoSin := r;
end; {doSin}

(******************************************************************************
* doRandom *
******************************************************************************)
function doRandom(var Aresult : double; var n : tokenType) : boolean;
var
r : boolean;
begin
r := matchFunc('RANDOM', Aresult, n);
Aresult := 0.0 + random(trunc(Aresult));
doRandom := r;
end; { doRandom }

(******************************************************************************
* doTrunc *
******************************************************************************)
function doTrunc(var AResult : double; var n : TokenType) : Boolean;
var
r : boolean;
begin
r := matchFunc('TRUNC', Aresult, n);
Aresult := 0.0 + trunc(Aresult);
doTrunc := r;
end; { doTrunc }

(******************************************************************************
* doRound *
******************************************************************************)
function doRound(var Aresult : double; var n : tokenType) : boolean;
var
r : boolean;
begin
r := matchFunc('ROUND', Aresult, n);
Aresult := 0.0 + round(Aresult);
doRound := r;
end; { doRound }


(******************************************************************************
* DoExp *
******************************************************************************)
function DoExp(var AResult : double; var n : TokenType) : Boolean;
var
r : Boolean;
begin
r := MatchFunc('EXP',AResult,n);
AResult := exp(AResult);
DoExp := r;
end; {doSin}

(******************************************************************************
* DoCos *
******************************************************************************)
function DoCos(var AResult : double; var n : TokenType) : Boolean;
var
r : Boolean;
begin
r := MatchFunc('COS',AResult,n);
AResult := cos(AResult);
DoCos := r;
end; {doCos}

(******************************************************************************
* DoLn *
******************************************************************************)
function DoLn(var AResult : Double; var n : TokenType) : Boolean;
var
r : Boolean;
begin
r := MatchFunc('LN',AResult,n);
if (AResult > 0.0) then AResult := ln(AResult)
else DoErr;
DoLn := r;
end; {doLn}

(******************************************************************************
* DoLog10 *
******************************************************************************)
function DoLog10(var AResult : Double; var n : TokenType) : Boolean;
var
r : Boolean;
begin
r := MatchFunc('LOG10',AResult,n);
if (AResult > 0.0) then AResult := ln(AResult)/ln(10.0)
else DoErr;
DoLog10 := r;
end; {doLog10}

(******************************************************************************
* DoLog2 *
******************************************************************************)
function DoLog2(var AResult : Double; var n : TokenType) : Boolean;
var
r : Boolean;
begin
r := MatchFunc('LOG2',AResult,n);
if (AResult > 0.0) then AResult := ln(AResult)/ln(2.0)
else DoErr;
DoLog2 := r;
end; {doLog2}

(******************************************************************************
* DoAbs *
******************************************************************************)
function DoAbs(var AResult : Double; var n : TokenType) : Boolean;
var
r : Boolean;
begin
r := MatchFunc('ABS',AResult,n);
AResult := Abs(AResult);
DoAbs := r;
end; {doAbs}

(******************************************************************************
* DoArcTan *
******************************************************************************)
function DoArcTan(var AResult : Double; var n : TokenType) : Boolean;
var
r : Boolean;
begin
r := MatchFunc('ARCTAN',AResult,n);
AResult := ArcTan(AResult);
DoArcTan := r;
end; {doArcTan}

(******************************************************************************
* DoSqr *
******************************************************************************)
function DoSqr(var AResult : Double; var n : TokenType) : Boolean;
var
r : Boolean;
begin
r := MatchFunc('SQR',AResult,n);
AResult := Sqr(AResult);
DoSqr := r;
end; {doSqr}

(******************************************************************************
* DoSqrt *
******************************************************************************)
function DoSqrt(var AResult : Double; var n : TokenType) : Boolean;
var
r : Boolean;
begin
r := MatchFunc('SQRT',AResult,n);
AResult := Sqrt(AResult);
DoSqrt := r;
end; {doSqrt}

(******************************************************************************
* DoTan *
******************************************************************************)
function DoTan(var AResult : Double; var n : TokenType) : Boolean;
var
r : Boolean;
begin
r := MatchFunc('TAN',AResult,n);
if ( cos(Aresult) <> 0 ) then
AResult := Sin(AResult) / cos(AResult)
else doErr;
DoTan := r;
end; {doTan}

(******************************************************************************
* DoCoTan *
******************************************************************************)
function DoCoTan(var AResult : Double; var n : TokenType) : Boolean;
var
r : Boolean;
begin
r := MatchFunc('COTAN',AResult,n);
if ( sin(Aresult) <> 0 ) then
AResult := cos(AResult) / sin(AResult)
else doErr;
DoCoTan := r;
end; {doCoTan}

(******************************************************************************
* DoArcSin *
******************************************************************************)
function DoArcSin(var AResult : Double; var n : TokenType) : Boolean;
var
r : Boolean;
begin
r := MatchFunc('ARCSIN',AResult,n);
if (abs(AResult) < 1.0) then
AResult := arcTan(AResult/sqrt(1-Aresult*Aresult))
else doErr;
DoArcSin := r;
end; {doArcSin}

(******************************************************************************
* DoArcCos *
******************************************************************************)
function DoArcCos(var AResult : Double; var n : TokenType) : Boolean;
var
r : Boolean;
begin
r := MatchFunc('ARCCOS',AResult,n);
if ((AResult <> 0.0) and (Aresult < 1.0)) then
AResult := arcTan(sqrt(1-Aresult*Aresult)/Aresult)
else doErr;
DoArcCos := r;
end; {doArcCos}

(******************************************************************************
* DoFunc *
******************************************************************************)
procedure DoFunc(var AResult : Double; var n : TokenType);
begin
case Macro of
's','S' : begin
if not(DoSin(AResult,n)) then
if not(DoSqr(AResult,n)) then
if not(DoSqrt(AResult,n)) then
DoErr;
end;
'c','C' : begin
if not(DoCos(AResult,n)) then
if not(DoCoTan(Aresult,n)) then
DoErr;
end;
'l','L' : begin
if not(DoLn(AResult,n)) then
if not(doLog10(Aresult,n)) then
if not(doLog2(Aresult,n)) then
DoErr;
end;
'a','A' : begin
if not(DoAbs(AResult,n)) then
if not(DoArcTan(AResult,n)) then
if not(doArcSin(AResult,n)) then
if not(doArcCos(Aresult,n))
then DoErr;
end;
'e','E' : begin
if not(DoExp(AResult,n)) then
if not(doE(Aresult)) then
DoErr;
end;
't','T' : begin
if not(doTan(Aresult,n)) then
if (not doTrunc(Aresult, n)) then
doErr;
end;
'p','P' : begin
if not(doPI(Aresult)) then
doErr;
end;
'r', 'R' : begin
if (not(doRandom(Aresult, n))) then
if (not doRound(Aresult, n)) then
doErr;
end; { 'r' }
else
DoErr;
end; {case}
end;

(******************************************************************************
* Primitive *
******************************************************************************)
procedure Primitive(var AResult : Double; var n : TokenType);
begin
if (n = variable) then begin
i := m;
VRec := GetVar(ppText);
AResult := VRec^.Value;
end else if (n = Digit) then
AResult := ReadNumber
else if (n = Func) then
DoFunc(AResult,n);
SkipBlanks(macro, i);
end;

(******************************************************************************
* Level6 *
* handle parenthasis *
******************************************************************************)
procedure Level6(var AResult : Double; var n : TokenType);
begin
if ((n = Delimiter) and (Macro = '(')) then begin
Inc(i);
n := GetToken;
Level1(AResult,n);
SkipBlanks(macro, i); {Reach closing parenthasis}
if (Macro <> ')') then
DoErr;
Inc(i);
SkipBlanks(macro, i);
end else
Primitive(AResult,n);
end; { level6}

(******************************************************************************
* Level5 *
******************************************************************************)
procedure Level5(var AResult : Double; var n : TokenType);
var
op : Char;
begin
if (i <= length(macro)) then
op := Macro
else
op := '#';
if (op in ['-','+']) then
Inc(i);
n := GetToken;
Level6(AResult,n);
if (op = '-') then
AResult := - (AResult);
end; { level5 }

(******************************************************************************
* Sign *
* returns -1 if num < 0, 1 otherwise *
******************************************************************************)
function Sign(Number : Double) : Double;
begin
if (Number < 0.0) then Sign := -1.0
else Sign := 1.0;
end; { sign }

(******************************************************************************
* Level4 *
******************************************************************************)
procedure Level4(var AResult : Double; var n : TokenType);
var
Hold : Double;
begin
Level5(AResult,n);
if (n <> Error) then
if (macro = '^') then begin
Inc(i);
n := GetToken;
Level4(Hold,n);
if (AResult = 0.0) then
if (hold = 0.0) then
AResult := 1.0
else
AResult := 0.0
else
AResult := Sign(AResult) * Exp(Hold * Ln(Abs(AResult)));
SkipBlanks(macro, i);
end; { case of ^ }
end; {level4}

(******************************************************************************
* Level3 *
* handle multiply/divide *
******************************************************************************)
procedure Level3(var AResult : Double; var n : TokenType);
var
Hold : Double;
op : Char;
begin
Level4(AResult,n);
if (n <> Error) then begin
SkipBlanks(macro, i);
While ((Macro in ['*','/','%']) and
(i <= length(macro))) do begin
op := Macro;
Inc(i);
if (i > length(macro)) then begin
doErr;
end else begin
n := GetToken;
Level4(Hold,n);
if (op = '*') then
AResult := AResult * Hold
else begin
if (hold = 0.0) then
doErr
else if (op = '/') then
AResult := AResult / Hold
else
AResult := Trunc(AResult) mod Trunc(Hold);
end; { legal }
end; { while }
SkipBlanks(macro, i);
end;
end; {not error}
end; { level 3 }

(******************************************************************************
* Level2 *
* handle add/sub *
******************************************************************************)
procedure Level2(var AResult : Double; var n : TokenType);
var
Hold : Double;
op : Char;
begin
Level3(AResult,n);
if (n <> Error) then begin
SkipBlanks(macro, i);
While ((Macro in ['+','-']) and
(i <= length(macro))) do begin
op := Macro ;
inc(i);
if (i > length(macro)) then begin
doErr;
end else begin
n := GetToken;
Level3(Hold,n);
if (op = '+') then
AResult := AResult + Hold
else
AResult := AResult - Hold;
SkipBlanks(macro, i);
end; { no probs .. }
end; {while}
end; {not error}
end; { level2 }

(******************************************************************************
* Level1 *
* handle assign *
******************************************************************************)
procedure Level1(var AResult : Double; var n : TokenType);
var
mt : TokenType;
j : Byte;
mv : string;
begin
if (n = variable) then begin
j := i; {save i}
i := m;
mv := ppText;
mt := GetToken;
if ((mt = Delimiter) and (Macro = '=') and (i <=length(Macro)))
then begin
Inc(i);
n := GetToken;
Level2(AResult,n);
VRec := GetVar(mv);
VRec^.Value := AResult;
end else begin
i := j; {restore ..}
level2(AResult,n);
end; {not a variable = ...}
end {variable case} else
Level2(AResult,n);
end; { level 1 }

(******************************************************************************
* GetExpr *
******************************************************************************)
{$ifdef dll}
function GetExpr(s : PChar; var valid : Boolean) : Double; export;
{$else}
function GetExpr(const s : string; var valid : Boolean) : Double;
{$endif}
var
AResult : Double;
n : TokenType;
begin

{$ifdef dll}
macro := strPas(s);
{$else}
macro := s;
{$endif}

i := 1;
AResult := 0; {if no result returned}
n := GetToken;
if (Not (n in [endExpr,Non])) then
Level1(AResult,n);
if ((n <> endExpr) and (i < Length(Macro))) then
Dec(i);
GetExpr := AResult;
if (n = Error) then begin
Valid := False;
{$ifdef dll}
Aresult := errAt;
{$endif}
end
else
Valid := True;
end; {getExpr}

(******************************************************************************
* MAIN *
******************************************************************************)
procedure CleanUp;far;
Begin
ClearExprVars;
VarList.Free;
End;
{$IFNDEF WIN32}
Var
ExitSave : Pointer;
{$ENDIF}
Initialization
begin
VarList := TList.Create;
{$IFNDEF WIN32}
ExitSave := ExitProc;
ExitProc := @Cleanup;
{$ENDIF}
End;

{$IFDEF WIN32}
Finalization
Begin
CleanUp;
End;
{$ENDIF}

end.



单元二：
unit expr;

interface

uses
WinTypes,WinProcs, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Parser;

type
TExprCalc = class(TComponent)
private
{ Private declarations }
FExpr : String;
FValid : Boolean;
FAnswer : Double;

procedure RunExpr(AExpr:String);
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AComponent:TComponent);override;
procedure ClearVars;
function DoExpr(AExpr:String)ouble;
published
{ Published declarations }
property Expr : String read FExpr write RunExpr;
property Valid : Boolean read FValid;
property Answer : Double read FAnswer;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Samples', [TExprCalc]);
end;
constructor TExprCalc.Create(AComponent:TComponent);
Begin
inherited Create(AComponent);
FExpr := '';
FValid := True;
FAnswer := 0;
End;

procedure TExprCalc.ClearVars;
Begin
ClearExprVars;
End;
procedure TExprCalc.RunExpr(AExpr:String);
Begin
FAnswer := 0;
FExpr := AExpr;
FValid := True;
FAnswer := GetExpr(FExpr,FValid);
End;
function TExprCalc.DoExpr(AExpr:String)ouble;
{Var
b : Boolean;}
Begin
RunExpr(AExpr);
Result := FAnswer;
End;
end.

无处下手

大虾：你是完全做了一个语法解析的程序啊！
能不能把算法讲一下，在delphi下有简单的实现方法吗？？只要+-*/四种运算

如果是从控件中得到数值，如EDIT1.TEXT中获得“1”这个值，可以这样写：
OnClick
var
a,b,c,d,s:integer;
begin
a:=edit1.text;
b:=edit2.text;
c:=edit2.text;
d:=edit3.text;
s:=a+b+c+d;
edit4:=inttostr(s);
end;
若是表达式，则同步
显示S1+S2+S3+S4
同时，OnClick中将S1的值赋与a，s2的值赋与b，s3的值赋与c，s4的值赋与d
显示表达式S：=S1+S2+S3+S4
但同时计算其值。

不是，是从数据库取数。
比如说我数据库中有l1,l2,l3,l4……几个字段
我在一个Edit或其他编辑框里得到l1=l2+l3+l4这个计算式，注意：l1=l2+l3+l4是一次输入
现在是怎么吧以string 方式得到的公式解析出来。

对数据进行分析，碰到'+'就将前面地数据写到一个变量中去。
如：
J;=1;
a() : array of integer;
for i:=1 to length(str)
begin
if copy(str,i,1)='+' then
begin
setlengh(a,j);
a(j):=copy(str,j,i-1);
inc(j):
result := result+a(j);
end;

end;

看看数据结构中的堆栈就解决了.有专门的算法.

表达式的数据结构是二叉树,当然有的时候也可以用栈.
高程书上有一个表达式求值的例子是用了两个栈的(一个是存放运算符号,一个放操作数)
存储最好还是用二叉树,只要中序遍历一下就可以得到你的表达式,因为不止是 +
还有- * /,^ mod....,他们有不同的优先级,在编译原理中是用二叉树的.
这方面的delphi控件很多,csdn.net首页就有一个

同意yypeng的.
用栈的先进后出就能实现.

楼上：能不能发个控件到我油箱：snluosheng@sohu.com

下载一个公式解析控件不就行了

接受答案了.