表达式求值：谁有完整的求表达式的 pascal 代码，高分求救！(求后缀表达式)

[hiphis]

表达式求值：谁有完整的求表达式的 pascal 代码，有java写的更好，高分求救！

包括将中缀表达式转换成后缀表达式，再求出后缀表达式的值。

最基本要支持“+-*/（）”；

//（如能支函数更好）

给出答案，立马给分兑现！

急急急急急急急急急急急急急急急急急急急急急急急急急急急急急急

[hiphis]

???

[王集鹄]

uses
Math;

procedure Bracket(mText: string; var nLStr, nCStr, nRStr: string);
var
L, R: Integer;
I: Integer;
B: Boolean;
begin
nLStr := '';
nCStr := '';
nRStr := '';
B := True;
L := 0;
R := 0;
for I := 1 to Length(mText) do
if B then begin
if mText[I] = '(' then
Inc(L)
else if mText[I] = ')' then
Inc(R);
if L = 0 then
nLStr := nLStr + mText[I]
else if L > R then
nCStr := nCStr + mText[I]
else B := False;
end else nRStr := nRStr + mText[I];
Delete(nCStr, 1, 1);
end; { Bracket }

function Calc(mText: string): string;
var
vText: string;

function fCalc(mText: string): string;
var
vLStr, vCStr, vRStr: string;
I, J, K, L: Integer;
begin
L := Length(mText);
if Pos('(', mText) > 0 then begin
Bracket(mText, vLStr, vCStr, vRStr);
Result := Calc(vLStr + fCalc(vCStr) + vRStr);
end else if (Pos('+', mText) > 0) or (Pos('-', mText) > 0) then begin
I := Pos('+', mText);
J := Pos('-', mText);
if I = 0 then I := L;
if J = 0 then J := L;
K := Min(I, J);
vLStr := Copy(mText, 1, Pred(K));
vRStr := Copy(mText, Succ(K), L);
if vLStr = '' then vLStr := '0';
if vRStr = '' then vRStr := '0';
if I = K then
Result := FloatToStr(StrToFloat(fCalc(vLStr)) + StrToFloat(fCalc(vRStr)))
else Result := FloatToStr(StrToFloat(fCalc(vLStr)) - StrToFloat(fCalc(vRStr)))
end else if (Pos('*', mText) > 0) or (Pos('/', mText) > 0) then begin
I := Pos('*', mText);
J := Pos('/', mText);
if I = 0 then I := L;
if J = 0 then J := L;
K := Min(I, J);
vLStr := Copy(mText, 1, Pred(K));
vRStr := Copy(mText, Succ(K), L);
if vLStr = '' then vLStr := '0';
if vRStr = '' then vRStr := '0';
if I = K then
Result := FloatToStr(StrToFloat(fCalc(vLStr)) * StrToFloat(fCalc(vRStr)))
else Result := FloatToStr(StrToFloat(fCalc(vLStr)) / StrToFloat(fCalc(vRStr)))
end else if Pos('_', mText) = 1 then
Result := FloatToStr(-StrToFloat(fCalc(Copy(mText, 2, L))))
else Result := FloatToStr(StrToFloat(mText));
end;
var
I, L: Integer;
begin
vText := '';
L := Length(mText);
for I := 1 to L do
if (mText[I] = '-') and (I < L) and (not (mText[Succ(I)] in ['+', '-', '(', ')'])) then
if (I = 1) or ((I > 1) and (mText[Pred(I)] in ['*', '/'])) then
vText := vText + '_'
else if (I > 1) and (mText[Pred(I)] in ['+', '-']) then
vText := vText + '+_'
else vText := vText + mText[I]
else vText := vText + mText[I];
Result := fCalc(vText);
end; { Calc }

[王集鹄]

Edit1.Text := Calc(Edit2.Text);

[王集鹄]

实现函数也可以
但没有现成的哦
自己修改添加吧

[thisisxutao]

??????

[txinfo]

收集的，你看一看，它可是写着支持Java哟

作 者: cailu_888(想你~★) 2001-03-07 13:17:46 :0 :0
将一个包括多重扩号的四则运算代数式转换为浮点数，经典算法是用运算符后置法，再用栈原理计算。小苦想到了一种新颖的算法，用嵌套调用和递归也可以把结果算出来。小苦写成动态链接库TxtToF.dll，VB,Delphi,C++Builder,Visual C++,Java等可以调用。
源代码如下：


//动态连接库TxtToF.dll
library TxtToF;

uses
SysUtils;


//删除字符串S中的子串SubStr
function DeleteSubStr(S, SubStr: String): String;
begin
while Pos(SubStr, S) <> 0 do
Delete(S, Pos(SubStr, S), Length(SubStr));
Result := S;
end;

