Полезно : Подсчёт формулы в строке (+-*/)

[Lime]

Всем привет. Написал сегодня такую функцию , думаю может быть полезна остальным.
Формула должна быть написана правильно
Проверку на правильность я ещё не написал)

function ExtCalcClear(formula:string):extended;
var
i2:integer;
st:tstringlist;
begin
formula:=stringreplace(formula,' ','',[rfreplaceall]);
st:=tstringlist.Create;
formula:=stringreplace(formula,'+',#10+'+'+#10,[rfreplaceall]);
formula:=stringreplace(formula,'-',#10+'-'+#10,[rfreplaceall]);
formula:=stringreplace(formula,'*',#10+'*'+#10,[rfreplaceall]);
formula:=stringreplace(formula,'/',#10+'/'+#10,[rfreplaceall]);
st.Text := formula;
i2 := 1;
while i2 <= st.Count-2 do
begin
if st[i2] = '*' then
begin
st[i2-1] := FloatToStr(StrToFloat(st[i2-1])*StrToFloat(st[i2+1]));
st.Delete(i2);
st.Delete(i2);
end else
if st[i2] = '/' then
begin
st[i2-1] := FloatToStr(StrToFloat(st[i2-1])/StrToFloat(st[i2+1]));
st.Delete(i2);
st.Delete(i2);
end else i2 := i2+1;
end;
i2 := 1;
while i2 <= st.Count-2 do
begin
if st[i2] = '+' then
begin
st[i2-1] := FloatToStr(StrToFloat(st[i2-1])+StrToFloat(st[i2+1]));
st.Delete(i2);
st.Delete(i2);
end else
if st[i2] = '-' then
begin
st[i2-1] := FloatToStr(StrToFloat(st[i2-1])-StrToFloat(st[i2+1]));
st.Delete(i2);
st.Delete(i2);
end else i2 := i2+1;
end;
result:= strtofloat(st[0]);
end;

function IsClear(formula:string):boolean;
begin
if ((pos('(',formula) = 0) and (pos(')',formula)=0)) then result := true else result := false;

end;

function ExtCalc(formula:string):Extended;
var str:string;
op,cl,oppos,clpos,i:integer;
begin
oppos:=-1;
clpos:=-1;
cl:=0;
op:=0;
formula:=stringreplace(formula,' ','',[rfreplaceall]);
if IsClear(formula) then result := ExtCalcclear(formula) else
begin
for i:=length(formula) downto 1 do
begin 

   if formula[i]='(' then
   begin
   op:=op+1;
   if oppos = -1 then oppos := i+1;
   if oppos > i+1 then oppos := i+1;
   end;

   if formula[i]=')' then
   begin
   cl:=cl+1;
   if clpos < i+1 then clpos := i+1;
   end;
   if ((op=cl)and (op<>0) and (cl<>0)) then
   begin 
   formula:=stringreplace(formula,copy(formula,oppos-1,clpos-oppos+1),floattostr(extcalc(copy(formula,oppos,clpos-oppos-1))),[rfreplaceall]);
   oppos:=-1;
   clpos:=-1;
   cl:=0;
   op:=0;
   end;


end;

end;
result := ExtCalcClear(formula);
end;

Пример использования :

procedure TForm1.Button1Click(Sender: TObject);
begin
showmessage(floattostr(extcalc(edit1.text)));
end;

Для проверки можете воспользоватся калькулятором в гугле. Достаточно ввести в поле поиска искомую формулу.

[ОДИНОЧЕСТВО В СЕТИ]

вот посмотрите интерпретатор на паскале может кому надо

[Serge_Bliznykov]

ну тогда и мои пять копеек в тему примите...
вот здесь (Парсер математических выражений) я выкладывал свой старенький вариант парсера...