Convertir Números a Palabras

Clases en VB.NET para convertir numeros a palabras en Ingles y Español

Introducción

Este articulo suministra la clase para traducir números a palabras en Ingles y Español respectivamente. Aunque este tema ha sido tratado ampliamente por los programadores, presento una alternativa con las clases CNumbersToWords y CNumerosEnPalabras. Al final doy la pauta para usar como WebService.

La Clase CNumbersToWords

La clase CNumbersToWords esta basada en el articulo Q95640 del MSDN escrito para VB clásico. He modificado y optimizado el código para adaptarlo a VB.NET, como tambien he incluido el parametros moneda. La clase contine la función NumbersToWords la cual hace la tarea. El código de la clase es el siguente:

'//==================================================================

'// CLASS : CNumbersToWords

'// AUTHOR : Article MSDN Q95640

'// MODIFY : Harvey Triana (harveytriana@mvps.org)

'// DESCRIPTION : Converts a number into string names

'//==================================================================

Public Class CNumbersToWords

Private Const DOT As String = ","

Function NumbersToWords( _

ByVal Number As String, _

ByVal Money As String) As String

Dim s As String

Dim Temp As String

Dim IntPart As String

Dim Cents As String

Dim DecimalPlace, Count

Dim Place(9) As String

Place(2) = " Thousand "

Place(3) = " Million "

Place(4) = " Billion "

Place(5) = " Trillion "

'//Convert s to a string, trimming extra spaces.

s = Format(Val(Number), "0.00")

DecimalPlace = InStr(s, DOT)

'//If we find decimal place...

If DecimalPlace > 0 Then

'//Convert cents

Temp = Left(Mid(s, DecimalPlace + 1) & "00", 2)

Cents = ConvertTens(Temp)

'//Strip off cents from remainder to convert.

s = Trim(Left(s, DecimalPlace - 1))

End If

Count = 1

Do Until s = ""

'//Convert last 3 digits of s to English IntPart.

Temp = ConvertHundreds(Right(s, 3))

If Len(Temp) Then IntPart = Temp & Place(Count) & IntPart

If Len(s) > 3 Then

'//Remove last 3 converted digits from s.

s = Left(s, Len(s) - 3)

Else

s = ""

End If

Count = Count + 1

Loop

'//Clean up IntPart.

'//Clean up IntPart.

Select Case IntPart

Case ""

IntPart = "No " & Money

Case "One"

IntPart = "One " & Singular(Money)

Case Else

IntPart = IntPart & " " & Money

End Select

IntPart = IntPart & " "

'//Clean up cents.

Select Case Cents

Case ""

Cents = "And No Cents"

Case "One"

Cents = "And One Cent"

Case Else

Cents = "And " & Cents & " Cents"

End Select

Return (Trim(IntPart & Cents))

End Function

Private Function ConvertHundreds(ByVal MyNumber As String) As String

Dim rtn As String

'//Exit if there is nothing to convert.

If Val(MyNumber) = 0 Then Exit Function

'//Append leading zeros to number.

MyNumber = Right("000" & MyNumber, 3)

'//Do we have a hundreds place digit to convert?

If Not Left(MyNumber, 1) = "0" Then

rtn = ConvertDigit(Left(MyNumber, 1)) & " Hundred "

End If

'//Do we have a tens place digit to convert?

If Not Mid(MyNumber, 2, 1) = "0" Then

rtn = rtn & ConvertTens(Mid(MyNumber, 2))

Else

'//If not, then convert the ones place digit.

rtn = rtn & ConvertDigit(Mid(MyNumber, 3))

End If

ConvertHundreds = Trim(rtn)

End Function

Private Function ConvertTens(ByVal MyTens As String) As String

Dim rtn As String

'//Is value between 10 and 19?

If Val(Left(MyTens, 1)) = 1 Then

Select Case Val(MyTens)

Case 10 : rtn = "Ten"

Case 11 : rtn = "Eleven"

Case 12 : rtn = "Twelve"

Case 13 : rtn = "Thirteen"

Case 14 : rtn = "Fourteen"

Case 15 : rtn = "Fifteen"

Case 16 : rtn = "Sixteen"