//删除字符串中的所有扩号
function DeleteK(S: String): String;
begin
S := DeleteSubStr(S, '(');
S := DeleteSubStr(S, ')');
Result := S;
end;

//返回字符串代数式的第一个运算符的整形序号
function GetOpIndex(S: String): Integer;
var
iAdd, iSub, iMu, iDiv: Integer;
begin
iAdd := Pos('+', S);
iSub := Pos('-', S);
iMu := Pos('*', S);
iDiv := Pos('/', S);

if iAdd = 0 then iAdd := 1000;
if iSub = 0 then iSub := 1000;
if iMu = 0 then iMu := 1000;
if iDiv = 0 then iDiv := 1000;

if (iAdd < iSub) and (iAdd < iMu) and
(iAdd < iDiv) then Result := iAdd else
if (iSub < iAdd) and (iSub < iMu) and
(iSub < iDiv) then Result := iSub else
if (iMu < iAdd) and (iMu < iSub) and
(iMu < iDiv) then Result := iMu else
if (iDiv < iAdd) and (iDiv < iSub) and
(iDiv < iMu) then Result := iDiv
else
Result := 0;
end;

//消除一个浮点数的前面的多重负号，如"__2"返回"2"，"___2"返回"_2"
function DeleteMinus(S: String): String;
var
bMinus: Boolean;
begin
bMinus := False;
while S[1] = '_' do
begin
Delete(S, 1, 1);
bMinus := not(bMinus);
end;
if bMinus then Result := '_' + S
else Result := S;
end;

//计算单运算符的代数式，返回浮点数字符串，负号为"_"
function SingleCal(S: String): String;
var
strTemp, strResult: String;
fLeft, fRight: Double;
i, iOpIndex: Integer;
begin
if S[1] = '-' then S[1] := '_';

iOpIndex := GetOpIndex(S);

//要是没有运算符的话，S就是结果
if (iOpIndex = 0) then
begin
Result := S;
exit;
end;

strTemp := ' ';
for i := 0 to iOpIndex - 1 do
strTemp[i] := S[i];
strTemp := Trim(strTemp);
strTemp := DeleteMinus(strTemp);
if strTemp[1] = '_' then
begin
Delete(strTemp, 1, 1);
fLeft := - StrToFloat(strTemp);
end else
fLeft := StrToFloat(strTemp);

strTemp := ' ';
for i := iOpIndex + 1 to Length(S) do
strTemp[i] := S[i];
strTemp := Trim(strTemp);
strTemp := DeleteMinus(strTemp);
if strTemp[1] = '_' then
begin
Delete(strTemp, 1, 1);
fRight := - StrToFloat(strTemp);
end else
fRight := StrToFloat(strTemp);

if S[iOpIndex] = '+' then
strResult := FloatToStr(fLeft + fRight)
else if S[iOpIndex] = '-' then
strResult := FloatToStr(fLeft - fRight)
else if S[iOpIndex] = '*' then
strResult := FloatToStr(fLeft * fRight)
else if S[iOpIndex] = '/' then
strResult := FloatToStr(fLeft / fRight);

if strResult[1] = '-' then
strResult[1] := '_';

Result := strResult;
end;

//计算只有加号或减号的多运算符代数式，返回浮点数字符串，负号为"_"
function AddSubCal(S: String): String;
var
strTemp: String;
iOpIndex, iLeft, iRight, i: Integer;
begin
if S[1] = '-' then S[1] := '_';

//要是没有运算符号，S就是结果
iOpIndex := GetOpIndex(S);
if (iOpIndex = 0) then
begin
Result := SingleCal(S);
exit;
end;

//计算第一条单运算符式子的左浮点数起始位置iLeft
iLeft := iOpIndex - 1;
while (S[iLeft] <> '+') and (S[iLeft] <> '-') and
(S[iLeft] <> '*') and (S[iLeft] <> '/') and (S[iLeft] <> '') do
iLeft := iLeft - 1;
iLeft := iLeft + 1;

//计算第一条单运算符式子的右浮点数起始位置iRight
iRight := iOpIndex + 1;
while (S[iRight] <> '+') and (S[iRight] <> '-') and
(S[iRight] <> '*') and (S[iRight] <> '/') and (S[iRight] <> '') do
iRight := iRight + 1;
iRight := iRight - 1;

strTemp := ' ';
for i := iLeft to iRight do
strTemp[i] := S[i];
strTemp := Trim(strTemp);

Delete(S, iLeft, iRight-iLeft+1);
Insert(SingleCal(strTemp), S, iLeft);

//递归调用AddSubCal
//每调用一次AddSubCal，消除式中的一个运算符，知道没有运算符为止
Result := AddSubCal(S);
end;

//计算无扩号的多运算符代数式，返回浮点数字符串，负号为"_"
function NoKCal(S: String): String;
var
strTemp: String;
iOpIndex, iMu, iDiv, iLeft, iRight, i: Integer;
begin
if S[1] = '-' then S[1] := '_';

