Форум программистов [Powered by Invision Power Board]

Код


function RoundEx(X: Double; Precision: Integer ): Double;
var
ScaledFractPart, Temp: Double;
begin
if x=0 then
 begin
 RoundEx:=0;
 exit;
 end;
TRY
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;
RoundEx := Int(X) + ScaledFractPart / Precision;
EXCEPT
ShowMessage('Îøèáêà îêðóãëåíèÿ '+FloatToStr(x));
END
end;

Код


function RoundEx(x:double; Precision:integer):double;
var mz:boolean;
begin
if Precision=0 then Precision:=1;
if x<0 then mz:=true else mz:=false;
if mz then x:=x*-1;
result:=Trunc(x * Precision + 0.5) / Precision ;
if mz then result:=result*-1;
end;

Код


function SimpleRoundTo(const AValue: Double; const ADigit: TRoundToRange = -2): Double;
var
  LFactor: Double;
begin
  LFactor := IntPower(10, ADigit);
  Result := Trunc((AValue / LFactor) + 0.5) * LFactor;
end;

Код


function SimpleRoundTo(const AValue: Double; const ADigit: TRoundToRange = -2): Double;
var
  LFactor: Double;
begin
  LFactor := IntPower(10, ADigit);
  if AValue < 0 then
    Result := Trunc((AValue / LFactor) - 0.5) * LFactor
  else
    Result := Trunc((AValue / LFactor) + 0.5) * LFactor;
end;

Код


function SimpleRoundTo(const AValue: Double; const ADigit: TRoundToRange = -2): Double;
var
  LFactor: Double;
begin
  LFactor := IntPower(10, ADigit);
  if AValue < 0 then
    Result := Trunc((AValue / LFactor) - 0.5) * LFactor
  else
    Result := Trunc((AValue / LFactor) + 0.5) * LFactor;
end;

Код


1,15       MyRound DoubleRound ExtendedRound
Currency       1,2         1,1           1,2
Double         1,1         1,1           1,1
Extended       1,2         1,1           1,2

Код


1,25       MyRound DoubleRound ExtendedRound
Currency       1,3         1,2           1,3
Double         1,3         1,2           1,3
Extended       1,3         1,2           1,3

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids;

type
  TForm1 = class(TForm)
    sg: TStringGrid;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Math;

{$R *.dfm}

function SimpleRoundToDouble(const AValue: Double; const ADigit: TRoundToRange = -2): Double;
var
  LFactor: Double;
begin
  LFactor := IntPower(10, ADigit);
  if AValue < 0 then
    Result := Trunc((AValue / LFactor) - 0.5) * LFactor
  else
    Result := Trunc((AValue / LFactor) + 0.5) * LFactor;
end;

function SimpleRoundToExtended(const AValue: Extended; const ADigit: TRoundToRange = -2): Extended;
var
  LFactor: Extended;
begin
  LFactor := IntPower(10, ADigit);
  if AValue < 0 then
    Result := Trunc((AValue / LFactor) - 0.5) * LFactor
  else
    Result := Trunc((AValue / LFactor) + 0.5) * LFactor;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  ValCur, ResCur: Currency;
  ValDbl, ResDbl: Double;
  ValExt, ResExt: Extended;
begin
  sg.Align := alClient;
  sg.DefaultColWidth := 80;
  sg.DefaultRowHeight:= 18;
  sg.ColCount := 4;
  sg.RowCount := 8;
  //
  ValCur := 1.15;
  ValDbl := 1.15;
  ValExt := 1.15;
  //
  sg.Cells[0, 0] := '1,15';
  sg.Cells[1, 0] := 'MyRound';
  sg.Cells[2, 0] := 'DoubleRound';
  sg.Cells[3, 0] := 'ExtendedRound';
  sg.Cells[0, 1] := 'Currency';
  sg.Cells[0, 2] := 'Double';
  sg.Cells[0, 3] := 'Extended';
  // MyRound
  sg.Cells[1, 1] := FloatToStr(Trunc(ValCur * 10 + 0.5) / 10);
  sg.Cells[1, 2] := FloatToStr(Trunc(ValDbl * 10 + 0.5) / 10);
  sg.Cells[1, 3] := FloatToStr(Trunc(ValExt * 10 + 0.5) / 10);
  // DoubleRound
  sg.Cells[2, 1] := FloatToStr(SimpleRoundToDouble(ValCur, -1));
  sg.Cells[2, 2] := FloatToStr(SimpleRoundToDouble(ValDbl, -1));
  sg.Cells[2, 3] := FloatToStr(SimpleRoundToDouble(ValExt, -1));
  // ExtendedRound
  sg.Cells[3, 1] := FloatToStr(SimpleRoundToExtended(ValCur, -1));
  sg.Cells[3, 2] := FloatToStr(SimpleRoundToExtended(ValDbl, -1));
  sg.Cells[3, 3] := FloatToStr(SimpleRoundToExtended(ValExt, -1));
  // Отрицательные числа
  ValCur := -1.15;
  ValDbl := -1.15;
  ValExt := -1.15;
  //
  sg.Cells[0, 4] := '-1,15';
  sg.Cells[0, 5] := 'Currency';
  sg.Cells[0, 6] := 'Double';
  sg.Cells[0, 7] := 'Extended';
  // MyRound
  sg.Cells[1, 5] := FloatToStr(Trunc(ValCur * 10 - 0.5) / 10);
  sg.Cells[1, 6] := FloatToStr(Trunc(ValDbl * 10 - 0.5) / 10);
  sg.Cells[1, 7] := FloatToStr(Trunc(ValExt * 10 - 0.5) / 10);
  // DoubleRound
  sg.Cells[2, 5] := FloatToStr(SimpleRoundToDouble(ValCur, -1));
  sg.Cells[2, 6] := FloatToStr(SimpleRoundToDouble(ValDbl, -1));
  sg.Cells[2, 7] := FloatToStr(SimpleRoundToDouble(ValExt, -1));
  // ExtendedRound
  sg.Cells[3, 5] := FloatToStr(SimpleRoundToExtended(ValCur, -1));
  sg.Cells[3, 6] := FloatToStr(SimpleRoundToExtended(ValDbl, -1));
  sg.Cells[3, 7] := FloatToStr(SimpleRoundToExtended(ValExt, -1));
end;

end.

Цитата

shmelina, Короткий вывод: Не используйте Double в округлениях smile

Код


//Precision количество знаков после запятой (0,1,2..)
function RoundEx(X: Extended; Precision: Integer ): Double;
 var s,tmpresult: String;
     i: Integer;
begin

 s:=FloatToStr(x);

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