{Автор: Наурыз Чуленбаев г. Байконур (Nauryz_91_kz@mail.ru)}
PROCEDURE FORMULA (F:STRING; VAR otvet:EXTENDED; perem:array of char; znperem:array of real; usevar:boolean);
var c:byte;
skn,skk,pf:byte;
function Minus(znach:string):extended; //отрицательные числа
begin
if znach[1]='m' then begin
delete (znach,1,1);
if znach<>'' then result:=0-strtofloat (znach);
end
else result:=strtofloat (znach);
end;
function SetM(zn:string):string ; //заменяет знак минус на m
var i:byte;
begin
if zn[1]='-' then zn[1]:='m';
for i:=1 to length (zn) do
if (zn[i]='-') and (zn[i+1]='-') then begin
insert ('+',zn,i);
delete (zn,i+1,2);
end;
for i:=1 to length (zn) do
if (zn[i]='-') and (zn[i-1] in ['*','/','+','-']) then zn[i]:='m';
result:=zn;
end;
function LastPos(subst:string; const st:string):byte; //аналог pos(),но ноходит
var dst:string; //номер последнего
count:byte; //проявления подстроки
begin
dst:=st;
count:=0;
if pos (subst,dst)<>0 then begin
result:=pos (subst,dst);
REPEAT
if result>pos (subst,dst) then result:=pos (subst,dst);
delete (dst,pos (subst,dst),length(subst));
count:=count+1;
if pos (subst,dst)<>0 then result:=pos (subst,dst);
UNTIL pos (subst,dst)=0;
result:=result+(length(subst)*(count-1));
end else
result:=0;
end;
function SetVar(st:string):string; //заменяет переменные их значениями
var j,h,d,s:byte;
begin
d:=length (st);
s:=0;
if length(perem)>1 then
for h:=0 to length(perem) do begin
while j<>d do begin
j:=j+1;
if st[j]=perem[h] then begin
delete (st,j,1);
insert (floattostr(znperem[h]),st,j);
j:=0;
end;
d:=length (st);
end;
j:=0;
end
else begin
for j:=1 to d do
if st[j]=perem[0] then begin
delete (st,j,1);
insert (floattostr(znperem[0]),st,j);
end;
d:=length (st);
end;
result:=st;
end;
//ф-я для умножения и деления
function KobeituBolu (ID:string; nomer:byte; KiliB:char; var fo:string):extended;
var tn,tk,j:byte;
zn1,zn2:real;
begin
tn:=0; tk:=0;
if KiliB='*' then
if nomer<>0 then begin
for j:=1 to nomer do
if ((ID[j]='+') or (ID[j]='-') or (ID[j]='/')) or ((ID[j]='*') and (j<nomer))
then tn:=j;
for j:=length(f) downto nomer do
if (ID[j]='+') or (ID[j]='-') or (ID[j]='/') or ((ID[j]='*') and (j>nomer))
then tk:=j;
if (tn<>0) and (tk<>0) then begin
zn1:=Minus(copy(ID,tn+1,(nomer-tn)-1));
zn2:=Minus(copy(ID,nomer+1,(tk-nomer)-1));
result:=zn1*zn2;
delete (ID,tn+1,(tk-tn)-1);
insert (floattostr(result),ID,tn+1);
end;
if (tn=0) and (tk=0) then begin
zn1:=Minus(copy(ID,1,nomer-1));
zn2:=Minus(copy(ID,nomer+1,length(ID)));
result:=zn1*zn2;
ID:=floattostr(result);
end;
if (tn=0) and (tk<>0) then begin
zn1:=Minus(copy(ID,1,nomer-1));
zn2:=Minus(copy(ID,nomer+1,(tk-nomer)-1));
result:=zn1*zn2;
delete (ID,1,tk-1);
insert (floattostr(result),ID,1);
end;
if (tn<>0) and (tk=0) then begin
zn1:=Minus (copy(ID,tn+1,(nomer-tn)-1));
zn2:=Minus (copy(ID,nomer+1,length(ID)));
result:=zn1*zn2;
delete (ID,tn+1,length(ID)-tn);
insert (floattostr(result),ID,tn+1);
end;
fo:=ID;
end; //if KiliB='*'then if nomer<>0 then
if KiliB='/' then
if nomer<>0 then begin
for j:=1 to nomer do
if ((ID[j]='+') or (ID[j]='-') or (ID[j]='*')) or ((ID[j]='/') and (j<nomer))
then tn:=j;
for j:=length(f) downto nomer do
if (ID[j]='+') or (ID[j]='-') or (ID[j]='*') or ((ID[j]='/') and (j>nomer))
then tk:=j;
if (tn<>0) and (tk<>0) then begin
zn1:=Minus(copy(ID,tn+1,(nomer-tn)-1));
zn2:=Minus(copy(ID,nomer+1,(tk-nomer)-1));
result:=zn1/zn2;
delete (ID,tn+1,(tk-tn)-1);
insert (floattostr(result),ID,tn+1);
end;
if (tn=0) and (tk=0) then begin
zn1:=Minus(copy(ID,1,nomer-1));
zn2:=Minus(copy(ID,nomer+1,length(ID)));
result:=zn1/zn2;
ID:=floattostr(result);
end;
if (tn=0) and (tk<>0) then begin
zn1:=Minus(copy(ID,1,nomer-1));
zn2:=Minus(copy(ID,nomer+1,(tk-nomer)-1));
result:=zn1/zn2;
delete (ID,1,tk-1);
insert (floattostr(result),ID,1);
end;
if (tn<>0) and (tk=0) then begin
zn1:=Minus (copy(ID,tn+1,(nomer-tn)-1));
zn2:=Minus (copy(ID,nomer+1,length(ID)));
result:=zn1/zn2;
delete (ID,tn+1,length(ID)-tn);
insert (floattostr(result),ID,tn+1);
end;
fo:=ID;
end; //if KiliB='/'then if nomer<>0 then
end; // function Kobeitu Bolu