Преобразование строки в математическое выражение и получение результата.
Автор: Vimil Saju
Источник: www.исходники.ru
Источник: www.исходники.ru
Представляю Вашему вниманию компонент, на вход которого подаётся строка, содержащая математическое выражение, а на выходе результат вычисления этого выражения. При необходимости Вам не составит труда добавить в компонент такие функции как 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.
Оставить комментарий
Комментарии
1.
![Мне нравится](http://i.codenet.ru/vote_good.gif)
![Мне не нравится](http://i.codenet.ru/vote_bad.gif)
20 апреля 2006, 09:24:07
Зачем все это? Юзайте msscript activex control.
2.
![Мне нравится](http://i.codenet.ru/vote_good.gif)
![Мне не нравится](http://i.codenet.ru/vote_bad.gif)
21 мая 2004, 15:33:33
выдает ошибку EAccessViolation на инструкции setlength
что с этим делать?
что с этим делать?