این برنامه یک عدد را تا 11 رقم گرفته و آن را به حروف تبدیل میکندو حروف نوشته شده را از طریق بلندگو پخش می کند. ببخشید من هنوز اجازه پیوست فایل ندارم اما چون این برنامه بدون فایل های صدا کار نمیکنه اگه کسی خواست بگه تا اصلش رو براش میل کنم. این هم کد:
کد:Const strh = "hundred"
Const strb = "bilion"
Public s As String
Dim strt1 As String, strm As String
Dim i As Integer
Private Declare Function sndPlaySound Lib "winmm.dll" _
Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Private Sub Command1_Click()
If IsNumeric(Text1.Text) = True Then
Me.Cls
Me.CurrentX = Me.Left \ 2
Me.CurrentY = Me.Top \ 2
adad = Abs(Val(Text1.Text))
lent = Len(adad)
Select Case lent
Case Is > 9
s1 = yek(Mid(Text1.Text, 1, lent - 9)) & " " & strb & " "
s2 = yek(Mid(Text1.Text, lent - 8, 3)) & " " & strm & " "
s3 = yek(Mid(Text1.Text, lent - 5, 3)) & " " & strt1 & " "
s4 = yek(Mid(Text1.Text, lent - 2, 3)) & " "
Case 7 To 9
s1 = yek(adad \ 1000000) & " " & strm & " "
s2 = yek((adad Mod 1000000) \ 1000) & " " & strt1 & " "
s3 = yek(adad Mod 1000) & " "
Case 4 To 6
s1 = yek(adad \ 1000) & " " & strt1 & " "
s2 = yek(adad Mod 1000) & " "
Case Is <= 3
s1 = yek(adad Mod 1000) & " "
End Select
s = s1 & s2 & s3 & s4
If Trim(s1) <> "" Then Print Tab(14), s1
If Trim(s2) <> "" Then Print Tab(14), s2
If Trim(s3) <> "" Then Print Tab(14), s3
If Trim(s4) <> "" Then Print Tab(14), s4
Else
a = MsgBox("áØÝÇ ÚÏÏ æÇÑÏ ßäíÏ", , "ÎØÇ")
Text1.Text = ""
Text1.SetFocus
End If
End Sub
Private Sub Command2_Click()
voice (s)
End Sub
Public Function yek(ByVal lnga As Long) As String
yekan = Array("", "one", "tow", "three", "four", "five", "six", "seven", "eight", "nine", "ten", "eleven", "towelvi", "therteen", "fourteen", "fifteen", "sixteen", "seventeen", "eighteen", "nineteen")
sad = Array("", "", "twenty", "therty", "fourty", "fifty", "sixty", "seventy", "eighty", "ninety")
s = lnga \ 100
d = (lnga Mod 100) \ 10
y = lnga Mod 10
If d = 1 Then
d1 = lnga Mod 100
d = 0
y = 0
End If
yek = IIf(s = 0, "", yekan(s) & " " & strh & " ") & IIf(d = 0, "", sad(d) & " ") & IIf(d1 = 0, "", yekan(d1) & " ") & IIf(y = 0, "", yekan(y))
If yek = "" Then
strt1 = ""
strm = ""
Else
strt1 = "thousand"
strm = "milion"
End If
End Function
Private Sub voice(s As String)
Dim a(1 To 20) As Integer
contur = 1
a(1) = 1
For i = 2 To 20
a(i) = InStr(contur, s, " ")
If a(i) <> 0 Then
start = Trim(Mid(s, contur, a(i) - a(i - 1)))
contur = a(i) + 1
k = sndPlaySound(App.Path & "\" & start & ".wav", 2)
Else
Exit For
End If
Next
End Sub
