Tecsitel_FactuGES2/Source/Base/Utiles/uNumUtils.pas

128 lines
4.6 KiB
ObjectPascal
Raw Normal View History

{
===============================================================================
Copyright (<EFBFBD>) 2002. Rodax Software.
===============================================================================
Los contenidos de este fichero son propiedad de Rodax Software titular del
copyright. Este fichero s<EFBFBD>lo podr<EFBFBD> ser copiado, distribuido y utilizado,
en su totalidad o en parte, con el permiso escrito de Rodax Software, o de
acuerdo con los t<EFBFBD>rminos y condiciones establecidas en el acuerdo/contrato
bajo el que se suministra.
-----------------------------------------------------------------------------
Web: www.rodax-software.com
===============================================================================
Fecha primera versi<EFBFBD>n: 01-11-2002
Versi<EFBFBD>n actual: 1.0.0
Fecha versi<EFBFBD>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;
implementation
uses SysUtils, Dialogs;
// SysUtils, Windows, Dialogs, Messages, Classes, Graphics, Controls, Forms, StdCtrls;
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.