Convertir un número en letras

Artículo por Club Developers · 31 diciembre 2005

5305 vistas

Es muy probable que necesitemos, en recibos y demás, convertir un valor numérico en letras. para ellos tenemos la siguiente función



delphi
  1. (**************************************)
  2. (* Conversión Número -> Letra         *)
  3. (*                                    *)
  4. (* Parámetros:                        *)
  5. (*                                    *)
  6. (*   mNum:    Número a convertir      *)
  7. (*   iIdioma: Idioma de conversión    *)
  8. (*            1 -> Castellano         *)
  9. (*            2 -> Catalán            *)
  10. (*   iModo:   Modo de conversión      *)
  11. (*            1 -> Masculino          *)
  12. (*            2 -> Femenino           *)
  13. (*                                    *)
  14. (* Restricciones:                     *)
  15. (*                                    *)
  16. (* - Redondeo a dos decimales         *)
  17. (* - Rango: 0,00 a 999.999.999.999,99 *)
  18. (*                                    *)
  19. (**************************************)
  20.  
  21. function NumLetra(const mNum: Currency; const iIdioma, iModo: Smallint): String;
  22. const 
  23.   iTopFil: Smallint = 6;
  24.   iTopCol: Smallint = 10;
  25.   aCastellano: array[0..5, 0..9] of PChar =
  26.   ( ('UNA ','DOS ','TRES ','CUATRO ','CINCO ',
  27.     'SEIS ','SIETE ','OCHO ','NUEVE ','UN '),
  28.     ('ONCE ','DOCE ','TRECE ','CATORCE ','QUINCE ',
  29.     'DIECISEIS ','DIECISIETE ','DIECIOCHO ','DIECINUEVE ',''),
  30.     ('DIEZ ','VEINTE ','TREINTA ','CUARENTA ','CINCUENTA ',
  31.     'SESENTA ','SETENTA ','OCHENTA ','NOVENTA ','VEINTI'),
  32.     ('CIEN ','DOSCIENTAS ','TRESCIENTAS ','CUATROCIENTAS ','QUINIENTAS ',
  33.     'SEISCIENTAS ','SETECIENTAS ','OCHOCIENTAS ','NOVECIENTAS ','CIENTO '),
  34.     ('CIEN ','DOSCIENTOS ','TRESCIENTOS ','CUATROCIENTOS ','QUINIENTOS ',
  35.     'SEISCIENTOS ','SETECIENTOS ','OCHOCIENTOS ','NOVECIENTOS ','CIENTO '),
  36.     ('MIL ','MILLON ','MILLONES ','CERO ','Y ',
  37.     'UNO ','DOS ','CON ','','') );
  38.   aCatalan: array[0..5, 0..9] of PChar =
  39.   ( ( 'UNA ','DUES ','TRES ','QUATRE ','CINC ',
  40.     'SIS ','SET ','VUIT ','NOU ','UN '),
  41.     ( 'ONZE ','DOTZE ','TRETZE ','CATORZE ','QUINZE ',
  42.     'SETZE ','DISSET ','DIVUIT ','DINOU ',''),
  43.     ( 'DEU ','VINT ','TRENTA ','QUARANTA ','CINQUANTA ',
  44.     'SEIXANTA ','SETANTA ','VUITANTA ','NORANTA ','VINT-I-'),
  45.     ( 'CENT ','DOS-CENTES ','TRES-CENTES ','QUATRE-CENTES ','CINC-CENTES ',
  46.     'SIS-CENTES ','SET-CENTES ','VUIT-CENTES ','NOU-CENTES ','CENT '),
  47.     ( 'CENT ','DOS-CENTS ','TRES-CENTS ','QUATRE-CENTS ','CINC-CENTS ',
  48.     'SIS-CENTS ','SET-CENTS ','VUIT-CENTS ','NOU-CENTS ','CENT '),
  49.     ( 'MIL ','MILIO ','MILIONS ','ZERO ','-',
  50.     'UN ','DOS ','AMB ','','') );
  51. var 
  52.   aTexto: array[0..5, 0..9] of PChar;
  53.   cTexto, cNumero: String;
  54.   iCentimos, iPos: Smallint;
  55.   bHayCentimos, bHaySigni: Boolean;
  56.  
  57.   (*************************************)
  58.   (* Cargar Textos según Idioma / Modo *)
  59.   (*************************************)
  60.  
  61.   procedure NumLetra_CarTxt;
  62.   var 
  63.     i, j: Smallint;
  64.   begin 
  65.     (* Asignación según Idioma *)
  66.  
  67.     for i := 0 to iTopFil - 1 do 
  68.       for j := 0 to iTopCol - 1 do 
  69.         case iIdioma of 
  70.           1: aTexto[i, j] := aCastellano[i, j];
  71.           2: aTexto[i, j] := aCatalan[i, j];
  72.         else 
  73.           aTexto[i, j] := aCastellano[i, j];
  74.         end; 
  75.  
  76.     (* Asignación si Modo Masculino *)
  77.  
  78.     if (iModo = 1) then 
  79.     begin 
  80.       for j := 0 to 1 do 
  81.         aTexto[0, j] := aTexto[5, j + 5];
  82.  
  83.       for j := 0 to 9 do 
  84.         aTexto[3, j] := aTexto[4, j];
  85.     end; 
  86.   end; 
  87.  
  88.   (****************************)
  89.   (* Traducir DÃgito -Unidad- *)
  90.   (****************************)
  91.  
  92.   procedure NumLetra_Unidad;
  93.   begin 
  94.     if not( (cNumero[iPos] = '0') or (cNumero[iPos - 1] = '1')
  95.      or ((Copy(cNumero, iPos - 2, 3) = '001') and ((iPos = 3) or (iPos = 9))) ) then 
  96.       if (cNumero[iPos] = '1') and (iPos <= 6) then 
  97.         cTexto := cTexto + aTexto[0, 9]
  98.       else 
  99.         cTexto := cTexto + aTexto[0, StrToInt(cNumero[iPos]) - 1];
  100.  
  101.     if ((iPos = 3) or (iPos = 9)) and (Copy(cNumero, iPos - 2, 3) <> '000') then 
  102.       cTexto := cTexto + aTexto[5, 0];
  103.  
  104.     if (iPos = 6) then 
  105.       if (Copy(cNumero, 1, 6) = '000001') then 
  106.         cTexto := cTexto + aTexto[5, 1]
  107.       else 
  108.         cTexto := cTexto + aTexto[5, 2];
  109.   end; 
  110.  
  111.   (****************************)
  112.   (* Traducir DÃgito -Decena- *)
  113.   (****************************)
  114.  
  115.   procedure NumLetra_Decena;
  116.   begin 
  117.     if (cNumero[iPos] = '0') then 
  118.       Exit
  119.     else if (cNumero[iPos + 1] = '0') then 
  120.       cTexto := cTexto + aTexto[2, StrToInt(cNumero[iPos]) - 1]
  121.     else if (cNumero[iPos] = '1') then 
  122.       cTexto := cTexto + aTexto[1, StrToInt(cNumero[iPos + 1]) - 1]
  123.     else if (cNumero[iPos] = '2') then 
  124.       cTexto := cTexto + aTexto[2, 9]
  125.     else 
  126.       cTexto := cTexto + aTexto[2, StrToInt(cNumero[iPos]) - 1]
  127.         + aTexto[5, 4];
  128.   end; 
  129.  
  130.   (*****************************)
  131.   (* Traducir DÃgito -Centena- *)
  132.   (*****************************)
  133.  
  134.   procedure NumLetra_Centena;
  135.   var 
  136.     iPos2: Smallint;
  137.   begin 
  138.     if (cNumero[iPos] = '0') then 
  139.       Exit;
  140.  
  141.     iPos2 := 4 - Ord(iPos > 6);
  142.  
  143.     if (cNumero[iPos] = '1') and (Copy(cNumero, iPos + 1, 2) <> '00') then 
  144.       cTexto := cTexto + aTexto[iPos2, 9]
  145.     else 
  146.       cTexto := cTexto + aTexto[iPos2, StrToInt(cNumero[iPos]) - 1];
  147.   end; 
  148.  
  149.   (**************************************)
  150.   (* Eliminar Blancos previos a guiones *)
  151.   (**************************************)
  152.  
  153.   procedure NumLetra_BorBla;
  154.   var 
  155.     i: Smallint;
  156.   begin 
  157.     i := Pos(' -', cTexto);
  158.  
  159.     while (i > 0) do 
  160.     begin 
  161.       Delete(cTexto, i, 1);
  162.       i := Pos(' -', cTexto);
  163.     end; 
  164.   end; 
  165.  
  166. begin 
  167.   (* Control de Argumentos *)
  168.  
  169.   if (mNum < 0.00) or (mNum > 999999999999.99) or (iIdioma < 1) or (iIdioma > 2)
  170.     or (iModo < 1) or (iModo > 2) then 
  171.   begin 
  172.     Result := 'ERROR EN ARGUMENTOS';
  173.     Abort;
  174.   end; 
  175.  
  176.   (* Cargar Textos según Idioma / Modo *)
  177.  
  178.   NumLetra_CarTxt;
  179.  
  180.   (* Bucle Exterior -Tratamiento Céntimos-     *)
  181.   (* NOTA: Se redondea a dos dígitos decimales *)
  182.  
  183.   cNumero := Trim(Format('%12.0f', [Int(mNum)]));
  184.   cNumero := StringOfChar('0', 12 - Length(cNumero)) + cNumero;
  185.   iCentimos := Trunc((Frac(mNum) * 100) + 0.5);
  186.  
  187.   repeat 
  188.     (* Detectar existencia de Céntimos *)
  189.  
  190.     if (iCentimos <> 0) then 
  191.       bHayCentimos := True
  192.     else 
  193.       bHayCentimos := False;
  194.  
  195.     (* Bucle Interior -Traducción- *)
  196.  
  197.     bHaySigni := False;
  198.  
  199.     for iPos := 1 to 12 do 
  200.     begin 
  201.       (* Control existencia DÃgito significativo *)
  202.  
  203.       if not(bHaySigni) and (cNumero[iPos] = '0') then 
  204.         Continue
  205.       else 
  206.         bHaySigni := True;
  207.  
  208.       (* Detectar Tipo de DÃgito *)
  209.  
  210.       case ((iPos - 1) mod 3) of 
  211.         0: NumLetra_Centena;
  212.         1: NumLetra_Decena;
  213.         2: NumLetra_Unidad;
  214.       end; 
  215.     end; 
  216.  
  217.     (* Detectar caso 0 *)
  218.  
  219.     if (cTexto = '') then 
  220.       cTexto := aTexto[5, 3];
  221.  
  222.     (* Traducir Céntimos -si procede- *)
  223.  
  224.     if (iCentimos <> 0) then 
  225.     begin 
  226.       cTexto := cTexto + aTexto[5, 7];
  227.       cNumero := Trim(Format('%.12d', [iCentimos]));
  228.       iCentimos := 0;
  229.     end; 
  230.   until not (bHayCentimos);
  231.  
  232.   (* Eliminar Blancos innecesarios -sólo Catalán- *)
  233.  
  234.   if (iIdioma = 2) then 
  235.     NumLetra_BorBla;
  236.  
  237.   (* Retornar Resultado *)
  238.  
  239.   Result := Trim(cTexto);
  240. end;