Domino Code Fragment

Code Name*
extensive numeric value		Date*
05/12/1999		Source (or email address if you prefer)*
Alexsandre - [email protected] / Samantha - [email protected]
IP address:.172.70.127.175
Description*
Type*
LotusScript		Categories*
Numeric Processing
Implementation:
None (plug and play)		Required Client:
4.6		Server:
(none)
Limitations:
999.999.999,99
Nine hundred ninety nine billions... 		Comments:
Written by Alexsandre Andrade and Samantha Saavedra
Arboll Associados - Rio de Janeiro - Brazil
Files/Graphics attachments (if applicable): Code:
'********************************************************
'* 12/5/99 *
'* Written by Alexsandre Andrade and Samantha Saavedra *
'* Arboll Associados - Rio de Janeiro - Brazil *
'********************************************************

Sub Exiting(Source As Field)

Dim uidoc As NotesUIDocument
Dim wks As New NotesUIWorkspace
Dim session As New NotesSession
Dim db As NotesDatabase
Dim db2 As NotesDatabase
Dim notesdocument As NotesDocument
Dim view1 As notesview
Dim view2 As notesview
Dim dc As NotesDocumentCollection
Dim dc2 As NotesDocumentCollection
Dim doc1 As NotesDocument
Dim doc2 As NotesDocument
Dim docsubform As NotesDocument

'========================= Variaveis
Dim Chave As String
Dim nValor , IntCParte As Double
Dim nContador, nTamanho As Integer
Dim cValor, cFinal , cParte As String
Dim Extenso As String
Dim VARaTexto, aTexto, Var, VERCENT , VARCFINAL As String

'===================================

Set db=session.CurrentDatabase
Set uidoc=wks.CurrentDocument
Set doc=uidoc.Document

nValor = doc.Valor(0)
'Faz a validação do argumento
If Isnull(nValor) Or nValor <= 0 Or nValor > 9999999.99 Then
Exit Sub
End If

'Declara as variáveis da função

Redim aGrupo(4) As String
Redim aTexto(4) As String

'Define matrizes com extensos parciais
Redim aUnid(19) As String
aUnid(1) = "ONE "
aUnid(2) = "TWO "
aUnid(3) = "THREE "
aUnid(4) = "FOUR "
aUnid(5) = "FIVE "
aUnid(6) = "SIX "
aUnid(7) = "SEVEN "
aUnid(8) = "EIGHT "
aUnid(9) = "NINE "
aUnid(10) = "TEN "
aUnid(11) = "ELEVEN "
aUnid(12) = "TWELVE "
aUnid(13) = "THIRTEEN "
aUnid(14) = "FOURTEEN "
aUnid(15) = "FIFTEEN "
aUnid(16) = "SIXTEEN "
aUnid(17) = "SEVENTEEN "
aUnid(18) = "EIGHTEEN "
aUnid(19) = "NINETEEN "

Redim aDezena(9) As String
aDezena(1) = "TEN "
aDezena(2) = "TWENTY "
aDezena(3) = "THIRTY "
aDezena(4) = "FORTY "
aDezena(5) = "FIFTY "
aDezena(6) = "SIXTY "
aDezena(7) = "SEVENTY "
aDezena(8) = "EIGHTY "
aDezena(9) = "NINETY "

Redim aCentena(9) As String
aCentena(1) = "ONE HUNDRED "
aCentena(2) = "TWO HUNDRED "
aCentena(3) = "THREE HUNDRED "
aCentena(4) = "FOUR HUNDRED "
aCentena(5) = "FIVE HUNDRED "
aCentena(6) = "SIX HUNDRED "
aCentena(7) = "SEVEN HUNDRED "
aCentena(8) = "EIGHT HUNDRED "
aCentena(9) = "NINE HUNDRED "

'Divide o valor em vários grupos
cValor = Format$(nValor, "0000000000.00")
aGrupo(1) = Mid$(cValor, 2, 3)
aGrupo(2) = Mid$(cValor, 5, 3)
aGrupo(3) = Mid$(cValor, 8, 3)
aGrupo(4) = "0" & Mid$(cValor, 12, 2)

'Processa cada grupo

For nContador = 1 To 4
cParte = aGrupo(nContador)
IntCParte = Cdbl(cParte)
Select Case IntCParte
Case IntCParte = 0 To 10
nTamanho = 1
Case IntCParte =0 To 100
nTamanho = 2
Case IntCParte =0 To 1000
nTamanho = 3
End Select


'-------------------------------------------------------------
If nTamanho = 3 Then
If Right$(cParte, 2) <> "00" Then
aTexto(nContador) = aTexto(nContador) & aCentena(Left(cParte, 1)) & "AND "
nTamanho = 2
Else
If (Left$(cParte, 1)) = "1" Then
VARaTexto = "ONE HUNDRED "
Else
VARaTexto = (aCentena(Left(cParte, 1)))
End If
aTexto(nContador) = aTexto(nContador) & VARaTexto
End If
End If

'--------------------------------------------------------
If nTamanho = 2 Then
If Val(Right(cParte, 2)) < 20 Then
aTexto(nContador) = aTexto(nContador) & aUnid(Right(cParte, 2))
Else
aTexto(nContador) = aTexto(nContador) & aDezena(Mid(cParte, 2, 1))

If Right$(cParte, 1) <> "0" Then
nTamanho = 1
End If
End If
End If
'------------------------------------------------------------------------

If nTamanho = 1 Then
aTexto(nContador) = aTexto(nContador) & aUnid(Right(cParte, 1))
End If
Next

'Gera o formato final do texto
'------------------------------------------------------------------
If (Val(aGrupo(1)))= 0 And (Val(aGrupo(2))) = 0 And (Val(aGrupo(3))) = 0 And (Val(aGrupo(4))) <> 0 Then

If(Val(aGrupo(4))) = 1 Then
VERCENT = "CENT"
Else
VERCENT = "CENTS"

End If
cFinal = aTexto(4) & VERCENT


Else
cFinal = ""


If(Val(aGrupo(1))) <> 0 Then
VARCFINAL = aTexto(1)
If(Val(aGrupo(1))) > 1 Then
Var = "MILLION "
Else
Var = "MILLION "
End If
Else
VARCFINAL = ""
End If
cFinal = cFinal + VARCFINAL + Var



If(Val(aGrupo(2))) <> 0 Then
VARGRUPO = aTexto(2) + "THOUSAND, "
Else
VARGRUPO = ""
End If
cFinal = cFinal + VARGRUPO


If(Val(aGrupo(1))) = 1 And (Val(aGrupo(2))) = 1 And (Val(aGrupo(3))) = 1 Then
VARGRUPO2 = "DOLLAR"
Else
VARGRUPO2 = "DOLLARS"
End If
cFinal = cFinal + aTexto(3) + VARGRUPO2


If(Val(aGrupo(4))) <> 0 Then
VARGRUPO3 = ", " + aTexto(4)
If(Val(aGrupo(4))) = 1 Then
VARGRUPO3 = VARGRUPO3 + "CENT"
Else
VARGRUPO3 = VARGRUPO3 + "CENTS"
End If
Else
VARGRUPO3 = ""
End If
cFinal = cFinal + VARGRUPO3
End If
''------------------------------------------------------------------------
Extenso = cFinal
Msgbox Extenso
doc.Extenso = Extenso
End Sub