{ =============================================================================== 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): Currency; implementation uses SysUtils, Dialogs; // SysUtils, Windows, Dialogs, Messages, Classes, Graphics, Controls, Forms, StdCtrls; function RoundCurrency(const Value: Currency): Currency; var V64: Int64 absolute Result; Decimals: Integer; 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; 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.