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

Question

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 }

Answer 1

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

Answer 2

收集的，你看一看，它可是写着支持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.   

Answer 3

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