iOpIndex := GetOpIndex(S);
//要是没有运算符号，S就是结果
if (iOpIndex = 0) then
begin
Result := AddSubCal(S);
exit;
end;

//将负数的负号转为'_'
if (iOpIndex = 1) and (S[1] = '-') then
S[1] := '_';

//------------首先考虑运算符等级高的乘号和除号---------------
iMu := Pos('*', S);
iDiv := Pos('/', S);

if (iMu <> 0) or (iDiv <> 0) then
begin
//乘法运算
if ((iMu < iDiv) and (iMu <> 0)) or ((iMu <> 0) and (iDiv = 0)) then
begin
iLeft := iMu - 1;
while (S[iLeft] <> '+') and (S[iLeft] <> '-') and
(S[iLeft] <> '*') and (S[iLeft] <> '/') and (S[iLeft] <> '') do
iLeft := iLeft - 1;
iLeft := iLeft + 1;

iRight := iMu + 1;
while (S[iRight] <> '+') and (S[iRight] <> '-') and
(S[iRight] <> '*') and (S[iRight] <> '/') and (S[iRight] <> '') do
iRight := iRight + 1;
iRight := iRight - 1;

strTemp := ' ';
for i := iLeft to iRight do
strTemp[i] := S[i];
strTemp := Trim(strTemp);

Delete(S, iLeft, iRight-iLeft+1);
Insert(SingleCal(strTemp), S, iLeft);

//递归调用NoKCal
Result := NoKCal(S);
exit;
end;

//除法运算
if (iDiv < iMu) and (iDiv <> 0) or ((iDiv <> 0) and (iMu = 0)) then
begin
iLeft := iDiv - 1;
while (S[iLeft] <> '+') and (S[iLeft] <> '-') and
(S[iLeft] <> '*') and (S[iLeft] <> '/') and (S[iLeft] <> '') do
iLeft := iLeft - 1;
iLeft := iLeft + 1;

iRight := iDiv + 1;
while (S[iRight] <> '+') and (S[iRight] <> '-') and
(S[iRight] <> '*') and (S[iRight] <> '/') and (S[iRight] <> '') do
iRight := iRight + 1;
iRight := iRight - 1;

strTemp := ' ';
for i := iLeft to iRight do
strTemp[i] := S[i];
strTemp := Trim(strTemp);

Delete(S, iLeft, iRight-iLeft+1);
Insert(SingleCal(strTemp), S, iLeft);

//递归调用NoKCal，直到没有*号和/号为止
Result := NoKCal(S);
exit;
end;
end else
//---------------------------------------------------------------
Result := AddSubCal(S);//S只剩下加号或减号了
end;

//计算复杂的代数式字符串，返回浮点数字符串，负号为"_"
function Cal(S: String): String;
var
strTemp, strOp: String;
iLeftK, iRightK, iTemp, i: Integer;
begin
//删除空格
S := DeleteSubStr(S, ' ');

//要是式子为不带扩号的简单运算式的话
if Pos('(', S) = 0 then
begin
Result := NoKCal(S);
exit;
end;

// 计算出式中最后一个左扩号的位置iLeftK，并把它前面的字符串和它都删除
strTemp := S;
iTemp := Pos('(', strTemp);
iLeftK := - iTemp;
while iTemp <> 0 do
begin
iLeftK := iLeftK + iTemp;
iTemp := Pos('(', strTemp);
Delete(strTemp, 1, iTemp);
end;

//strOp是包含左、右扩号的多运算符符式，把扩号删除后交由NoKCal计算
strOp := ' ';
iRightK := Pos(')', strTemp);
for i := 0 to iRightK do
strOp[i] := strTemp[i];
strOp := '(' + Trim(strOp);

//删除多运算符式，用其计算结果代替
Delete(S, iLeftK, iRightK+1);
strOp := DeleteK(strOp);//删除扩号
Insert(NoKCal(strOp), S, iLeftK);

//递归调用Cal
//每调用一次Cal，式中就计算出式中优先级最高的一对扩号中
//多运算符代数式的值，知道没有扩号为止
Result := Cal(S);
end;

//将Cal算出的结果转化为双精度浮点数
//此函数符合stdcall约定
function TxtToFloat(S: String): Double; stdcall;
begin
S := Cal(S);
S := DeleteMinus(S);
if S[1] = '_' then
begin
Delete(S, 1, 1);
Result := - StrToFloat(S);
end else
Result := StrToFloat(S);
end;

//引出函数
exports
TxtToFloat;

begin
end.

[王集鹄]

人呢？怎么不给个答复

[3fly]

关注

[hiphis]

看到了，其实我是JAVA中用，不过还是要感谢你的帮助。立马给分！