Преобразование строки в математическое
выражение и получение результата.
Автор: Vimil Saju
Представляю Вашему вниманию сомпонент, на вход
которого подаётся строка, содержащая
математическое выражение, а на выходе результат
вычисления этого выражения. При необходимости
Вам не составит труда добавить в компонент такие
функции как sin,cos,log,tan и т.д. Единственная
неприятность, это присутствие глюка. Если ввести
строку типа '5* -3', то мы получим ошибку. Я
обязательно в ближайшее время постараюсь
исправить данный баг.
Совместимость: Delphi 4.x (или выше)
|
Собственно сам исходничек: |
unit MathComponent;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,math;
type
TMathtype=(mtnil,mtoperator,mtlbracket,mtrbracket,mtoperand);
type
TMathOperatortype=(monone,moadd,mosub,modiv,momul,mopow);
type
pmathchar = ^Tmathchar;
TMathChar = record
case mathtype: Tmathtype of
mtoperand:(data:extended);
mtoperator:(op:TMathOperatortype);
end;
type
TMathControl = class(TComponent)
private
input,output,stack:array of tmathchar;
fmathstring:string;
function getresult:extended;
function calculate(operand1,operand2,operator:Tmathchar):extended;
function getoperator(c:char):TMathOperatortype;
function getoperand(mid:integer;var len:integer):extended;
procedure processstring;
procedure convertinfixtopostfix;
function isdigit(c:char):boolean;
function isoperator(c:char):boolean;
function getprecedence(mop:TMathOperatortype):integer;
protected
published
property MathExpression:string read fmathstring write fmathstring;
property MathResult:extended read getresult;
end;
procedure Register;
implementation
function Tmathcontrol.calculate(operand1,operand2,operator:Tmathchar):extended;
begin
result:=0;
case operator.op of
moadd:
result:=operand1.data + operand2.data;
mosub:
result:=operand1.data - operand2.data;
momul:
result:=operand1.data * operand2.data;
modiv:
if (operand1.data<>0) and (operand2.data<>0) then
result:=operand1.data / operand2.data
else
result:=0;
mopow: result:=power(operand1.data,operand2.data);
end;
end;
function Tmathcontrol.getresult:extended;
var
i:integer;
tmp1,tmp2,tmp3:tmathchar;
begin
convertinfixtopostfix;
setlength(stack,0);
for i:=0 to length(output)-1 do
begin
if output[i].mathtype=mtoperand then
begin
setlength(stack,length(stack)+1);
stack[length(stack)-1]:=output[i];
end
else if output[i].mathtype=mtoperator then
begin
tmp1:=stack[length(stack)-1];
tmp2:=stack[length(stack)-2];
setlength(stack,length(stack)-2);
tmp3.mathtype:=mtoperand;
tmp3.data:=calculate(tmp2,tmp1,output[i]);
setlength(stack,length(stack)+1);
stack[length(stack)-1]:=tmp3;
end;
end;
result:=stack[0].data;
setlength(stack,0);
setlength(input,0);
setlength(output,0);
end;
function Tmathcontrol.getoperator(c:char):TMathOperatortype;
begin
result:=monone;
if c='+' then
result:=moadd
else if c='*' then
result:=momul
else if c='/' then
result:=modiv
else if c='-' then
result:=mosub
else if c='^' then
result:=mopow;
end;
function Tmathcontrol.getoperand(mid:integer;var len:integer):extended;
var
i,j:integer;
tmpnum:string;
begin
j:=1;
for i:=mid to length(fmathstring)-1 do
begin
if isdigit(fmathstring[i]) then
begin
if j<=20 then
tmpnum:=tmpnum+fmathstring[i];
j:=j+1;
end
else
break;
end;
result:=strtofloat(tmpnum);
len:=length(tmpnum);
end;
procedure Tmathcontrol.processstring;
var
i:integer;
numlen:integer;
begin
i:=0;
numlen:=0;
setlength(output,0);
setlength(input,0);
setlength(stack,0);
fmathstring:='('+fmathstring+')';
setlength(input,length(fmathstring));
while i<=length(fmathstring)-1 do
begin
if fmathstring[i+1]='(' then
begin
input[i].mathtype:=mtlbracket;
i:=i+1;
end
else if fmathstring[i+1]=')' then
begin
input[i].mathtype:=mtrbracket;
i:=i+1;
end
else if isoperator(fmathstring[i+1]) then
begin
input[i].mathtype:=mtoperator;
input[i].op:=getoperator(fmathstring[i+1]);
i:=i+1;
end
else if isdigit(fmathstring[i+1]) then
begin
input[i].mathtype:=mtoperand;
input[i].data:=getoperand(i+1,numlen);
i:=i+numlen;
end;
end;
end;
function Tmathcontrol.isoperator(c:char):boolean;
begin
result:=false;
if (c='+') or (c='-') or (c='*') or (c='/') or (c='^') then
result:=true;
end;
function Tmathcontrol.isdigit(c:char):boolean;
begin
result:=false;
if ((integer(c)> 47) and (integer(c)< 58)) or (c='.') then
result:=true;
end;
function Tmathcontrol.getprecedence(mop:TMathOperatortype):integer;
begin
result:=-1;
case mop of
moadd:result:=1;
mosub:result:=1;
momul:result:=2;
modiv:result:=2;
mopow:result:=3;
end;
end;
procedure Tmathcontrol.convertinfixtopostfix;
var
i,j,prec:integer;
begin
processstring;
for i:=0 to length(input)-1 do
begin
if input[i].mathtype=mtoperand then
begin
setlength(output,length(output)+1);
output[length(output)-1]:=input[i];
end
else if input[i].mathtype=mtlbracket then
begin
setlength(stack,length(stack)+1);
stack[length(stack)-1]:=input[i];
end
else if input[i].mathtype=mtoperator then
begin
prec:=getprecedence(input[i].op);
j:=length(stack)-1;
if j>=0 then
begin
while(getprecedence(stack[j].op)>=prec) and
(j>=0) do
begin
setlength(output,length(output)+1);
output[length(output)-1]:=stack[j];
setlength(stack,length(stack)-1);
j:=j-1;
end;
setlength(stack,length(stack)+1);
stack[length(stack)-1]:=input[i];
end;
end
else if input[i].mathtype=mtrbracket then
begin
j:=length(stack)-1;
if j>=0 then
begin
while(stack[j].mathtype<>mtlbracket) and
(j>=0) do
begin
setlength(output,length(output)+1);
output[length(output)-1]:=stack[j];
setlength(stack,length(stack)-1);
j:=j-1;
end;
if j>=0 then
setlength(stack,length(stack)-1);
end;
end;
end;
end;
procedure Register;
begin
RegisterComponents('Samples', [TMathControl]);
end;
end.
|