|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
||||
|
||||
[ Исходник ] - Процедура для генерации формул
Имя (Ник): Наурыз Чуленбаев
E-mail: Nauryz_91_kz@mail.ru Описание исходника: Процедура для генерации формул (математического выражения) во время выполнения программы (т.е. в ран-тайм). Код:
{Автор: Наурыз Чуленбаев г. Байконур (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 |