Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Varios (https://www.clubdelphi.com/foros/forumdisplay.php?f=11)
-   -   nros a letras (https://www.clubdelphi.com/foros/showthread.php?t=25648)

pmfras 29-09-2005 02:32:14

nros a letras
 
preciso si alguien me puede facilitar componente o codigo que me permita pasar un nro con dos decimales a letras.

Sotrono 29-09-2005 02:45:47

Hola. No lo probe pero el truco 260 de Trucomania te va a servir::

Código Delphi [-]
 (**************************************)
 (* Conversión Número -> Letra         *)
 (*                                    *)
 (* Parámetros:                        *)
 (*                                    *)
 (*   mNum:    Número a convertir      *)
 (*   iIdioma: Idioma de conversión    *)
 (*            1 -> Castellano         *)
 (*            2 -> Catalán            *)
 (*   iModo:   Modo de conversión      *)
 (*            1 -> Masculino          *)
 (*            2 -> Femenino           *)
 (*                                    *)
 (* Restricciones:                     *)
 (*                                    *)
 (* - Redondeo a dos decimales         *)
 (* - Rango: 0,00 a 999.999.999.999,99 *)
 (*                                    *)
 (**************************************)
  
 function NumLetra(const mNum: Currency; const iIdioma, iModo: Smallint): String;
 const 
   iTopFil: Smallint = 6;
   iTopCol: Smallint = 10;
   aCastellano: array[0..5, 0..9] of PChar =
   ( ('UNA ','DOS ','TRES ','CUATRO ','CINCO ',
     'SEIS ','SIETE ','OCHO ','NUEVE ','UN '),
     ('ONCE ','DOCE ','TRECE ','CATORCE ','QUINCE ',
     'DIECISEIS ','DIECISIETE ','DIECIOCHO ','DIECINUEVE ',''),
     ('DIEZ ','VEINTE ','TREINTA ','CUARENTA ','CINCUENTA ',
     'SESENTA ','SETENTA ','OCHENTA ','NOVENTA ','VEINTI'),
     ('CIEN ','DOSCIENTAS ','TRESCIENTAS ','CUATROCIENTAS ','QUINIENTAS ',
     'SEISCIENTAS ','SETECIENTAS ','OCHOCIENTAS ','NOVECIENTAS ','CIENTO '),
     ('CIEN ','DOSCIENTOS ','TRESCIENTOS ','CUATROCIENTOS ','QUINIENTOS ',
     'SEISCIENTOS ','SETECIENTOS ','OCHOCIENTOS ','NOVECIENTOS ','CIENTO '),
     ('MIL ','MILLON ','MILLONES ','CERO ','Y ',
     'UNO ','DOS ','CON ','','') );
   aCatalan: array[0..5, 0..9] of PChar =
   ( ( 'UNA ','DUES ','TRES ','QUATRE ','CINC ',
     'SIS ','SET ','VUIT ','NOU ','UN '),
     ( 'ONZE ','DOTZE ','TRETZE ','CATORZE ','QUINZE ',
     'SETZE ','DISSET ','DIVUIT ','DINOU ',''),
     ( 'DEU ','VINT ','TRENTA ','QUARANTA ','CINQUANTA ',
     'SEIXANTA ','SETANTA ','VUITANTA ','NORANTA ','VINT-I-'),
     ( 'CENT ','DOS-CENTES ','TRES-CENTES ','QUATRE-CENTES ','CINC-CENTES ',
     'SIS-CENTES ','SET-CENTES ','VUIT-CENTES ','NOU-CENTES ','CENT '),
     ( 'CENT ','DOS-CENTS ','TRES-CENTS ','QUATRE-CENTS ','CINC-CENTS ',
     'SIS-CENTS ','SET-CENTS ','VUIT-CENTS ','NOU-CENTS ','CENT '),
     ( 'MIL ','MILIO ','MILIONS ','ZERO ','-',
     'UN ','DOS ','AMB ','','') );
 var 
   aTexto: array[0..5, 0..9] of PChar;
   cTexto, cNumero: String;
   iCentimos, iPos: Smallint;
   bHayCentimos, bHaySigni: Boolean;
  
   (*************************************)
   (* Cargar Textos según Idioma / Modo *)
   (*************************************)
  
   procedure NumLetra_CarTxt;
   var 
     i, j: Smallint;
   begin 
     (* Asignación según Idioma *)
  
     for i := 0 to iTopFil - 1 do 
       for j := 0 to iTopCol - 1 do 
         case iIdioma of 
           1: aTexto[i, j] := aCastellano[i, j];
           2: aTexto[i, j] := aCatalan[i, j];
         else 
           aTexto[i, j] := aCastellano[i, j];
         end; 
  
     (* Asignación si Modo Masculino *)
  
     if (iModo = 1) then 
     begin 
       for j := 0 to 1 do 
         aTexto[0, j] := aTexto[5, j + 5];
  
       for j := 0 to 9 do 
         aTexto[3, j] := aTexto[4, j];
     end; 
   end; 
  
   (****************************)
   (* Traducir Dígito -Unidad- *)
   (****************************)
  
   procedure NumLetra_Unidad;
   begin 
     if not( (cNumero[iPos] = '0') or (cNumero[iPos - 1] = '1')
      or ((Copy(cNumero, iPos - 2, 3) = '001') and ((iPos = 3) or (iPos = 9))) ) then 
       if (cNumero[iPos] = '1') and (iPos <= 6) then 
         cTexto := cTexto + aTexto[0, 9]
       else 
         cTexto := cTexto + aTexto[0, StrToInt(cNumero[iPos]) - 1];
  
     if ((iPos = 3) or (iPos = 9)) and (Copy(cNumero, iPos - 2, 3) <> '000') then 
       cTexto := cTexto + aTexto[5, 0];
  
     if (iPos = 6) then 
       if (Copy(cNumero, 1, 6) = '000001') then 
         cTexto := cTexto + aTexto[5, 1]
       else 
         cTexto := cTexto + aTexto[5, 2];
   end; 
  
   (****************************)
   (* Traducir Dígito -Decena- *)
   (****************************)
  
   procedure NumLetra_Decena;
   begin 
     if (cNumero[iPos] = '0') then 
       Exit
     else if (cNumero[iPos + 1] = '0') then 
       cTexto := cTexto + aTexto[2, StrToInt(cNumero[iPos]) - 1]
     else if (cNumero[iPos] = '1') then 
       cTexto := cTexto + aTexto[1, StrToInt(cNumero[iPos + 1]) - 1]
     else if (cNumero[iPos] = '2') then 
       cTexto := cTexto + aTexto[2, 9]
     else 
       cTexto := cTexto + aTexto[2, StrToInt(cNumero[iPos]) - 1]
         + aTexto[5, 4];
   end; 
  
   (*****************************)
   (* Traducir Dígito -Centena- *)
   (*****************************)
  
   procedure NumLetra_Centena;
   var 
     iPos2: Smallint;
   begin 
     if (cNumero[iPos] = '0') then 
       Exit;
  
     iPos2 := 4 - Ord(iPos > 6);
  
     if (cNumero[iPos] = '1') and (Copy(cNumero, iPos + 1, 2) <> '00') then 
       cTexto := cTexto + aTexto[iPos2, 9]
     else 
       cTexto := cTexto + aTexto[iPos2, StrToInt(cNumero[iPos]) - 1];
   end; 
  
   (**************************************)
   (* Eliminar Blancos previos a guiones *)
   (**************************************)
  
   procedure NumLetra_BorBla;
   var 
     i: Smallint;
   begin 
     i := Pos(' -', cTexto);
  
     while (i > 0) do 
     begin 
       Delete(cTexto, i, 1);
       i := Pos(' -', cTexto);
     end; 
   end; 
  
 begin 
   (* Control de Argumentos *)
  
   if (mNum < 0.00) or (mNum > 999999999999.99) or (iIdioma < 1) or (iIdioma > 2)
     or (iModo < 1) or (iModo > 2) then 
   begin 
     Result := 'ERROR EN ARGUMENTOS';
     Abort;
   end; 
  
   (* Cargar Textos según Idioma / Modo *)
  
   NumLetra_CarTxt;
  
   (* Bucle Exterior -Tratamiento Céntimos-     *)
   (* NOTA: Se redondea a dos dígitos decimales *)
  
   cNumero := Trim(Format('%12.0f', [Int(mNum)]));
   cNumero := StringOfChar('0', 12 - Length(cNumero)) + cNumero;
   iCentimos := Trunc((Frac(mNum) * 100) + 0.5);
  
   repeat 
     (* Detectar existencia de Céntimos *)
  
     if (iCentimos <> 0) then 
       bHayCentimos := True
     else 
       bHayCentimos := False;
  
     (* Bucle Interior -Traducción- *)
  
     bHaySigni := False;
  
     for iPos := 1 to 12 do 
     begin 
       (* Control existencia Dígito significativo *)
  
       if not(bHaySigni) and (cNumero[iPos] = '0') then 
         Continue
       else 
         bHaySigni := True;
  
       (* Detectar Tipo de Dígito *)
  
       case ((iPos - 1) mod 3) of 
         0: NumLetra_Centena;
         1: NumLetra_Decena;
         2: NumLetra_Unidad;
       end; 
     end; 
  
     (* Detectar caso 0 *)
  
     if (cTexto = '') then 
       cTexto := aTexto[5, 3];
  
     (* Traducir Céntimos -si procede- *)
  
     if (iCentimos <> 0) then 
     begin 
       cTexto := cTexto + aTexto[5, 7];
       cNumero := Trim(Format('%.12d', [iCentimos]));
       iCentimos := 0;
     end; 
   until not (bHayCentimos);
  
   (* Eliminar Blancos innecesarios -sólo Catalán- *)
  
   if (iIdioma = 2) then 
     NumLetra_BorBla;
  
   (* Retornar Resultado *)
  
   Result := Trim(cTexto);
 end;

Saludos...

vtdeleon 29-09-2005 03:16:19

Saludos

Creo que en la seccion Componentes de este foro existe una unidad o componente que facilita este caso

dec 29-09-2005 08:42:50

Hola,

Cita:

Empezado por vtdeleon
Creo que en la seccion Componentes (...)

Efectivamente, en el apartado de Componentes del ClubDelphi se encuentra ATexto 2.0, escrito por Antoni Aloy y en cuya descripción se lee:

EDITO(Neftalí): Actualmente (07/2006) la sección de Componentes está desactivada por la remodelación del ClubDelphi; Mientras tanto se puede encontrar éste componente también aquí.

Cita:

Componente que traduce cifras a letras, 153 lo convierte en ciento cincuenta y tres. La nueva versión de Saviers contempla ciertas correcciones y mejoreas, entre ellas la cantidad de cifras que podía traducir. Incluye código fuente.
ANTES --> 999.999.999 (menos de mil millones) AHORA --> 9.999.999.999.999.999.999 (menos de 10 Trillones)


La franja horaria es GMT +2. Ahora son las 11:19:50.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi