تبدیل عدد به حرف

[Hassan2500]

سلام

کدی میخوام که اعداد رو به حروف تبدیل کنه(فقط دو تا تکست باشه در اولی عدد بنویسیم در دومی نتیجه رو نشون بده)

حروف ابجد و اعداد کبیر هر حرف
ا1-ب2-ج3-د4-ه5-و6-ز7-ح8-ط9-ي10-ك20- ل30-م40-ن50-س60-ع70-ف80-ص90-ق100-ر200-ش300-ت400-ث500-خ600-ذ700-ض800-ظ900-غ1000

مثلاً
1 بشود ا - 2 بشود ب - 10 بشود ي - 12 بشود ب ي - 20 بشود ك - 25 بشود ه ك - 30 بشود ل - 90 بشود ص - 100 بشود ق - 101 بشود ا ق - 111 بشود ا ي ق - 300 بشود ش - 900 بشود بشود ظ - 1000 بشود غ - 1001 بشود ا غ - 1100 بشود ق غ - 1999 بشود ط ص ظ غ

از 1999 قاعده فرق میکند که 2000 میشود ب غ - 3000 میشود ج غ - 4000 میشود د غ - و...

مثلاً
2000 بشود ب غ - 2001 بشود ا ب غ - 2010 بشود ي ب غ - 2101 بشود ا ق ب غ - 3000 بشود ج غ - 8656 بشود و ن خ ح غ - 9999 بشود ط ص ظ ط غ - 10000 بشود ي غ - 10001 بشود ا ي غ - 10010 بشود ي ي غ - 10011 بشود ا ي ي غ - 10255 بشود ه ن ر ي غ - 13555 بشود ه ن ث ج ي غ

و و قتی تعداد ارقام عدد بیشتر میشود تبدیل به حرفش فرق میکند و میخام این کدو اگه میشه جوری بنویسید که اگه ارقام عدد رو هم خواستم بیشتر هم کنم بشه این کار رو کرد یعنی بتونم ویرایشش کنم.

[m.4.r.m]

یه روش با Select case میهش نوشت اما زیاد میشه روش دیگه استفاده از فایل یا بانک اطلاعاتی هست .

این روش سادس :
Select Case Text1.Text
Case 1
Text2 = "ã"
Case 2
Text2 = "Ž"
Case 2000
Text2 = "Ú"
Case ""
Text2 = Empty
End Select

روش فایل هم که یا بانک باید یه ستون اعداد رو بنویسی یه ستون حروف رو بعد میای 2 تا تکست و یه Adodc وصل می کنی تکست اولی مقدار Field رو میگیری ستون 1 و تکست 2 مقدارشو میگیری Field حروف به همین راحتی .

بازم خواستی بگو کمکت کنم

[Hassan2500]

سلام

وقتی این کدو تو قسمت Text1_Change مینویسم برنامه کار نمیکند راستش رو اگه بخواهید من برنامه نویسیم ضعیفه اگه میشه سورسشو برام بزار

[Hassan2500]

کسی نیست جواب بده

[SlowCode]

توی رویداد keydown یا keypress امتحان کن.

[Hassan2500]

کسی نیست یه کد صحیح و کاملی بزاره

[بهروز عباسی]

شرمنده شاید اونی نباشه که خواستی ولی میشه اگه کمی روش کا کنی
Option Explicit

Dim bNumToWordInit As Boolean

Dim strNumberWords(19) As String
Dim strNumberGroups(10) As String
Dim strNumberTenWords(2 To 9) As String
Private Sub InitNumToWords()

'array for values 0 to 19
strNumberWords(0) = "zero"
strNumberWords(1) = "one"
strNumberWords(2) = "two"
strNumberWords(3) = "three"
strNumberWords(4) = "four"
strNumberWords(5) = "five"
strNumberWords(6) = "six"
strNumberWords(7) = "seven"
strNumberWords(8) = "eight"
strNumberWords(9) = "nine"
strNumberWords(10) = "ten"
strNumberWords(11) = "eleven"
strNumberWords(12) = "twelve"
strNumberWords(13) = "thirteen"
strNumberWords(14) = "fourteen"
strNumberWords(15) = "fifteen"
strNumberWords(16) = "sixteen"
strNumberWords(17) = "seventeen"
strNumberWords(18) = "eightteen"
strNumberWords(19) = "nineteen"

'array for 10's digit
strNumberTenWords(2) = "twenty"
strNumberTenWords(3) = "thirty"
strNumberTenWords(4) = "forty"
strNumberTenWords(5) = "fifty"
strNumberTenWords(6) = "sixty"
strNumberTenWords(7) = "seventy"
strNumberTenWords(8) = "eighty"
strNumberTenWords(9) = "ninety"


'array for number groups
strNumberGroups(1) = "thousand"
strNumberGroups(2) = "million"
strNumberGroups(3) = "billion"
strNumberGroups(4) = "trillion"

'set flag
bNumToWordInit = True