Case 17 : rtn = "Seventeen"

Case 18 : rtn = "Eighteen"

Case 19 : rtn = "Nineteen"

Case Else

End Select

Else

'//.. otherwise it's between 20 and 99.

Select Case Val(Left(MyTens, 1))

Case 2 : rtn = "Twenty "

Case 3 : rtn = "Thirty "

Case 4 : rtn = "Forty "

Case 5 : rtn = "Fifty "

Case 6 : rtn = "Sixty "

Case 7 : rtn = "Seventy "

Case 8 : rtn = "Eighty "

Case 9 : rtn = "Ninety "

Case Else

End Select

'//Convert ones place digit.

rtn = rtn & ConvertDigit(Right(MyTens, 1))

End If

ConvertTens = rtn

End Function

Private Function ConvertDigit(ByVal MyDigit As String) As String

Select Case Val(MyDigit)

Case 1 : ConvertDigit = "One"

Case 2 : ConvertDigit = "Two"

Case 3 : ConvertDigit = "Three"

Case 4 : ConvertDigit = "Four"

Case 5 : ConvertDigit = "Five"

Case 6 : ConvertDigit = "Six"

Case 7 : ConvertDigit = "Seven"

Case 8 : ConvertDigit = "Eight"

Case 9 : ConvertDigit = "Nine"

Case Else : ConvertDigit = ""

End Select

End Function

Private Function Singular(ByVal s As String) As String

If Len(s) >= 2 Then

If Right(s, 1) = "s" Then

If Right(s, 2) = "es" Then

Singular = Left(s, Len(s) - 2)

Else

Singular = Left(s, Len(s) - 1)

End If

Else

Singular = s

End If

End If

End Function

End Class

'//==============================================================

La Clase CNumerosEnPalabras

La clase CNumerosEnPalabras fue escrita por mi para VB clásico hace varios años. Esta clase fue traducida y optimizada para VB.NET. La clase contine la función NumerosEnPalabras la cual hace la tarea. El código de la clase es el siguente:

'//==================================================================

'// CLASS : CNumerosEnPalabras

'// AUTHOR : Harvey Triana (harveytriana@mvps.org)

'// DESCRIPTION : Convierte un numero a palabras

'//==================================================================

Public Class CNumerosEnPalabras

Private Const DOT As String = ","

Public Function NumerosEnPalabras( _

ByVal Number As String, _

ByVal Moneda As String) As String

Dim s As String

Dim DecimalPlace As Integer

Dim IntPart As String

Dim Cents As String

s = Format(Val(Number), "0.00")

DecimalPlace = InStr(s, DOT)

If DecimalPlace Then

IntPart = Left(s, DecimalPlace - 1)

Cents = Left(Mid(s, DecimalPlace + 1, 2), 2)

Else

IntPart = s

Cents = ""

End If

If IntPart = "0" Or IntPart = "" Then

s = "Cero "

ElseIf Len(IntPart) > 7 Then

s = IntNumToSpanish(Val(Left(IntPart, Len(IntPart) - 6))) + _

"Millones " + IntNumToSpanish(Val(Right(IntPart, 6)))

Else

s = IntNumToSpanish(Val(IntPart))

End If

If Right(s, 9) = "Millones " Or Right(s, 7) = "Millón " Then

s = s + "de "

End If

Select Case s

Case "Un ", "Una "

s = s & Singular(Moneda)

Case Else

s = s & Moneda

End Select

s = s & " "

If Val(Cents) Then

Cents = "con " + IntNumToSpanish(Val(Cents)) + "Centavos"

Else

Cents = "con Cero Centavos"

End If

Return (Trim(s + Cents))

End Function

Public Function IntNumToSpanish(ByVal numero As Integer) As String

Dim ptr As Integer

Dim n As Integer

Dim i As Integer

Dim s As String

Dim rtn As String

Dim tem As String

s = CStr(numero)

n = Len(s)

tem = ""

i = n

Do Until i = 0

tem = EvalPart(Val(Mid(s, n - i + 1, 1) + CloneChain(i - 1, "0")))

If Not tem = "Cero" Then

rtn = rtn + tem + " "

End If

i = i - 1

