На главную

Назад

//Функция realsn и realsimple округляет вещественное число с заданной точностью
//Если параметр точности realsn <0 округляются числа после 0,000.. (после запятой и после нулей)
//Примеры
//r=0,001234 realsn(r,-2)=0,0012
//r=-123,001235 realsn(r,-3)=-123,00124
//r=123,001235 realsn(r,-3)=123,00124
//r=123,751235 realsn(r,1)=123,8
//r=123,751235 realsn(r,-1)=123,8
//r=123 realsn(r,2)=123
//r=125,001235 realsimple(r,-2)=130
//r=125,001235 realsn(r,-3)=125,00124
function realsimple(r:real; n:integer):real;
var s:string;
begin
    s:=FloatToStrF(r,ffFixed,18,n);
    realsimple:=strtofloat(s);
end;

function realsn(r:real; n:integer):real;
const Digit: Set of Char=['1' .. '9'];
var i,temp,n2:integer;
    rest:real;
    sg,s,s0,srest:string;
begin
    s:=FloatToStrF(r,ffFixed,18,18);
if pos(',',s)>1 then sg:=copy(s,1,pos(',',s)-1) else sg:='';
//Нули после запятой есть, округлять после них
if (pos(',0',s)>0) and (n<0) then
 begin
   n2:=abs(n);
   s0:=copy(s,pos(',0',s)+1,length(s));
   for i := 1 to length(s0) do
   begin
     if s0[i] in Digit then
     begin
     srest:=copy(s0,i,length(s0));
     s0:=copy(s0,1,i-1);
     break;
     end;
   end;
  rest:=strtofloat('0,'+srest)*power(10,n2);
  temp:=round(rest);
  if (temp/power(10,n2))>=1 then s0:=copy(s0,1,length(s0)-1);
  if r<0 then realsn:=strtofloat(sg)-strtofloat('0,'+s0+inttostr(temp)) else
               realsn:=strtofloat(sg)+strtofloat('0,'+s0+inttostr(temp));
 end;
//Нулей после запятой нет, обычное округление с заданой точностью
if (pos(',0',s)=0) and (pos(',',s)>0) and (n>0) then
 begin
 realsn:=realsimple(r, n);
 end;
//Нули после запятой есть, обычное округление с заданой точностью
if (pos(',0',s)>0) and (pos(',',s)>0) and (n>0) then
 begin
 realsn:=realsimple(r, n);
 end;
 //Нулей после запятой нет, обычное округление с заданой точностью (сказано пропускать нули)
if (pos(',0',s)=0) and (pos(',',s)>0) and (n<0) then
 begin
  n2:=abs(n);
  realsn:=realsimple(r, n2);
 end;
//Округлять до целого числа
if (pos(',',s)>0) and (n=0) then
 begin
  realsn:=round(r);
 end;
//число не является вещественным ничего округлять не надо
if pos(',',s)=0 then realsn:=r;
end;