'===============================================
' ALGORITMO DE LECTURA DE NUMEROS ENTEROS
'con un rango comprendido entre 1 y 999.999.999
'===============================================
'(C)Carlos Ruiz Díaz - Castord
'Asunción, 31-ENE-2007, Paraguay
'Todos los Derechos Reservados
'Carlos.RuizDiaz@gmail.com
'----------------------------------------------
'NO SE HACEN TODAS LAS VALIDACIONES NECESARIAS!
' Código vb5, vb6 Win32 compatible
' | CONTROLES |
'un text box, name=Text1
'un command button, name=Command1
'----------------------------------------------
'por favor, si encuentran bugs o realizan alguna
'clase de optimización, reportenmelo al mail
'adjunto, gracias.
'===============================================
Dim Unidades(1 To 9) As String
Dim Decenas(1 To 9) As String
Dim Especiales(11 To 19) As String
Dim Lect(1 To 3) As String
Dim nLect(1 To 3) As Integer
'---------------------------------
'Dim Millar As String
Dim Cent As String
'Dim Veinti As String
Dim Centenas(1 To 9) As String
Dim Grupo As Integer
'---------------------------------
Function Leer(Nro As String) As Boolean
'On Error GoTo Error
'On Error Resume Next
Dim Unidad As String, Decena As String, Centena As String
Dim Cifras As Integer
Dim Aux As String, Parte As String
Aux = vbNullString
Debug.Print Nro
If Val(Nro) = 0 Then 'si la cadena es por ej. '000' resultante del nro 1.000
Grupo = Grupo + 1
Lect(Grupo) = Aux
Exit Function 'sale
End If
Cifras = Len(Nro)
Parte = Mid(Nro, 1, 1) 'extrae las centenas
If Parte > 0 Then 'si es mayor a cero se consulta al vector y se asigna ya el texto respectivo
Aux = Centenas(Parte)
End If
Parte = CInt(Right(Nro, 2)) 'extrae unidad y decena
Unidad = CInt(Right(Nro, 1))
Debug.Print Unidad
Decena = CInt(Mid(Nro, 2, 1))
Debug.Print Decena
Centena = CInt(Left(Nro, 1))
Debug.Print Centena
'======se explicar por si solas algunas condicionales======
If Centena = 0 And Decena = 0 And Unidad > 0 Then 'para '001' por ej.
Aux = Unidades(Unidad)
ElseIf Unidad = 0 And Decena = 0 And Centena > 0 Then '100' por ej.
If Centena = 1 Then 'para cien
Aux = "cien"
Else '`para versiones 'ciento'.. .ej. 101
Aux = Centenas(Mid(Nro, 1, 1))
End If
ElseIf Decena = 0 And Unidad > 0 Then '01' por ej.
Aux = Aux & " " & Unidades(Unidad)
ElseIf Unidad = 0 And Decena > 0 Then '10' por ej.
Decena = Mid(Nro, 2, 1)
Aux = Aux & " " & Decenas(CInt(Decena))
ElseIf Parte < 20 Then 'para las versiones 'dieci', sin esto el resultado seria
'diez uno si el nro fuera 11
Aux = Aux & " " & Especiales(Parte)
ElseIf Parte > 20 And Parte < 30 Then 'para las versiones 'veinti', sin esto el resultado seria
'veinte uno si el nro fuera 21
Parte = CInt(Mid(Nro, 3, 1))
Aux = Aux & " Veinti" & Unidades(Parte)
Else 'para nros, sin ceros >30 y bla bla
Parte = CInt(Mid(Nro, 2, 1))
Aux = Aux & " " & Decenas(Parte)
Parte = CInt(Mid(Nro, 3, 1))
Aux = Aux & " y " & Unidades(Parte)
End If
'LOS VALORES LLEGAN DE DERECHA A IZQUIERDA... En el nro. 1.000.123 se leerá 1ro.
'la porcion '123'
'el vector Lect(1)=CENTENAS
'el vector Lect(2)=MILLARES
'el vector Lect(3)=MILLONES
Grupo = Grupo + 1 'determina que parte se esta leyendo
Lect(Grupo) = Aux 'coloca aqui el texto
nLect(Grupo) = Val(Nro) 'coloca aqui el nro.
Nro = vbNullString
Leer = True
Exit Function
Error:
Leer = False
MsgBox Err.Description
End Function
Function SetearNro() As Boolean
On Error GoTo Error
Dim Nro As String, Parte As String, Limit As Integer
Nro = Text1.Text
If Val(Nro) > 999999999 Or Val(Nro) < 1 Then
MsgBox "Error en rango de lectura", vbInformation
MsgBox "1 al 999.999.999 nomás!"
SetearNro = False
Exit Function
End If
'el programa toma los nros como cadenas de 3 caracteres por lo que esta sub es
'muy necesaria para que funcione
If Len(Nro) < 3 Then 'si el nro fue por ej. '3' el resultado será '003'
' para satisfacer la condicion
Nro = String(3 - Len(Nro), "0") & Nro
'MsgBox Nro
End If
Parte = vbNullString
'los nros de descomponen al estilo notacional corriente... ej. 1.000.000
'donde el . (punto) es el separador de millares
'=====determinar el limite del bucle=======
'ej... el nro 100.000 tiene dos partes de 3 cifras por lo que
'de acuerdo el algoritmo de abajo el limite es 2. En el nro 1.100.123
'se tiene dos partes de 3 cifras y una de una cifra pero el bucle se debe ejecutar
'3 veces para poder tomar tb. el '1', ya que las porciones '100' y '123' cumplen
'con las condiciones de 3 cifras... para el caso del '1' se correrá el algoritmo
'correspondiente para comvertirlo a '001' y formar asi el nro 001.100.123 compatible
If (Len(Nro) / 3) > (Round(Len(Nro) / 3)) Then
Limit = Round(Len(Nro) / 3) + 1
Else
Limit = Len(Nro) / 3
End If
For i = 1 To Limit
Debug.Print Nro
If Len(Nro) < 3 Then 'para nros de de longitud menor a 3, nunca debe entrar a la 1ra.
Nro = String(3 - Len(Nro), "0") & Nro
'Nro = Right(Nro, Len(Nro))
'MsgBox Nro
Leer (Nro) 'pasa el arg. a la funcion de lectura
Debug.Print Nro
Else
Parte = Right(Nro, 3) 'leer las ultimas 3 cifras del nro
Debug.Print Parte
Leer (Parte)
Nro = Left(Nro, Len(Nro) - 3) 'extraer la parte leida de la cadena original
Debug.Print Nro 'y reasignar a la var original el resto de la
'cadena descompuesta
End If
Next
SetearNro = True
Exit Function
Error:
MsgBox Err.Description
SetearNro = False
End Function
Private Sub Command1_Click()
Dim ok As Boolean
ok = SetearNro
If ok = False Then
Exit Sub
End If
'==========================================
'diferenciar los millones, miles y centenas
'==========================================
Dim Texto As String
Texto = vbNullString
If Lect(3) <> vbNullString Then 'millones
If nLect(3) = 1 Then
Texto = "Un millón "
Else
Texto = Lect(3) & " millones "
End If
End If
If Lect(2) <> vbNullString Then 'miles
'If nLect(2) = 1 Then
' Texto = Texto & Lect(2) & " mil "
'Else
Texto = Texto & Lect(2) & " mil "
'End If
End If
If Lect(1) <> vbNullString Then 'centenas
Texto = Texto & Lect(1)
End If
Texto = Trim(Texto) 'sacar de la cadena los espacios en blanco en ambos lados
'MsgBox Texto, , "TEXTO SIN FORMATO TITULO"
MsgBox Estilo(Texto) 'texto en estilo titulo.
'Ej. "ani reñembotavy nde tembo" se verá
'como "Ani Reñembotavy Nde Tembo"
'================
' Reinicializar
'================
Grupo = 0
For i = 1 To UBound(Lect, 1)
Lect(i) = vbNullString
nLect(i) = 0
Next
End Sub
Function Estilo(Texto As String) As String
'On Error Resume Next
Dim i As Integer, Pos As String, SubStrPre As String, SubStrPos As String
Dim MayusChar As String
Dim Char As String
Dim n As String
For i = 1 To Len(Texto)
Pos = InStr(i, Texto, " ") 'buscar espacios en blanco
Debug.Print Pos
Char = Mid(Texto, Pos + 1, 1) 'extraer el caracter luego del espacio en blaco
Debug.Print Char
SubStrPre = Left(Texto, Pos) 'extraer al cadena anterior al caracter
Debug.Print SubStr
SubStrPos = Right(Texto, Len(Texto) - (Pos + 1)) 'extraer la cadena posterior al char
Debug.Print SubStrPos
MayusChar = UCase(Char) 'convertir el char a su version muyuscula
Texto = SubStrPre & MayusChar & SubStrPos 'concatenar la cadena anterior el caracter
'y la cadena posterior en la var original
Debug.Print Texto
Next
Estilo = Texto
End Function
Private Sub Command3_Click()
MsgBox Estilo(Text1.Text)
End Sub
Private Sub Form_Load()
'VECTORES DE CADENAS
Unidades(1) = "uno"
Unidades(2) = "dos"
Unidades(3) = "tres"
Unidades(4) = "cuatro"
Unidades(5) = "cinco"
Unidades(6) = "seis"
Unidades(7) = "siete"
Unidades(8) = "ocho"
Unidades(9) = "nueve"
Especiales(11) = "once"
Especiales(12) = "doce"
Especiales(13) = "trece"
Especiales(14) = "catorce"
Especiales(15) = "quince"
Especiales(16) = "dieciseis"
Especiales(17) = "diecisiete"
Especiales(18) = "dieciocho"
Especiales(19) = "diecinueve"
Decenas(1) = "diez"
Decenas(2) = "veinte"
Decenas(3) = "treinta"
Decenas(4) = "cuarenta"
Decenas(5) = "cincuenta"
Decenas(6) = "sesenta"
Decenas(7) = "setenta"
Decenas(8) = "ochenta"
Decenas(9) = "noventa"
Centenas(1) = "ciento"
Centenas(2) = "doscientos"
Centenas(3) = "trescientos"
Centenas(4) = "cuatrocientos"
Centenas(5) = "quinientos"
Centenas(6) = "seiscientos"
Centenas(7) = "setecientos"
Centenas(8) = "ochocientos"
Centenas(9) = "novecientos"
'Veinti = "veinti"
'Millar = "mil"
End Sub
Mostrar Mensajes
