Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Varios
Registrarse FAQ Miembros Calendario Guía de estilo Buscar Temas de Hoy Marcar Foros Como Leídos

Grupo de Teaming del ClubDelphi

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 29-09-2005
pmfras pmfras is offline
Miembro
 
Registrado: nov 2004
Posts: 59
Poder: 20
pmfras Va por buen camino
nros a letras

preciso si alguien me puede facilitar componente o codigo que me permita pasar un nro con dos decimales a letras.
Responder Con Cita
  #2  
Antiguo 29-09-2005
Avatar de Sotrono
Sotrono Sotrono is offline
Miembro
 
Registrado: abr 2004
Ubicación: Buenos Aires - Argentina
Posts: 396
Poder: 20
Sotrono Va por buen camino
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...
Responder Con Cita
  #3  
Antiguo 29-09-2005
Avatar de vtdeleon
vtdeleon vtdeleon is offline
Miembro
 
Registrado: abr 2004
Ubicación: RD & USA
Posts: 3.236
Poder: 23
vtdeleon Va por buen camino
Saludos

Creo que en la seccion Componentes de este foro existe una unidad o componente que facilita este caso
__________________
Van Troi De León
(Not) Guía, Code vB:=Delphi-SQL, ¿Cómo?
Viajar en el tiempo no es teóricamente posible, pues si lo fuera, ya estarían aqui contándonos al respecto!
Responder Con Cita
  #4  
Antiguo 29-09-2005
Avatar de dec
dec dec is offline
Moderador
 
Registrado: dic 2004
Ubicación: Alcobendas, Madrid, España
Posts: 13.107
Poder: 34
dec Tiene un aura espectaculardec Tiene un aura espectacular
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)
__________________
David Esperalta
www.decsoftutils.com

Última edición por Neftali [Germán.Estévez] fecha: 21-06-2006 a las 13:08:15.
Responder Con Cita
Respuesta


Herramientas Buscar en Tema
Buscar en Tema:

Búsqueda Avanzada
Desplegado

Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro


La franja horaria es GMT +2. Ahora son las 21:14:28.


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
Copyright 1996-2007 Club Delphi