number into words

[Cyrus]

in my oldays in doing DOS program I written Function that converts number figures into words and have the condition to break the words into 2 phrases if length exceed stated len. I converted this to VB6 problem is source is long . Does anybody knows if theres is VB function for this, or smaller coding.

thank in advance and god bless
cyrus

[Shiv Kumar G.M.]

Option Explicit

Private Sub cmdConvert_Click()
txtResult = NumToText(Val(txtNumber))
txtNumber.SelStart = 0
txtNumber.SelLength = Len(txtNumber)
txtNumber.SetFocus
End Sub

Private Sub cmdExit_Click()
Unload Me
End Sub

Private Function NumToText(dblVal As Double) As String
Static Ones(0 To 9) As String
Static Teens(0 To 9) As String
Static Tens(0 To 9) As String
Static Thousands(0 To 4) As String
Static bInit As Boolean
Dim i As Integer, bAllZeros As Boolean, bShowThousands As Boolean
Dim strVal As String, strBuff As String, strTemp As String
Dim nCol As Integer, nChar As Integer

'Only handles positive values
Debug.Assert dblVal >= 0

If bInit = False Then
'Initialize array
bInit = True
Ones(0) = "zero"
Ones(1) = "one"
Ones(2) = "two"
Ones(3) = "three"
Ones(4) = "four"
Ones(5) = "five"
Ones(6) = "six"
Ones(7) = "seven"
Ones(8) = "eight"
Ones(9) = "nine"
Teens(0) = "ten"
Teens(1) = "eleven"
Teens(2) = "twelve"
Teens(3) = "thirteen"
Teens(4) = "fourteen"
Teens(5) = "fifteen"
Teens(6) = "sixteen"
Teens(7) = "seventeen"
Teens(8) = "eighteen"
Teens(9) = "nineteen"
Tens(0) = ""
Tens(1) = "ten"
Tens(2) = "twenty"
Tens(3) = "thirty"
Tens(4) = "forty"
Tens(5) = "fifty"
Tens(6) = "sixty"
Tens(7) = "seventy"
Tens(8) = "eighty"
Tens(9) = "ninety"
Thousands(0) = ""
Thousands(1) = "thousand" 'US numbering
Thousands(2) = "million"
Thousands(3) = "billion"
Thousands(4) = "trillion"
End If
'Trap errors
On Error GoTo NumToTextError
'Get fractional part
strBuff = "and " & Format((dblVal - Int(dblVal)) * 100, "00") & "/100"
'Convert rest to string and process each digit
strVal = CStr(Int(dblVal))
'Non-zero digit not yet encountered
bAllZeros = True
'Iterate through string
For i = Len(strVal) To 1 Step -1
'Get value of this digit
nChar = Val(Mid$(strVal, i, 1))
'Get column position
nCol = (Len(strVal) - i) + 1
'Action depends on 1's, 10's or 100's column
Select Case (nCol Mod 3)
Case 1 '1's position
bShowThousands = True
If i = 1 Then
'First digit in number (last in loop)
strTemp = Ones(nChar) & " "
ElseIf Mid$(strVal, i - 1, 1) = "1" Then
'This digit is part of "teen" number
strTemp = Teens(nChar) & " "
i = i - 1 'Skip tens position
ElseIf nChar > 0 Then
'Any non-zero digit
strTemp = Ones(nChar) & " "
Else
'This digit is zero. If digit in tens and hundreds column
'are also zero, don't show "thousands"
bShowThousands = False
'Test for non-zero digit in this grouping
If Mid$(strVal, i - 1, 1) <> "0" Then
bShowThousands = True
ElseIf i > 2 Then
If Mid$(strVal, i - 2, 1) <> "0" Then
bShowThousands = True
End If
End If
strTemp = ""
End If
'Show "thousands" if non-zero in grouping
If bShowThousands Then
If nCol > 1 Then
strTemp = strTemp & Thousands(nCol \ 3)
If bAllZeros Then
strTemp = strTemp & " "
Else
strTemp = strTemp & ", "
End If
End If
'Indicate non-zero digit encountered
bAllZeros = False
End If
strBuff = strTemp & strBuff
Case 2 '10's position
If nChar > 0 Then
If Mid$(strVal, i + 1, 1) <> "0" Then
strBuff = Tens(nChar) & "-" & strBuff
Else
strBuff = Tens(nChar) & " " & strBuff
End If
End If
Case 0 '100's position
If nChar > 0 Then
strBuff = Ones(nChar) & " hundred " & strBuff
End If
End Select
Next i
'Convert first letter to upper case
strBuff = UCase$(Left$(strBuff, 1)) & Mid$(strBuff, 2)
EndNumToText:
'Return result
NumToText = strBuff
Exit Function
NumToTextError:
strBuff = "#Error#"
Resume EndNumToText
End Function

[John G Duffy]

Here is a list of hits on planet-Source-Code.com/vb I got when I searched on "Numbers to Text" there may be more to find if you alter the search argument. Check out the second page. It contains hits more to your liking
http://www.planet-source-code.com/vb...umbers+to+text

John G