function GetExpressionValue(ExpressionStr: string; var E: string; Rvn: boolean = false): extended;
{
//
/ /
/ 此为早期VB的练习作品,使用了大量的goto,使程序非常难读,改为delphi后有许多 /
/ 编译警告,但没有功能上及内存泄漏的问题 2001-06-22 /
/ /
/ 函数功能:表达式求解 /
/ 参 数:<ExpressionStr>必要,字符串类型,是一个以##为标界(可省略)包 /
/ 含数字及运算符优先符的字符串 /
/ [Rvn]可省略,布尔类型,选择异常返回值类型,Ture 返回代码异常 /
/ 值,False 返回中文异常值 /
/ 运算符支持 +、-、*、/、^、(、)、+(正)、-(负) (注:正 /
/ 负号必须与其后的数字包含在(、)内才会优先运算) 的运算,括号 /
/ 之间的*可以省略,字符串中的空格将被忽略,任何其他非算符字符 /
/ 会返回错误。 /
/ 返回值说明: #+)n 表示在n处多出),#-)n 表示在n处缺少),#E 表示表达式 /
/ 为空,#Zm.n表示从m至n的除数为0,#Pm.n表示从m至n的底数为0而指 /
/ 数为负数,#n 表示在n有无法识别的符号 /
/ 其他说明:本函数调用了自定义函数 Repl,用于除去字符串中的空格和将)(、 /
/ (+、(- 分别解释为)*(、(0+及(0-。 /
/ 本函数调用的其他自定义函数有 VAL()、MID()、LEFT()、RIGHT() /
/ /
/ 算符优先级表: /
/ /
/ + - * / ^ ( ) # /
/ + > > < < < < > > /
/ - > > < < < < > > /
/ * > > > > < < > > /
/ / > > > > < < > > /
/ ^ > > > > > < > > /
/ ( < < < < > < = #) /
/ ) > > > > > ? > > /
/ # < < < < < < #( > /
/ /
/ 例: GetExpressionValue("#1.2+4^4*7+2/(7-3)#") /
/ 返回 1793.7 ,正确的结果 /
/ GetExpressionValue("1.2+4^4*7+2/(7-3)#") /
/ 返回 1793.7 ,任一标界均省略 /
/ GetExpressionValue("1.2+4^4*7+2/(7-3))") /
/ 返回 “在 18 处多出 )” /
/ GetExpressionValue("1.2+4^4*7+2/(7-3))",True) /
/ 返回 #+)18 ,在 18 处多出 ) /
/ GetExpressionValue("1.2+4^4*7+2/((7-3)") /
/ 返回 “在 19 处缺少)” /
/ GetExpressionValue("1.2+4^4*7+2/((7-3)",True) /
/ 返回 #-)19 ,在 19 处缺少 /
/ GetExpressionValue("1,2+4^4*7+2/((7-3)") /
/ 返回 “在 2 处有无法识别的符号” /
/ GetExpressionValue("1,2+4^4*7+2/((7-3)",Ture) /
/ 返回 #2 ,第2个字符无法识别 /
/ GetExpressionValue("1. 2+4 ^4*7+ 2/(7 -3)") /
/ 返回 1793.7 ,空格被忽略 /
/ GetExpressionValue("") /
/ 返回“表达式为空” /
/ GetExpressionValue("",Ture) /
/ 返回 #E /
//
}
const
OperateSYN: set of char = ['+', '-', '*', '/', '^', '(', ')', '#']; //操作符集
// OperateNUM:set of char=['0','1','2','3','4','5','6','7','8','9','.'];
var
Optr: TStack; //操作符栈
OptrS: ^Integer; //用于
OptrP: char; //用于暂存操作符进行比较
Opdn: TStack; //操作数及结果栈
LineNo: TStack; //保存函数的返回地址
Opri: array[0..7, 1..2] of string; //存储操作符的优先级,第○列表示该操作符的符号,
//第一列表示该操作符的类别,第二列表示该操作符的优先级
Xs: string; //暂存输入
Theta: ^integer; //获得参与运算的操作符
a: ^extended; //操作数a
b: ^extended; //操作数b
c: ^extended; //运算返回值
i: integer; //字符串的当前位置
j: integer; //用于判断取操作数的位数
k: Integer; //仅用于 AllLine 部分
iP: ^extended; //用于操作数压栈
jP: ^integer; //用于操作符压栈及与栈有关的整型变量
LsOptr: ^integer; //获得操作符栈栈顶元素
Cinb: boolean; //用于判断输入是否为操作符,Ture 为操作符 False 为操作数
Prec: char; //用于保存操作符的比较结果
Pn: boolean;
Ex: string;
label
10, 20, 30, 40, 50, 60, 70, 80, 90, 100, Precede, Operate, JudgeNumber, AllLine, ConvOperateSYN, ExitTF, ReturnR;
begin
Ex := '';
Optr := TStack.Create;
Opdn := TStack.Create;
LineNo := TStack.Create;
New(iP);
// Opri[0, 0] := '('; // (
Opri[0, 1] := 'P'; // P 表示是优先符
Opri[0, 2] := 'L'; // L 表示是左优先符
// Opri[1, 0] := ')'; // )
Opri[1, 1] := 'P';
Opri[1, 2] := 'R'; // R 表示是右优先符
// Opri[2, 0] := '^'; // ^
Opri[2, 1] := 'O'; // O 表示是运算符
Opri[2, 2] := '10'; // 0
// Opri[3, 0] := '*'; // *
Opri[3, 1] := 'O';
Opri[3, 2] := '20'; // 1
// Opri[4, 0] := '/'; // /
Opri[4, 1] := 'O';
Opri[4, 2] := '20'; // 1
// Opri[5, 0] := '+'; // +
Opri[5, 1] := 'O';
Opri[5, 2] := '30'; // 2
// Opri[6, 0] := '-'; // -
Opri[6, 1] := 'O';
Opri[6, 2] := '30'; // 2
// Opri[7, 0] := '#'; // #
Opri[7, 1] := 'S'; // S 表示是结束符
Opri[7, 2] := '40'; // 3
{ 0, '(';
1, ')';
2, '^';
3, '*';
4, '/';
5, '+';
6, '-';
7, '#';}
///
if Length(ExpressionStr) = 0 then
begin
Ex := CxFFPC.IIf(Rvn, '#E', '表达式为空');
iP^ := 0;
Opdn.Push(iP);
goto ReturnR;
end
else begin
if CxFFPC.CRight(ExpressionStr, 1) <> '#' then ExpressionStr := ExpressionStr + '#';
if CxFFPC.CLeft(ExpressionStr, 1) = '#' then ExpressionStr := CxFFPC.Mid(ExpressionStr, 2);
end;
ExpressionStr := CxFFPC.Repl(ExpressionStr, ')(', ')*(');
ExpressionStr := CxFFPC.Repl(ExpressionStr, '(-', '(0-');
ExpressionStr := CxFFPC.Repl(ExpressionStr, '(+', '(0+');
ExpressionStr := CxFFPC.Repl(ExpressionStr, ' ', '');
i := 1;
Pn := false;
New(OptrS);
OptrS^ := 7;
Optr.Push(OptrS); // '#'
iP^ := 0;
Opdn.Push(iP);
New(OptrS);
OptrS^ := 40;
LineNo.Push(OptrS);
goto JudgeNumber;
40:
Xs := CxFFPC.Mid(ExpressionStr, i, j);
i := i + j;
OptrS := Optr.Peek;
while not ((Xs = '#') and (OptrS^ = 7)) do
begin
10:
if not Cinb then //如果是操作数
begin
Opdn.Push(iP);
Pn := false;
New(OptrS);
OptrS^ := 50;
LineNo.Push(OptrS);
goto JudgeNumber;
50:
Xs := CxFFPC.Mid(ExpressionStr, i, j);
i := i + j;
end
else begin
New(OptrS);
OptrS^ := 20;
LineNo.Push(OptrS);
OptrP := Xs[1];
goto Precede; //判断操作符的优先级
20:
case Prec of
'<':
begin
90:
Optr.Push(jP);
Pn := true;
New(OptrS);
OptrS^ := 60;
LineNo.Push(OptrS);
goto JudgeNumber;
60:
Xs := CxFFPC.Mid(ExpressionStr, i, j);
i := i + j;
end;
'=':
begin
OptrS := Optr.Pop;
Dispose(OptrS);
New(OptrS);
OptrS^ := 70;
LineNo.Push(OptrS);
goto JudgeNumber;
70:
Xs := CxFFPC.Mid(ExpressionStr, i, j);
i := i + j;
end;
'>':
begin
Theta := Optr.Pop;
b := Opdn.Pop;
a := Opdn.Pop;
New(OptrS);
OptrS^ := 30;
LineNo.Push(OptrS);
goto Operate;
30:
Dispose(Theta);
Dispose(a);
Dispose(b);
end;
else
goto ReturnR;
end;
end;
OptrS := Optr.Peek;
end; //while
ReturnR:
iP := Opdn.Pop;
Result := CxFFPC.IIf(Ex = '', iP^, 0);
E := Ex;
Dispose(iP);
goto ExitTF;
///函数区
Precede: //判断两个操作符的优先级,返回值寄存在变量 Prec 中
LsOptr := Optr.Peek;
New(OptrS);
OptrS^ := 100;
LineNo.Push(OptrS);
goto ConvOperateSYN;
100:
if LsOptr^ = 7 then
if jP^ = 7 then
Prec := '='
else begin
if Opri[jP^, 2] = 'R' then
begin
Prec := ' ';
Ex := CxFFPC.IIf(Rvn, '#+)' + IntToStr(i - 1),
' 在 ' + IntToStr(i - 1) + ' 位多出 ) '); // # 表示表达式在此位置多 )
end
else
Prec := '<'; // # 表示表达式在此位置缺少 Opri(OP(Xs), 0)
goto AllLine;
end
else
if jP^ = 7 then
begin
if Opri[LsOptr^, 2] = 'L' then
begin
Prec := ' ';
Ex := CxFFPC.IIf(Rvn, '#-)' + IntToStr(i - 1), ' 在 ' + IntToStr(i - 1) + ' 位缺少 ) ');
end
else
Prec := '>'; // # 表示表达式在此位置缺少 )
goto AllLine;
end;
if (Opri[LsOptr^, 1] = 'O') and (Opri[jP^, 1] = 'O') then
begin
Prec := CxFFPC.IIf((StrToInt(Opri[LsOptr^, 2]) - StrToInt(Opri[jP^, 2])) <= 0, '>', '<');
goto AllLine;
end
else
if Opri[LsOptr^, 2] = 'L' then
if Opri[jP^, 1] = 'P' then
begin
Prec := CxFFPC.IIf(Opri[jP^, 2] = 'R', '=', '<');
goto AllLine;
end
else begin
Prec := '<';
goto AllLine;
end
else
if Opri[LsOptr^, 2] = 'R' then
begin
if Opri[jP^, 2] = 'L' then
begin
Prec := ' ';
Ex := 'Error';
end
else
Prec := '>';
goto AllLine;
end
else begin
Prec := CxFFPC.IIf(Opri[jP^, 2] = 'L', '<', '>');
goto AllLine;
end;
goto AllLine;
Operate: //对操作数求值,返回值压回 Opdn 栈
case Theta^ of
5: // +
begin
New(c);
c^ := a^ + b^;
Opdn.Push(c);
end;
6: // -
begin
New(c);
c^ := a^ - b^;
Opdn.Push(c);
end;
3: // *
begin
New(c);
c^ := a^ * b^;
Opdn.Push(c);
end;
4: // /
begin
if b^ = 0 then
begin
Ex := CxFFPC.IIf(Rvn, '#Z' + IntToStr(i - 1 - Length(VarToStr(b^))) + '.'
+ IntToStr(Length(VarToStr(b^))), '从第 ' +
IntToStr(i - 1 - Length(VarToStr(b^))) + ' 位开始的 ' +
IntToStr(Length(VarToStr(b^))) + ' 位数据为零');
goto ReturnR;
end;
New(c);
c^ := a^ / b^;
Opdn.Push(c);
end;
2: // ^
begin
if (a^ = 0) and (b^ < 0) then
begin
Ex := CxFFPC.IIf(Rvn, '#P' + IntToStr(i - 1 - Length(VarToStr(b^))) + '.'
+ IntToStr(Length(VarToStr(b^))), '从第 ' +
IntToStr(i - 1 - Length(VarToStr(b^))) + ' 位开始的 ' +
IntToStr(Length(VarToStr(b^))) + ' 位的指数为负,而底数为零');
goto ReturnR;
end;
New(c);
c^ := Math.Power(a^, b^);
Opdn.Push(c);
end;
end; //case
goto AllLine;
JudgeNumber: //判断数字,返回值寄存在变量 j 中
j := i;
while (CxFFPC.Asc(CxFFPC.Mid(ExpressionStr, j, 1)) = 46) or ((CxFFPC.Asc(CxFFPC.Mid(ExpressionStr, j, 1)) >= 48) and (CxFFPC.Asc(CxFFPC.Mid(ExpressionStr, j, 1)) <= 57)) do
j := j + 1;
if j > i then
begin
Cinb := false;
j := j - i;
end
else begin
OptrP := ExpressionStr[j];
Cinb := OptrP in OperateSYN;
if Cinb then
begin
New(OptrS);
OptrS^ := 80;
LineNo.Push(OptrS);
goto ConvOperateSYN;
80:
if Pn and (jP^ <> 0) then
begin
Ex := CxFFPC.IIf(Rvn, '#' + IntToStr(j), '在 ' + IntToStr(j - 1) + ' 位有的多余运算符');
goto ReturnR;
end
end
else begin
Ex := CxFFPC.IIf(Rvn, '#' + IntToStr(j), '在 ' + IntToStr(j) + ' 位有无法识别的符号');
goto ReturnR;
end;
j := 1;
end;
New(iP);
iP^ := CxFFPC.CVal(CxFFPC.Mid(ExpressionStr, i, j));
goto AllLine;
ConvOperateSYN: //将操作符转换为优先级,返回值寄存在变量 jP^ 中
New(jP);
case OptrP of
'(':
jP^ := 0;
')':
jP^ := 1;
'^':
jP^ := 2;
'*':
jP^ := 3;
'/':
jP^ := 4;
'+':
jP^ := 5;
'-':
jP^ := 6;
'#':
jP^ := 7;
end;
goto AllLine;
///返回区
AllLine:
OptrS := LineNo.Pop;
k := OptrS^;
Dispose(OptrS);
case k of
10:
goto 10;
20:
goto 20;
30:
goto 30;
40:
goto 40;
50:
goto 50;
60:
goto 60;
70:
goto 70;
80:
goto 80;
90:
goto 90;
100:
goto 100;
end;
///释放资源区
ExitTF:
for k := 1 to Optr.Count do
Dispose(Optr.Pop);
for k := 1 to Opdn.Count do
Dispose(Opdn.Pop);
for k := 1 to LineNo.Count do
Dispose(LineNo.Pop);
Optr.Free;
Opdn.Free;
LineNo.Free;
end;
表达式计算函数
最新推荐文章于 2022-11-09 23:50:42 发布