End Sub


Public Function NumberToWords(ByVal vNumber, Optional bMoney As Boolean = False) As String

Dim strTemp As String
Dim strChar As String
Dim strWhole As String
Dim strDecimal As String

Dim lNumberGroupCount As Long
Dim lDecimalPos As Long
Dim loop1 As Long
Dim dTemp As Double


'intiqalize the arrays (if not yet done)
If Not bNumToWordInit Then
InitNumToWords
End If

'make sure it's a valid number
If Not IsNumeric(vNumber) Then
NumberToWords = "Invalid Number"
Exit Function
End If
If Abs(Val(vNumber)) >= 999999999999999# Then
NumberToWords = "Number too big"
Exit Function
End If

strTemp = CStr(vNumber)

'clean up non-numerics
strTemp = Replace(strTemp, "$", "")
strTemp = Replace(strTemp, ",", "")
strTemp = Replace(strTemp, " ", "")

'convert '(number)' to '-number'
If Left$(strTemp, 1) = "(" And Right$(strTemp, 1) = ")" Then
strTemp = "-" & Mid$(strTemp, 2, Len(strTemp) - 2)
End If

'find the decimal
lDecimalPos = InStr(1, strTemp, ".")

'if there is a decimal
If lDecimalPos > 0 Then
'get integer part
strWhole = Left$(strTemp, lDecimalPos - 1)
'get the fractional part
strDecimal = Right$(strTemp, Len(strTemp) - lDecimalPos)
If strDecimal = "" Then strDecimal = "0"
'if optional money param is true
If bMoney Then
'handle >2 digit decimal
If Len(strDecimal) > 2 Then
strDecimal = CStr(CInt(Val("." & strDecimal) * 100))
'handle <2 digit decimal
ElseIf Len(strDecimal) < 2 Then
strDecimal = Left(strDecimal & "00", 2)
End If
End If
Else 'otherwise
If bMoney Then
strDecimal = "0"
End If
strWhole = strTemp
End If


vNumber = Val(strWhole)

'handle negatives
If vNumber < 0 Then
NumberToWords = "negative"
vNumber = Abs(vNumber)
End If

'if the number is as least 1
If vNumber > 0 Then

'get count of three digit number groups (log base 1000)
lNumberGroupCount = Int(Log(CDbl(vNumber)) / Log(1000))

'if the number has more that the "hundreds" group
If lNumberGroupCount > 0 Then
'get the hundres value of the current group
dTemp = vNumber / (1000 ^ lNumberGroupCount)
dTemp = Int(dTemp)

'build the output by recursively calling this function and
'getting the Group word from the array
NumberToWords = Trim$(NumberToWords(dTemp)) & " " & strNumberGroups(lNumberGroupCount)
'if the remainder is more than 0
If vNumber - (dTemp * 1000 ^ lNumberGroupCount) > 0 Then
NumberToWords = NumberToWords & " " & _
NumberToWords(vNumber - (dTemp * 1000 ^ lNumberGroupCount))
End If
Else

'if the number is at least 100
If vNumber > 99 Then

'get the number word for the hundreds digit
NumberToWords = Trim$(NumberToWords & _
" " & strNumberWords(Int(vNumber / 100)) & " hundred")

'subtract from the number
vNumber = vNumber Mod 100 '- 100 * Int(vNumber / 100)
End If

'if the remaining value is at least 20
If vNumber > 19 Then

'append the the number word for the 10's digit
NumberToWords = Trim$(NumberToWords & _
" " & strNumberTenWords(Int(vNumber / 10)))

'subtract from the number
vNumber = vNumber Mod 10 '- 10 * Int(vNumber / 10)

'if the remainder is at least 1
If vNumber > 0 Then
'append the the number word for the 1's digit
NumberToWords = Trim$(NumberToWords & " " & strNumberWords(vNumber))
End If
Else ' otherwise (less than 20)
'if the remainder is at least 1
If vNumber > 0 Then
'append the number word for less than 20
NumberToWords = Trim$(NumberToWords & " " & strNumberWords(vNumber))
End If
End If
End If
Else 'otherwise (less than 1 i.e. 0)
NumberToWords = "zero"
End If

'if optional Money parameter is true
If bMoney Then
'format as money
NumberToWords = Trim$(NumberToWords & " dollars and")
NumberToWords = NumberToWords & " " & NumberToWords(strDecimal)
NumberToWords = Trim$(NumberToWords & " cents")
Else
'if there is a decimal portion
If strDecimal <> "" Then
'append the word point
NumberToWords = Trim$(NumberToWords & " point")
'build the decimal portion
For loop1 = 1 To Len(strDecimal)
strChar = Mid$(strDecimal, loop1, 1)
NumberToWords = NumberToWords & " " & strNumberWords(Val(strChar))
Next 'loop1
End If
End If
End Function
Rem for test
Private Sub Command1_Click()
Text2.Text = NumberToWords(Text1.Text)
End Sub