AbetoDesign_FactuGES2/Source/Base/Utiles/uNumUtils.pas

{
===============================================================================
  Copyright (©) 2002. Rodax Software.
===============================================================================
  Los contenidos de este fichero son propiedad de Rodax Software titular del
  copyright. Este fichero sólo podrá ser copiado, distribuido y utilizado,
  en su totalidad o en parte, con el permiso escrito de Rodax Software, o de
  acuerdo con los términos y condiciones establecidas en el acuerdo/contrato
  bajo el que se suministra.
  -----------------------------------------------------------------------------
  Web:  www.rodax-software.com
===============================================================================
  Fecha primera versión: 01-11-2002
  Versión actual: 1.0.0
  Fecha versión actual: 01-11-2002
===============================================================================
  Modificaciones:

    Fecha         Comentarios
    ---------------------------------------------------------------------------
===============================================================================
}

unit uNumUtils;

interface

Function IntToLetras(Numero:LongInt):String;
Function xxIntToLetras(Valor:LongInt):String;
Function CifraToLetras(Cifra: Double): String;
function RoundCurrency(const Value: Currency; const NumDecimales: Smallint = 2): Currency;

implementation

uses SysUtils, Dialogs;
//  SysUtils, Windows, Dialogs, Messages, Classes, Graphics, Controls, Forms, StdCtrls;

//Funcion importantisima, nos redondea por defecto el valor double-hasta 14 decimales- pasado por parametro a currency-solo 4 decimales-
//tiene un parametro de redondeo a numero de decimales menor, por defecto a 2 decimales, si no
function RoundCurrency(const Value: Currency; const NumDecimales: Smallint = 2): Currency;
var
  V64: Int64 absolute Result;
  Decimals: Integer;
begin
  if (NumDecimales = 2) then
  begin
    Result := Value;
    Decimals := V64 mod 100;
    Dec(V64, Decimals);
    case Decimals of
      -99 .. -50 : Dec(V64, 100);
      50 .. 99 : Inc(V64, 100);
    end;
  end
  else if (NumDecimales = 3) then
  begin
    Result := Value;
    Decimals := V64 mod 10;
    Dec(V64, Decimals);
    case Decimals of
      -9 .. -5 : Dec(V64, 10);
      5 .. 9 : Inc(V64, 10);
    end;
  end
  else
    Result := Value;
end;


{function RoundCurrency(const Value: Currency; const NumDecimales: Smallint = 2): Currency;
const
  factors: array [-4..-1] of Int64 = (10000, 1000, 100, 10);
var
  factor: Integer;
  ValueAsInt64: Int64 absolute Value;
  Scale: Integer;
begin
  Scale := -1*NumDecimales;
  if Scale = -4 then
    Result := ValueAsInt64
  else if Scale < -4 then
    Result := ValueAsInt64 * factors[4 + Scale]
  else begin
    factor := factors[-(4 + Scale)];
    Result := ValueAsInt64 div factor;
    if (ValueAsInt64 mod factor) >= (factor div 2) then
      Result := Inc(Result);
  end;
end;}



Function xxIntToLetras(Valor:LongInt):String;
const
 aUnitat : array[1..15] of String = ('UNO','DOS','TRES','CUATRO','CINCO','SEIS',
                                     'SIETE','OCHO','NUEVE','DIEZ','ONCE','DOCE',
                                     'TRECE','CATORCE','QUINCE');
 aCentena: array[1..9]  of String = ('CIENTO','DOSCIENTOS','TRESCIENTOS',
                                     'CUATROCIENTOS','QUINIENTOS','SEISCIENTOS',
                                     'SETECIENTOS','OCHOCIENTOS','NOVECIENTOS');
 aDecena : array[1..9]  of String = ('DIECI','VEINTI','TREINTA','CUARENTA','CINCUENTA',
                                     'SESENTA','SETENTA','OCHENTA','NOVENTA');
var
   Centena, Decena, Unitat, Doble: LongInt;
   Linea: String;
begin
   if valor=100 then Linea:=' CIEN ' {Maximo Valor sera 999, ejemplo con 123}
   else   begin
        Linea:='';
        Centena := Valor div 100;                         {1 }
        Doble   := Valor - (Centena*100);                 {23}
        Decena  := (Valor div 10) - (Centena*10);         {2 }
        Unitat  := Valor - (Decena*10) - (Centena*100);   {3 }

        if Centena>0 then Linea:=Linea+Acentena[centena]+' ';

        if Doble>0 then begin
           if Doble=20 then Linea:=Linea+' VEINTE '
          else  begin
               if doble<16 then Linea:=Linea+Aunitat[Doble]
               else  begin
                    Linea:=Linea+' '+Adecena[Decena];
                    if (Decena>2) and (Unitat<>0) then Linea:=Linea+' Y ';
                    if Unitat>0 then Linea:=Linea+Aunitat[Unitat];
               end;
          end;
        end;

   end;
   Result:=Linea;
end;

Function IntToLetras(Numero:LongInt):String;
var
   Millions,mils,unitats: Longint;
   Linea : String;
begin
     {Inicializamos el string que contendra las letras segun el valor numerico}
     if numero=0 then Linea:='Cero'
     else if numero<0 then Linea:='MENOS '
          else if numero>0 then Linea:='';

     {Determinamos el Nº de millones, miles, i unidades de numero en positivo}
     Numero   := Abs(Numero);
     millions := numero div 1000000;
     mils     := (numero - (millions*1000000)) div 1000;
     unitats  := numero - ((millions*1000000)+(mils*1000));

     {Vamos poniendot en el string las cadenas de los numeros(llamando a subfuncion)}
     if millions=1 then Linea:= Linea + ' UN MILLON '
     else if millions>1 then Linea := Linea + xxIntToLetras(millions) + ' MILLONES ';

     if mils =1 then Linea:= Linea + ' MIL '
     else if mils>1 then Linea := Linea + xxIntToLetras(mils) + ' MIL ';

     if unitats >0 then Linea:=Linea+xxIntToLetras(unitats);

     IntToLetras:=Linea;
end;

Function CifraToLetras(Cifra: Double): String;
var
  Entero: LongInt;
  Decimal: LongInt;
  Cadena: String;
begin
  Cadena := '';
  Entero := Trunc(Cifra);

  //Se quita el trunc ya que falla el redondeo y hay desfase de 1 centimo
//  Decimal := Trunc(((Cifra - Entero) * 100));
  Decimal := Round((Cifra - Entero) * 100);



  if (Decimal > 0) then
     Cadena := ' CON ' + IntToLetras(Decimal) + ' CÉNTIMOS';

  if (Entero > 0) then
     Cadena := IntToLetras(Entero) + ' EUROS ' + Cadena;

  Result := UpperCase(Cadena);
end;

end.