Loop

'//Filters

'//filterThousands

ReplaceAll(rtn, " Mil Mil", " Un Mil")

Do

ptr = InStr(rtn, "Mil ")

If ptr Then

If InStr(ptr + 1, rtn, "Mil ") Then

ReplaceStringFrom(rtn, "Mil ", "", ptr)

Else : Exit Do

End If

Else : Exit Do

End If

Loop

'//filterHundreds

ptr = 0

Do

ptr = InStr(ptr + 1, rtn, "Cien ")

If ptr Then

tem = Left(Mid(rtn, ptr + 5), 1)

If tem = "M" Or tem = "" Then

Else

ReplaceStringFrom(rtn, "Cien", "Ciento", ptr)

End If

End If

Loop Until ptr = 0

'//filterMisc

ReplaceAll(rtn, "Diez Un", "Once")

ReplaceAll(rtn, "Diez Dos", "Doce")

ReplaceAll(rtn, "Diez Tres", "Trece")

ReplaceAll(rtn, "Diez Cuatro", "Catorce")

ReplaceAll(rtn, "Diez Cinco", "Quince")

ReplaceAll(rtn, "Diez Seis", "Dieciseis")

ReplaceAll(rtn, "Diez Siete", "Diecisiete")

ReplaceAll(rtn, "Diez Ocho", "Dieciocho")

ReplaceAll(rtn, "Diez Nueve", "Diecinueve")

ReplaceAll(rtn, "Veinte Un", "Veintiun")

ReplaceAll(rtn, "Veinte Dos", "Veintidos")

ReplaceAll(rtn, "Veinte Tres", "Veintitres")

ReplaceAll(rtn, "Veinte Cuatro", "Veinticuatro")

ReplaceAll(rtn, "Veinte Cinco", "Veinticinco")

ReplaceAll(rtn, "Veinte Seis", "Veintiseís")

ReplaceAll(rtn, "Veinte Siete", "Veintisiete")

ReplaceAll(rtn, "Veinte Ocho", "Veintiocho")

ReplaceAll(rtn, "Veinte Nueve", "Veintinueve")

'//filterOne

If Left(rtn, 1) = "M" Then

rtn = "Un " + rtn

End If

'//Un Mil...

If Left(rtn, 6) = "Un Mil" Then

rtn = Mid(rtn, 4)

End If

'//addAnd

For i = 65 To 88

If Not i = 77 Then

ReplaceAll(rtn, "a " + Chr(i), "* y " + Chr(i))

End If

Next

ReplaceAll(rtn, "*", "a")

IntNumToSpanish = rtn

End Function

Private Function EvalPart(ByVal x As Integer) As String

Dim rtn As String

Dim s As String

Dim i As Integer

Do

Select Case x

Case 0 : s = "Cero"

Case 1 : s = "Un"

Case 2 : s = "Dos"

Case 3 : s = "Tres"

Case 4 : s = "Cuatro"

Case 5 : s = "Cinco"

Case 6 : s = "Seis"

Case 7 : s = "Siete"

Case 8 : s = "Ocho"

Case 9 : s = "Nueve"

Case 10 : s = "Diez"

Case 20 : s = "Veinte"

Case 30 : s = "Treinta"

Case 40 : s = "Cuarenta"

Case 50 : s = "Cincuenta"

Case 60 : s = "Sesenta"

Case 70 : s = "Setenta"

Case 80 : s = "Ochenta"

Case 90 : s = "Noventa"

Case 100 : s = "Cien"

Case 200 : s = "Doscientos"

Case 300 : s = "Trescientos"

Case 400 : s = "Cuatrocientos"

Case 500 : s = "Quinientos"

Case 600 : s = "Seiscientos"

Case 700 : s = "Setecientos"

Case 800 : s = "Ochocientos"

Case 900 : s = "Novecientos"

Case 1000 : s = "Mil"

Case 1000000 : s = "Millón"

End Select

If s = "" Then

i = i + 1

x = x / 1000

If x = 0 Then i = 0

Else

Exit Do

End If

Loop Until i = 0

rtn = s

Select Case i

Case 0 : s = ""

Case 1 : s = " Mil"

