CÓDIGO: Escrever um Número por Extenso

O programa abaixo, escrito para Visual Basic, fornece um método para receber um número em formato contábil #,00 e retorna o seu significado por extenso através da função Moeda(Numero); ou, se o programador preferir, através da função Porcentagem(Numero). Ambas recebem e retornam um tipo String.

 


Function Conectivo(ByVal Numero As Integer, ByVal Termo As String) As String
    Dim Result As String
    If Numero = 0 Then
        Result = ""
    ElseIf Termo = "" Then
        Result = ""
    Else
        Result = " E "
    End If
    Conectivo = Result
End Function 

Function Unidade(ByVal Numero As String) As String
    Dim Aux As String, Result As String
    Numero = CStr(CInt(Trim(Numero)))
    Aux = Right(Numero, 1) 

    Select Case CInt(Aux)
        Case 1
            Result = "UM"
        Case 2
            Result = "DOIS"
        Case 3
            Result = "TRES"
        Case 4
            Result = "QUATRO"
        Case 5
            Result = "CINCO"
        Case 6
            Result = "SEIS"
        Case 7
            Result = "SETE"
        Case 8
            Result = "OITO"
        Case 9
            Result = "NOVE"
        Case Else
            Result = ""
    End Select
    Unidade = Result
End Function 

Function Dezena_Lote10(ByVal Numero As String) As String 

    Dim Aux As String, Result As String
    Numero = CStr(CInt(Trim(Numero)))
    Aux = Right(Numero, 2) 

    Select Case CInt(Aux)
        Case 11
            Result = "ONZE"
        Case 12
            Result = "DOZE"
        Case 13
            Result = "TREZE"
        Case 14
            Result = "CATORZE"
        Case 15
            Result = "QUINZE"
        Case 16
            Result = "DEZESSEIS"
        Case 17
            Result = "DEZESSETE"
        Case 18
            Result = "DEZOITO"
        Case 19
            Result = "DEZENOVE"
        Case Else
            Result = "DEZ"
    End Select 

    Dezena_Lote10 = Result
End Function 

Function Dezena(ByVal Numero As String) As String 

    Dim Aux As String, Result As String
    Numero = CStr(CInt(Trim(Numero)))
    Aux = Right(Numero, 2) 

    If CInt(Aux) <> 10 Then
        Aux = Left(Aux, 1)
        Select Case CInt(Aux)
            Case 1
                Result = Dezena_Lote10(Numero)
            Case 2
                Result = "VINTE" & _
                Conectivo(CInt(Aux), Unidade(Numero)) & _
                Unidade(Numero)
            Case 3
                Result = "TRINTA" & _
                Conectivo(CInt(Aux), Unidade(Numero)) & _
                Unidade(Numero)
            Case 4
                Result = "QUARENTA" & _
                Conectivo(CInt(Aux), Unidade(Numero)) & _
                Unidade(Numero)
            Case 5
                Result = "CINQUENTA" & _
                Conectivo(CInt(Aux), Unidade(Numero)) & _
                Unidade(Numero)
            Case 6
                Result = "SESSENTA" & _
               Conectivo(CInt(Aux), Unidade(Numero)) & _
               Unidade(Numero)
            Case 7
                Result = "SETENTA" & _
                Conectivo(CInt(Aux), Unidade(Numero)) & _
                Unidade(Numero)
            Case 8
                Result = "OITENTA" & _
                Conectivo(CInt(Aux), Unidade(Numero)) & _
                Unidade(Numero)
            Case 9
                Result = "NOVENTA" & _
                Conectivo(CInt(Aux), Unidade(Numero)) & _
                Unidade(Numero)
            Case Else
                Result = "" & Unidade(Numero)
        End Select
    Else
        Result = "DEZ"
    End If
    Dezena = Result
End Function 

Function Centena(ByVal Numero As String) As String
    Dim Aux As String, Result As String
    Numero = CStr(CInt(Trim(Numero)))
    Aux = Right(Numero, 3) 

    If CInt(Aux) <> 100 Then
        Aux = Left(Aux, 1)
        Select Case CInt(Aux)
            Case 1
                Result = "CENTO" & _
                Conectivo(CInt(Aux), Dezena(Numero)) & _
                Dezena(Numero)
            Case 2
                Result = "DUZENTOS" & _
                Conectivo(CInt(Aux), Dezena(Numero)) & _
                Dezena(Numero)
            Case 3
                Result = "TREZENTOS" & _
                Conectivo(CInt(Aux), Dezena(Numero)) & _
                Dezena(Numero)
            Case 4
                Result = "QUATROCENTOS" & _
                Conectivo(CInt(Aux), Dezena(Numero)) & _
                Dezena(Numero)
            Case 5
                Result = "QUINHENTOS" & _
                Conectivo(CInt(Aux), Dezena(Numero)) & _
                Dezena(Numero)
            Case 6
                Result = "SEISCENTOS" & _
                Conectivo(CInt(Aux), Dezena(Numero)) & _
                Dezena(Numero)
            Case 7
                Result = "SETECENTOS" & _
                Conectivo(CInt(Aux), Dezena(Numero)) & _
                Dezena(Numero)
            Case 8
                Result = "OITOCENTOS" & _
                Conectivo(CInt(Aux), Dezena(Numero)) & _
                Dezena(Numero)
            Case 9
                Result = "NOVECENTOS" & _
                Conectivo(CInt(Aux), Dezena(Numero)) & _
                Dezena(Numero)
            Case Else
                Result = Dezena(Numero)
        End Select
    Else
        Result = "CEM"
    End If
    Centena = Result
