function
KosuAlu (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]=
'+'
)
and
(j<nomer))
then
tn:=j;
for
j:=length(f)
downto
nomer
do
if
(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
begin
for
j:=
1
to
nomer
do
if
(ID[j]=
'+'
)
or
((ID[j]=
'-'
)
and
(j<nomer))
then
tn:=j;
for
j:=length(f)
downto
nomer
do
if
(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
;
end
;
BEGIN
TRY
if
usevar
then
f:=SetVar (f);
f:=SetM (f);
skn:=
0
; skk:=
0
;
for
c:=
1
to
length(f)
do
if
f[c]=
'('
then
skn:=c;
for
c:=length(f)
downto
1
do
if
(f[c]=
')'
)
and
(c>skn)
then
skk:=c;
if
(skn=
0
)
or
(skk=
0
)
then
begin
REPEAT
c:=c+
1
;
if
f[
1
]=
'-'
then
f:=SetM (f);
if
(f[c]=
'*'
)
or
(f[c]=
'/'
)
then
begin
otvet:=KobeituBolu (f,c,f[c],f);
c:=
0
;
end
;
UNTIL
c=length (f);
f:=SetM (f);
c:=
0
;
REPEAT
c:=c+
1
;
if
f[
1
]=
'-'
then
f:=SetM (f);
if
(f[c]=
'+'
)
or
(f[c]=
'-'
)
then
begin
otvet:=KosuAlu (f,c,f[c],f);
c:=
0
;
end
;
UNTIL
c=length (f);
if
(pos(
'*'
,f)=
0
)
and
(pos(
'+'
,f)=
0
)
and
(pos(
'/'
,f)=
0
)
and
(pos(
'-'
,f)=
0
)
then
otvet:=Minus(f);
end
;
if
(skn<>
0
)
or
(skk<>
0
)
then
begin
FORMULA (copy(f,skn+
1
,(skk-skn)-
1
),otvet,perem,znperem,usevar);
if
(lastpos (
'sin'
,f)+
3
=skn)
and
(pos (
'sin'
,f)<>
0
)
then
begin
pf:=lastpos (
'sin'
,f);
otvet:=sin(otvet)*(
3.1415
/
180
);
delete (f,lastpos(
'sin'
,f),skk-lastpos(
'sin'
,f)+
1
);
insert (floattostrf(otvet,ffgeneral,
6
,
4
),f,pf);
end
else
if
(lastpos (
'cos'
,f)+
3
=skn)
and
(pos (
'cos'
,f)<>
0
)
then
begin
pf:=lastpos (
'cos'
,f);
otvet:=cos(otvet)*(
3.1415
/
180
);
delete (f,lastpos(
'cos'
,f),skk-lastpos(
'cos'
,f)+
1
);
insert (floattostrf(otvet,ffgeneral,
6
,
4
),f,pf);
end
else
if
(lastpos (
'tan'
,f)+
3
=skn)
and
(pos (
'tan'
,f)<>
0
)
and
(f[lastpos (
'tan'
,f)-
2
]<>
'c'
)
then
begin
pf:=lastpos (
'tan'
,f);
otvet:=tan(otvet)*(
3.1415
/
180
);
delete (f,lastpos(
'tan'
,f),skk-lastpos(
'tan'
,f)+
1
);
insert (floattostrf(otvet,ffgeneral,
6
,
4
),f,pf);
end
else
if
(lastpos (
'sqr'
,f)+
3
=skn)
and
(pos (
'sqr'
,f)<>
0
)
then
begin
pf:=lastpos (
'sqr'
,f);
otvet:=sqr(otvet);
delete (f,lastpos(
'sqr'
,f),skk-lastpos(
'sqr'
,f)+
1
);
insert (floattostrf(otvet,ffgeneral,
6
,
4
),f,pf);
end
else
if
(lastpos (
'cotan'
,f)+
5
=skn)
and
(pos (
'cotan'
,f)<>
0
)
then
begin
pf:=lastpos (
'cotan'
,f);
otvet:=cotan(otvet)*(
3.1415
/
180
);
delete (f,lastpos(
'cotan'
,f),skk-lastpos(
'cotan'
,f)+
1
);
insert (floattostrf(otvet,ffgeneral,
6
,
4
),f,pf);
end
else
if
(lastpos (
'sqrt'
,f)+
4
=skn)
and
(pos (
'sqrt'
,f)<>
0
)
then
begin
pf:=lastpos (
'sqrt'
,f);
otvet:=sqrt(otvet);
delete (f,lastpos(
'sqrt'
,f),skk-lastpos(
'sqrt'
,f)+
1
);
insert (floattostrf(otvet,ffgeneral,
6
,
4
),f,pf);
end
else
if
(lastpos (
'exp'
,f)+
3
=skn)
and
(pos (
'exp'
,f)<>
0
)
then
begin
pf:=lastpos (
'exp'
,f);
otvet:=exp(otvet);
delete (f,lastpos(
'exp'
,f),skk-lastpos(
'exp'
,f)+
1
);
insert (floattostrf(otvet,ffgeneral,
6
,
4
),f,pf);
end
else
if
(lastpos (
'ln'
,f)+
2
=skn)
and
(pos (
'ln'
,f)<>
0
)
then
begin
pf:=lastpos (
'ln'
,f);
otvet:=ln(otvet);
delete (f,lastpos(
'ln'
,f),skk-lastpos(
'ln'
,f)+
1
);
insert (floattostrf(otvet,ffgeneral,
6
,
4
),f,pf);
end
else
begin
delete (f,skn,skk-skn+
1
);
insert (floattostrf(otvet,ffgeneral,
6
,
4
),f,skn);
end
;
FORMULA (f,otvet,perem,znperem,usevar);
end
;
except
messagedlg (
'Сандарды дурыстап жаз!.. Че то жумыс истей алмай жатырм.'
,mterror,[mbok],
0
);
end
;
END
;