Case 2 : s = " Millones"

Case 3 : s = " Billones"

End Select

EvalPart = rtn + s

Exit Function

End Function

Private Sub ReplaceStringFrom( _

ByRef s As String, _

ByVal OldWrd As String, _

ByVal NewWrd As String, _

ByVal ptr As Integer)

s = Left(s, ptr - 1) + NewWrd + Mid(s, Len(OldWrd) + ptr)

End Sub

Private Function Singular(ByVal s As String) As String

If Len(s) >= 2 Then

If Right(s, 1) = "s" Then

If Right(s, 2) = "es" Then

Singular = Left(s, Len(s) - 2)

Else

Singular = Left(s, Len(s) - 1)

End If

Else

Singular = s

End If

End If

End Function

Private Function CloneChain(ByVal n As Integer, ByVal Chr As String)

Dim i As Integer

Dim CharClone As String

Dim rtn As String

If Len(Chr) Then

CharClone = Mid(Chr, 1, 1)

For i = 1 To n

rtn = rtn + CharClone

Next

End If

Return rtn

End Function

Private Sub ReplaceAll( _

ByRef s As String, _

ByVal OldWrd As String, _

ByVal NewWrd As String)

Dim ptr As Integer

Do

ptr = InStr(s, OldWrd)

If ptr Then

s = Left(s, ptr - 1) + NewWrd + Mid(s, Len(OldWrd) + ptr)

End If

Loop Until ptr = 0

End Sub

End Class

//==============================================================

Usando Como WebServices

Como todo código de .NET las clases pueden hacer parte de un WebService. Tan solo se requiere agregar las clases al projecto, delegar los metodos como metodos de Web, y publicar. El codigo de un WebService de ejemplo que trabajé es el siguiente:

'//==================================================================

'// WEBSERVICE : ...Service1

'// AUTHOR : Harvey Triana (harveytriana@mvps.org)

'// DESCRIPTION : Converts a number into string names

'//==================================================================

Imports System.Web.Services

<WebService(Namespace := "http://tempuri.org/")> _

Public Class Service1

Inherits System.Web.Services.WebService

Dim ew As Numbers2Words.CNumbersToWords

Dim es As Numbers2Words.CNumerosEnPalabras

#Region " Web Services Designer Generated Code "

<WebMethod()> Function NumbersToWords(ByVal Number As String, ByVal Money As String) As String

ew = New CNumbersToWords()

Return (ew.NumbersToWords(Number, Money))

End Function

<WebMethod()> Function NumerosEnPalabras(ByVal Numero As String, ByVal Moneda As String) As String

es = New CNumerosEnPalabras()

Return (es.NumerosEnPalabras(Numero, Moneda))

End Function

End Class

//==============================================================

Observe que las clases no se modifican en absoluto, solo se usan en un objeto concreto.

Los WebService pueden servir a cualquier aplicación .NET, es decir tamto a aplicaciones locales como aplicaciones en Web (ASP.NET). Tan solo debe agregar la referencia al WebService desde Project=> Add Web Reference. Luego crear un objeto del WebService. Siguiendo con el ejemplo, yo cree una aplicación de Windows, agregue un Boton (btnContertToWords), un Label (lblResponse), un TextBox (txtNumber). Mi servidor se llama Joda y el servicio web se llama Service1. El siguiente código completa el ejemplo:

'//==================================================================

'// FORM : Form1

'// AUTHOR : Harvey Triana (harveytriana@mvps.org)

'// DESCRIPTION : Sample of Consuming a WebService

'//==================================================================

Public Class Form1

Inherits System.Windows.Forms.Form

#Region " Windows Form Designer generated code "

Private Sub btnContertToWords_Click( _

ByVal sender As System.Object, _

ByVal e As System.EventArgs) Handles btnContertToWords.Click

Dim ws As joda.Service1

ws = New joda.Service1()

Me.lblResponse.Text = ws.NumbersToWords(Me.txtNumber.Text, "Dolars")

End Sub

End Class

Despues de dar clic, se crea un objeto del WebService, y se ejecuta una de sus funciones. Vaya si funciona.

Autor: Harvey Triana (http://www.mvps.org/vexpert)