End Function 

Function CentenaMilhar(ByVal Numero As String) As String
    Dim Result As String, Aux As String, Conjuncao As String
    Numero = CStr(CInt(Trim(Numero)))
    Aux = Numero
    If Centena(Right(Aux, 3)) = "" And Len(Aux) > 3 Then
        Conjuncao = ""
    Else
        Conjuncao = "E "
    End If 

    Select Case Len(Aux)
        Case 1
            Result = Unidade(Aux)
        Case 2
            Result = Dezena(Aux)
        Case 3
            Result = Centena(Aux)
        Case 4
            Result = Unidade(Left(Aux, 1)) & " MIL " & _
        Conjuncao & Centena(Aux)
        Case 5
            Result = Dezena(Left(Aux, 2)) & " MIL " & _
            Conjuncao & Centena(Aux)
        Case 6
            Result = Centena(Left(Aux, 3)) & " MIL " & _
            Conjuncao & Centena(Aux)
        Case Else
            Result = ""
    End Select
    CentenaMilhar = Result
End Function 

Function CentenaMilhao(ByVal Numero As String) As String
    Dim Result As String, Aux As String
    Numero = CStr(CInt(Trim(Numero)))
    Aux = Numero
    Select Case Len(Aux)
        Case 7
            If CInt(Left(Aux, 1)) = 1 Then
                Result = Unidade(Left(Aux, 1)) & _
                " MILHAO " & CentenaMilhar(Right(Aux, 6))
            Else
                Result = Unidade(Left(Aux, 1)) & _
                " MILHOES " & CentenaMilhar(Right(Aux, 6))
            End If
        Case 8
            Result = Dezena(Left(Aux, 2)) & _
            " MILHOES " & CentenaMilhar(Right(Aux, 6))
        Case 9
            Result = Centena(Left(Aux, 3)) & _
            " MILHOES " & CentenaMilhar(Right(Aux, 6))
        Case Else
            Result = CentenaMilhar(Aux)
    End Select
    CentenaMilhao = Result
End Function 

Function Moeda(ByVal Numero As String) As String
    Dim Result As String, Direito As String, M_Direito As String
    Dim Esquerdo As String, M_Esquerdo As String
    Dim Teste As Boolean
    Numero = Trim(Numero)
    If Len(Numero) < 3 Then
        Result = "NULL"
    Else
        Result = ""
        Direito = CStr(CInt(Right(Numero, 2)))
        Esquerdo = CStr(CInt(Left(Numero, Len(Numero) – 3))) 

        If CInt(Esquerdo) = 1 Then
            M_Esquerdo = " REAL"
        ElseIf CInt(Esquerdo) = 0 Then
            M_Esquerdo = " "
        Else
           Teste = CInt(Left(Esquerdo, 1)) = 1 And _
           CInt(Right(Esquerdo, Len(Esquerdo) – 1)) = 0
           Teste = Teste And Len(Esquerdo) > 6
            If Teste Then
                M_Esquerdo = " DE"
            Else
                M_Esquerdo = ""
            End If
                M_Esquerdo = M_Esquerdo & " REAIS" 

        End If 

        If CInt(Direito) = 1 Then
            M_Direito = " CENTAVO"
        ElseIf CInt(Direito) = 0 Then
            M_Direito = " "
        Else
            M_Direito = " CENTAVOS"
        End If 

        If CentenaMilhao(Esquerdo) <> "" Then
            Result = CentenaMilhao(Esquerdo) & M_Esquerdo
        End If 

        If CentenaMilhao(Direito) <> "" Then
            If Result = "" Then
                Result = CentenaMilhao(Direito) & M_Direito
            Else
                Result = Result & " E " & _
                CentenaMilhao(Direito) & M_Direito
            End If
        End If
    End If
    Moeda = Result
End Function 

Function Porcentagem(ByVal Numero As String) As String
    Dim Result As String, Direito As String, M_Direito As String
    Dim Esquerdo As String, M_Esquerdo As String, Conjuncao As String 

    Numero = Trim(Numero)
    Result = ""
    Esquerdo = ""
    Direito = ""
    M_Esquerdo = ""
    Conjuncao = "" 

    If Len(Numero) < 3 Then
        Result = "NULL"
    Else
        Direito = Right(Numero, 2)
        Esquerdo = CStr(CInt(Left(Numero, Len(Numero) – 3)))
        If CInt(Esquerdo) = 0 Then
            M_Esquerdo = " ZERO PORCENTO"
        Else
            M_Esquerdo = " PORCENTO"
        End If
    End If 

    If CInt(Direito) = 0 Then
        M_Direito = ""
   ElseIf CInt(Left(Direito, 1)) > 0 And _
          CInt(Right(Direito, 1)) = 0 Then
        Direito = Left(Direito, 1)
        Conjuncao = " E "
        M_Direito = " DECIMO"
        If CInt(Left(Direito, 1)) > 1 Then
            M_Direito = M_Direito & "S"
        End If
    Else
        Conjuncao = " E "
        M_Direito = " CENTESIMO"
        If CInt(Direito) > 1 Then
            M_Direito = M_Direito & "S"
        End If
    End If
    Result = CentenaMilhao(Esquerdo) & M_Esquerdo & _
    Conjuncao & CentenaMilhao(Direito) & M_Direito
    Porcentagem = Result
End Function


Anúncios

Os comentários estão desativados.