Tema: Redondeo
Ver Mensaje Individual
  #17  
Antiguo 03-04-2014
Avatar de nlsgarcia
[nlsgarcia] nlsgarcia is offline
Miembro Premium
 
Registrado: feb 2007
Ubicación: Caracas, Venezuela
Posts: 2.206
Reputación: 21
nlsgarcia Tiene un aura espectacularnlsgarcia Tiene un aura espectacular
novato_erick,

Cita:
Empezado por novato_erick
...Alguna mejor idea de funciones de redondeo que me retorne valores deseados reales...
Revisa este código:
Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Math;

type
  TForm1 = class(TForm)      
    RadioGroup1: TRadioGroup;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
   RadioGroup1.ItemIndex := 0;
end;

// Realiza diversos tipos de redondeo
procedure TForm1.Button1Click(Sender: TObject);
var
   N1 : Double;
   E : Integer;

begin

   {

   -function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode
  
   Sets the FPU rounding mode.
  
   (RoundMode)
   rmNearest : Rounds to the closest value.
   rmDown : Rounds toward negative infinity.
   rmUp : Rounds toward positive infinity.
   rmTruncate : Truncates the value, rounding positive numbers down and negative numbers up.
  
   -function RoundTo(const AValue: Double; const ADigit: TRoundToRange): Double;
  
   Rounds a floating-point value to a specified digit or power of ten using “Banker’s rounding”.

   }

   N1 := 2.718281;

   case RadioGroup1.ItemIndex of

      0 : begin
             SetRoundMode(rmUp);
             // Muestra 2.72
             ShowMessage(FormatFloat('#,###,###.00',RoundTo(N1,-2)));
          end;

      1 : begin
             SetRoundMode(rmDown);
             // Muestra 2.71
             ShowMessage(FormatFloat('#,###,###.00',RoundTo(N1,-2)));
          end;

      2 : begin
             SetRoundMode(rmNearest);
             // Muestra 2.72
             ShowMessage(FormatFloat('#,###,###.00',RoundTo(N1,-2)));
          end;

      3 : begin
             SetRoundMode(rmTruncate);
             // Muestra 2.71
             ShowMessage(FormatFloat('#,###,###.00',RoundTo(N1,-2)));
          end;

   end;

end;

// Estable el número de decimales (Truncado) sin redondeo de valores doubles
function DoubleDecimals(Number : Double; Decimal : Integer) : Double;
var
   AuxNumber : String;

begin

   AuxNumber := FloatToStr(Number);

   if Pos('.',AuxNumber) > 0 then
      Result := StrToFloat(Copy(AuxNumber,1,Pos('.',AuxNumber) + Decimal))
   else
   if Pos(',',AuxNumber) > 0 then
      Result := StrToFloat(Copy(AuxNumber,1,Pos(',',AuxNumber) + Decimal))
   else
      Result := Number;

end;

// Convierte un valor de n decimales a m decimales sin redondeo
procedure TForm1.Button2Click(Sender: TObject);
var
   N1 : Double;
   E : Integer;

begin

   N1 := 2.718281;

   // Convierte 2.718281 en 2.71, se establece el truncado de decimales sin redondeo a 2
   N1 := DoubleDecimals(N1,2);

   // Muestra 2.71
   ShowMessage(FloatToStr(N1));

end;

end.
El código anterior permite hacer diferentes tipos de ajustes decimales con redondeo y sin redondeo.

Espero sea útil

Nelson.

Última edición por nlsgarcia fecha: 03-04-2014 a las 22:06:06.
Responder Con Cita