Find Code:
All Words
Any of the Words
Exact Phrase
Home
:
Code
:
Forums
:
Submit
:
Mailing List
:
About
:
Contact
Code
All
VB.NET
ASP.NET
C#
VB Classic
ASP Classic
Snippets
Popular
Resources
Submit Code
Forums
Articles
Tips
Links
Books
Contest
Link to us
After reading a plead for help (okay, slight exagg...
Author:
KrazyGamer
E-mail:
Click to e-mail author
Submitted:
6/4/2001
Version:
VB3
Compatibility:
VB3, VB4, VB5, VB6
Category:
String Manipulation
Views:
9385
After reading a plead for help (okay, slight exaggeration) in the forum, I've decided to endevour to make a function that can convert integers to actual text. It's pretty handy and bug-free (as far as I know). You can also disable the "and" in the result, too. Example: Four Hundred and Four -> Four Hundred Four To use, just type msgbox convertIntegerToWords("191").
Declarations:
'none
Code:
Function convertIntegerToWords$(intstr$) '=============================================== 'This cool function was created by KrazyGamer (krazygamer@hotmail.com). 'I left town one day and I decided to make an integer-to-text conversion 'program. The only problem was I didn't have VB at that computer; I had 'QBASIC, which was essentially the same, so I used it. There are ways to 'optimize the code, but I'm too lazy to do so ^_^;. Anyhoo, this function 'can convert integers up to 99999. Not enough? Implement it yourself. >=] '================================================ 'June 3, 2001 showAnd = 1 'set to 0 if you don't want the product to contain "and" '-==[ DO NOT EDIT BEYOND THIS POINT UNLESS YOU KNOW WHAT YOU'RE DOING! ]==- For j = 1 To Len(intstr$) a = Asc(Mid$(intstr$, j, 1)) If a < 48 Or a > 57 Then convertIntegerToWords$ = "Only integers allowed.": Exit Function Next Dim ones(19) As String 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" ones(10) = "Ten" ones(11) = "Eleven" ones(12) = "Twelve" ones(13) = "Thirteen" ones(14) = "Fourteen" ones(15) = "Fifteen" ones(16) = "Sixteen" ones(17) = "Seventeen" ones(18) = "Eighteen" ones(19) = "Nineteen" Dim tens(9) As String 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" intstr$ = LTrim$(RTrim$(intstr$)) Do a = InStr(intstr$, ",") If a < 1 Then Exit Do intstr$ = Left$(intstr$, a - 1) + Mid$(intstr$, a + 1) a = InStr(intstr$, ",") If a < 1 Then Exit Do Loop LoS = Len(LTrim$(RTrim$(Str$(Val(intstr$))))) ogstr = Val(intstr$) Select Case LoS Case Is < 3 If ogstr < 20 Then convertIntegerToWords$ = ones(ogstr) Else u = Val(Mid$(LTrim$(RTrim$(Str$(ogstr))), 1, 1)) kg$ = ones(Val(Mid$(LTrim$(RTrim$(Str$(ogstr))), 2, 1))) If kg$ <> "" Then convertIntegerToWords$ = tens(u) + "-" + kg$ Else convertIntegerToWords$ = tens(u) End If Exit Function End If Case Is < 7 If LoS = 3 Then lu$ = LTrim$(RTrim$(Str$(ogstr))) au = Val(Mid$(lu$, 1, 1)) bu = Val(Mid$(lu$, 2, 1)) cu = Val(Mid$(lu$, 3, 1)) If au > 0 Then retval$ = ones(au) + " Hundred " If bu = 0 And cu = 0 Then GoTo 10 If bu > 1 Then If showAnd = 1 Then retval$ = retval$ + "and " retval$ = retval$ + tens(bu) End If If bu = 1 Then If showAnd = 1 Then retval$ = retval$ + "and " retval$ = retval$ + ones(Val(Mid$(lu$, 2))): GoTo 10 End If If cu > 0 And bu > 0 Then retval$ = retval$ + "-" If bu = 0 And showAnd = 1 Then retval$ = retval$ + "and " retval$ = retval$ + ones(cu) 10 convertIntegerToWords$ = LTrim$(RTrim$(retval$)) Exit Function ElseIf LoS = 4 Then lu$ = LTrim$(RTrim$(Str$(ogstr))) fu = Val(Mid$(lu$, 1, 1)) au = Val(Mid$(lu$, 2, 1)) bu = Val(Mid$(lu$, 3, 1)) cu = Val(Mid$(lu$, 4, 1)) retval$ = ones(fu) + " Thousand " If au = 0 And bu = 0 And cu = 0 Then GoTo 20 If au > 0 Then retval$ = retval$ + ones(au) + " Hundred " If bu = 0 And cu = 0 Then GoTo 20 If bu > 1 Then If showAnd = 1 Then retval$ = retval$ + "and " retval$ = retval$ + tens(bu) End If If bu = 1 Then If showAnd = 1 Then retval$ = retval$ + "and " retval$ = retval$ + ones(Val(Mid$(lu$, 3, 2))): GoTo 20 End If If cu > 0 And bu > 0 Then retval$ = retval$ + "-" If bu = 0 And showAnd = 1 Then retval$ = retval$ + "and " retval$ = retval$ + ones(cu) 20 convertIntegerToWords$ = LTrim$(RTrim$(retval$)) Exit Function ElseIf LoS = 5 Then lu$ = LTrim$(RTrim$(Str$(ogstr))) fu = Val(Mid$(lu$, 1, 1)) eu = Val(Mid$(lu$, 2, 1)) au = Val(Mid$(lu$, 3, 1)) bu = Val(Mid$(lu$, 4, 1)) cu = Val(Mid$(lu$, 5, 1)) xu = Val(Mid$(lu$, 1, 2)) yu = Val(Mid$(lu$, 4, 2)) If xu < 20 Then retval$ = ones(xu) + " Thousand " Else If eu > 0 Then retval$ = tens(fu) + "-" + ones(eu) + " Thousand " If eu = 0 Then retval$ = tens(fu) + " Thousand " End If If au = 0 And bu = 0 And cu = 0 Then GoTo 30 If au > 0 Then retval$ = retval$ + ones(au) + " Hundred " If InStr(retval$, " and") < 1 And yu > 0 And showAnd = 1 Then retval$ = retval$ + "and " If yu < 20 Then retval$ = retval$ + ones(yu) Else retval$ = retval$ + tens(bu) + "-" + ones(cu) End If 30 Else convertIntegerToWords$ = "Value is too large; only integers up to 99999 allowed.": Exit Function End If convertIntegerToWords$ = LTrim$(RTrim$(retval$)) End Select End Function
Home
|
Forums
|
Submit
|
Books
|
Mailing List
|
Advertising
|
About
|
Contact
© 2024 A1VBCode. All rights reserved.
Legal disclaimer & terms of use
Privacy statement