[Resolvido] Colocando Números por extenso

[Ted k' 126]

ASP

<%

Dim a, b, c, d, e, f, g, h( 900 ), i( 6 ), j( 6 ), k, l

 

i( 1 ) = "rea"

i( 2 ) = "mil"

i( 3 ) = "milh"

i( 4 ) = "bilh"

i( 5 ) = "trilh"

 

h( 1 ) = "um"

h( 2 ) = "dois"

h( 3 ) = "tres"

h( 4 ) = "quatro"

h( 5 ) = "cinco"

h( 6 ) = "seis"

h( 7 ) = "sete"

h( 8 ) = "oito"

h( 9 ) = "nove"

h( 10 ) = "dez"

h( 11 ) = "onze"

h( 12 ) = "doze"

h( 13 ) = "treze"

h( 14 ) = "quatorze"

h( 15 ) = "quinze"

h( 16 ) = "dezesseis"

h( 17 ) = "dezessete"

h( 18 ) = "dezoito"

h( 19 ) = "dezenove"

h( 20 ) = "vinte"

h( 30 ) = "trinta"

h( 40 ) = "quarenta"

h( 50 ) = "cinquenta"

h( 60 ) = "sessenta"

h( 70 ) = "setenta"

h( 80 ) = "oitenta"

h( 90 ) = "noventa"

h( 100 ) = "cento"

h( 200 ) = "duzentos"

h( 300 ) = "trezentos"

h( 400 ) = "quatrocentos"

h( 500 ) = "quinhentos"

h( 600 ) = "seiscentos"

h( 700 ) = "setentos"

h( 800 ) = "oitocentos"

h( 900 ) = "novecentos"

 

Function Extenso( e )

e = FormatNumber( e , 2 )

a = right( e , 2 )

j( 0 ) = 0

f = Int( ( len( e ) + 1 ) / 4 )

 

For b = 1 to f

j( b ) = ""

Next

 

b = 1

c = 1

For d = len( e ) - 3 to 1 step -1

j( c ) = mid( e , d , 1 ) & j( c )

If b / 3 = Int( b / 3 ) Then

c = c + 1

d = d - 1

End If

b = b + 1

next

g = 0

Extenso = ""

               

For b = f to 1 step -1

g = g + Int( j( b ) )

 

If Int( j( b ) ) <> 0 or ( Int( j( b ) ) = 0 And b = 1 )Then

If Int( j( b ) = 0 And Int( j( b + 1 ) ) = 0 And b = 1 )Then

Extenso = Extenso & ExtCentena( j( b ) , g ) & " de " & i( b )

Else

Extenso = Extenso & ExtCentena( j( b ) , g ) & " " & i( b )

End If

If Int( j( b ) ) <> 1 or ( b = 1 And g <> 1 ) Then

Select Case b

Case 1

Extenso = Extenso & "is"

Case 3, 4, 5

Extenso = Extenso & "ões"

End Select             

Else

Select Case b

Case 1

Extenso = Extenso & "l"

Case 3, 4, 5

Extenso = Extenso & "ão"

End Select             

End If

End If

If Int( j( b - 1 ) ) = 0 Then

Extenso = Extenso

Else

If ( Int( j( b + 1 ) ) = 0 And ( b + 1 ) <= f ) or ( b = 2 ) Then

Extenso = Extenso & " e "

Else

Extenso = Extenso & ", "

End If

End If         

Next

 

If a > 0 Then

If Int( a ) = 1 Then

Extenso = Extenso & " e " & ExtDezena( a ) & " centavo"

Else

Extenso = Extenso &  " e " & ExtDezena( a ) & " centavos"

End If

End If

Extenso = UCase( Left( Extenso , 1 ) )&right( Extenso , len( Extenso ) - 1 )

End Function

 

Function ExtDezena( k )

ExtDezena = ""

If Int( k ) > 0 Then

If Int( k ) < 20 Then

ExtDezena = h( Int( k ) )

Else

ExtDezena = h( Int( Int( k ) / 10 ) * 10 )

If ( Int( k ) / 10 ) - Int( Int( k ) / 10 ) <> 0 Then

ExtDezena = ExtDezena & " e " & h( Int( right( k , 1 ) ) )

End If

End If

End If

End Function

 

Function ExtCentena( k, l )

ExtCentena = ""

 

If Int( k ) > 0 Then

If Int( k ) = 100 Then

ExtCentena = "cem"

Else

If Int( k ) < 20 Then

If Int( k ) = 1 Then

If l - Int( k ) = 0 Then

ExtCentena = "hum"

Else

ExtCentena = h( Int( k ) )

End If

Else

ExtCentena = h( Int( k ) )

End If

Else

If Int( k ) < 100 Then

ExtCentena = ExtDezena( right( k , 2 ) )

Else                           

ExtCentena = h( Int( Int( k ) / 100 )*100 )

If ( Int( k ) / 100 ) - Int( Int( k ) / 100 ) <> 0 Then

ExtCentena = ExtCentena & " e " & ExtDezena( right( k , 2 ) )

End If

End If

End If

End If

End If

End Function

response.write Extenso(20.30)

%>

 

estou livre para aprimoramentos do código.... abraços a todos....

 

Ted k'