Redondear numeros reales

Aquí tienen varias formas de redondear correctamente números reales:

Opcion1:

======



function RoundStr(Zn: Real; kol_zn: Integer): Real;

var

snl, s, s0, s1, s2: string;

n, n1: Real;

nn, i: Integer;

begin

s := FloatToStr(Zn);

if (Pos(',', s) > 0) and (Zn > 0) and

(Length(Copy(s, Pos(',', s) + 1, length(s))) > kol_zn) then

begin

s0 := Copy(s, 1, Pos(',', s) + kol_zn - 1);

s1 := Copy(s, 1, Pos(',', s) + kol_zn + 2);

s2 := Copy(s1, Pos(',', s1) + kol_zn, Length(s1));

n := StrToInt(s2) / 100;

nn := Round(n);

if nn >= 10 then

begin

snl := '0,';

for i := 1 to kol_zn - 1 do

snl := snl + '0';

snl := snl + '1';

n1 := StrToFloat(Copy(s, 1, Pos(',', s) + kol_zn)) + StrToFloat(snl);

s := FloatToStr(n1);

if Pos(',', s) > 0 then

s1 := Copy(s, 1, Pos(',', s) + kol_zn);

end

else

s1 := s0 + IntToStr(nn);

if s1[Length(s1)] = ',' then

s1 := s1 + '0';

Result := StrToFloat(s1);

end

else

Result := Zn;

end;



Opcion 2:



function RoundEx(X: Double; Precision: Integer ): Double;



// Precision : 1, 10,100 ...



var

ScaledFractPart, Temp: Double;

begin

ScaledFractPart := Frac(X) * Precision;

Temp := Frac(ScaledFractPart);

ScaledFractPart := Int(ScaledFractPart);

if Temp >= 0.5 then

ScaledFractPart := ScaledFractPart + 1;

if Temp <= -0.5 then

ScaledFractPart := ScaledFractPart - 1;

Result := Int(X) + ScaledFractPart / Precision;

end;



Opcion 3:



function FormatData(s: String; i: Integer): String;

begin

Result:=FloatToStr(Round(StrToFloat(s)*exp(i*ln(10)))/(exp(i*ln(10))));

end;



Opcion 4:



function RoundFloat(R: Extended; Decimals: Integer): Extended;

var

Factor: Extended;

begin

Factor := Int(Exp(Decimals * Ln(10)));

Result := Round(Factor * R) / Factor;

end;



La llamada sería de la siguiente forma:



showmessage(FloatToStr(RoundStr(2.3456789,3)));

showmessage(FloatToStr(RoundEx(2.3456789,1000)));

showmessage(formatdata('2,3456789',3));

showmessage(FloatToStr(RoundFloat(2.3456789,3)));

Al trabajar con imágenes en 3D he tenido que utilizar alguna de estas funciones y lo que he hecho para acelerar su cálculo es aumentar la prioridad de mi aplicación con la siguiente función:

procedure TForm1.AumentaPrioridad;

var

ProcessID : DWORD;

ProcessHandle : THandle;

ThreadHandle : THandle;

begin

ProcessID := GetCurrentProcessID;

ProcessHandle := OpenProcess(PROCESS_SET_INFORMATION,

false, ProcessID);

SetPriorityClass(ProcessHandle, REALTIME_PRIORITY_CLASS);

ThreadHandle := GetCurrentThread;

SetThreadPriority(ThreadHandle, THREAD_PRIORITY_TIME_CRITICAL);

end;