أين وكيف أحصل على التفقيط الصوتي

'لتحويل الارقام الي تفقيط باللغة العربية
Public Function HorofToSound(x, Optional Ma As String, Optional Mi As String) As String
	'Ma = " ريال"
	'Mi = " هلله"
	N = Int(x)
	B = Val(Right(Format(x, "000000000000.00"), 2))
	r = SHorof(N)
	C = Int(B)
	B = SHorof(C)
	If r <> "" And B > 0 Then Result = r & Ma & " و " & B & Mi
	If r <> "" And B = 0 Then Result = r & Ma
	If r = "" And B <> 0 Then Result = B & Mi
	HorofToSound = Result
End Function

Private Function SHorof(x)

	N = Int(x)
	C = Format(N, "000000000000")
	c1 = Val(Mid(C, 12, 1))
	Select Case c1
		Case Is = 1: Letter1 = "1." 'z "واحد"
		Case Is = 2: Letter1 = "2." 'z "اثنان"
		Case Is = 3: Letter1 = "3." 'z "ثلاثة"
		Case Is = 4: Letter1 = "4." 'z "اربعة"
		Case Is = 5: Letter1 = "5." 'z "خمسة"
		Case Is = 6: Letter1 = "6." 'z "ستة"
		Case Is = 7: Letter1 = "7." 'z "سبعة"
		Case Is = 8: Letter1 = "8." 'z "ثمانية"
		Case Is = 9: Letter1 = "9." 'z "تسعة"
	End Select

	C2 = Val(Mid(C, 11, 1))
	Select Case C2
		Case Is = 1: Letter2 = "10." 'z "عشر"
		Case Is = 2: Letter2 = "20." 'z "عشرون"
		Case Is = 3: Letter2 = "30." 'z "ثلاثون"
		Case Is = 4: Letter2 = "40." 'z "اربعون"
		Case Is = 5: Letter2 = "50." 'z "خمسون"
		Case Is = 6: Letter2 = "60." 'z "ستون"
		Case Is = 7: Letter2 = "70." 'z "سبعون"
		Case Is = 8: Letter2 = "80." 'z "ثمانون"
		Case Is = 9: Letter2 = "90." 'z "تسعون"
	End Select

	If Letter1 <> "" And C2 > 1 Then Letter2 = Letter1 + "and." + Letter2 'z " و" + Letter2
	If Letter2 = "" Then Letter2 = Letter1
	If c1 = 0 And C2 = 1 Then Letter2 = Letter2 + "." 'z "ة"
	If c1 = 1 And C2 = 1 Then Letter2 = "11." 'z "احدى عشر"
	If c1 = 2 And C2 = 1 Then Letter2 = "12." 'z "اثنى عشر"
	If c1 = 3 And C2 = 1 Then Letter2 = "13." 'z "ثلاث عشر"
	If c1 = 4 And C2 = 1 Then Letter2 = "14." 'z "اربع عشر"
	If c1 = 5 And C2 = 1 Then Letter2 = "15." 'z "خمس عشر"
	If c1 = 6 And C2 = 1 Then Letter2 = "16." 'z "ستة عشر"
	If c1 = 7 And C2 = 1 Then Letter2 = "17." 'z "سبع عشر"
	If c1 = 8 And C2 = 1 Then Letter2 = "18." 'z "ثماني عشر"
	If c1 = 9 And C2 = 1 Then Letter2 = "19." 'z "تسعة عشر"

	C3 = Val(Mid(C, 10, 1))
	Select Case C3
		Case Is = 1: Letter3 = "100." 'z "مائة"
		Case Is = 2: Letter3 = "200." 'z "مئتان"
		'Case Is > 2: Letter3 = Left(SHorof(C3), Len(SHorof(C3)) - 1) + ".100." 'z  "مائة"
		Case Is = 3: Letter3 = "300." 'z "ثلاثمائة"
		Case Is = 4: Letter3 = "400." 'z "اربعمائة"
		Case Is = 5: Letter3 = "500." 'z "خمسمائة"
		Case Is = 6: Letter3 = "600." 'z "ستمائة"
		Case Is = 7: Letter3 = "700." 'z "سبعمائة"
		Case Is = 8: Letter3 = "800." 'z "ثمانمائة"
		Case Is = 9: Letter3 = "900." 'z "تسعمائة"
	End Select
	'If Letter3 <> "" And Letter2 <> "" Then Letter3 = Letter3 + "and." + Letter2 'z " و" + Letter2
	If Letter3 <> "" And Letter2 <> "" Then Letter3 = Letter3 + Letter2 'z " و" + Letter2
	If Letter3 = "" Then Letter3 = Letter2

	C4 = Val(Mid(C, 7, 3))
	Select Case C4
		Case Is = 1: Letter4 = "1000." 'z "الف"
		Case Is = 2: Letter4 = "2000." 'z "الفان"
		Case 3 To 10: Letter4 = SHorof(C4) + "1000s." 'z " آلاف"
		Case Is > 10: Letter4 = SHorof(C4) + "1000." 'z " الف"
	End Select
	'If Letter4 <> "" And Letter3 <> "" Then Letter4 = Letter4 + "and." + Letter3 'z " و" + Letter3
	If Letter4 <> "" And Letter3 <> "" Then Letter4 = Letter4 + Letter3 'z " و" + Letter3
	If Letter4 = "" Then Letter4 = Letter3
	C5 = Val(Mid(C, 4, 3))
	Select Case C5
		Case Is = 1: Letter5 = "1000000." 'z "مليون"
		Case Is = 2: Letter5 = "2000000." 'z "مليونان"
		Case 3 To 10: Letter5 = SHorof(C5) + "1000000s." 'z " ملايين"
		Case Is > 10: Letter5 = SHorof(C5) + "1000000." 'z " مليون"
	End Select
	'If Letter5 <> "" And Letter4 <> "" Then Letter5 = Letter5 + "and." + Letter4 'z " و" + Letter4
	If Letter5 <> "" And Letter4 <> "" Then Letter5 = Letter5 + Letter4 'z " و" + Letter4
	If Letter5 = "" Then Letter5 = Letter4

	C6 = Val(Mid(C, 1, 3))
	Select Case C6
		Case Is = 1: Letter6 = "10000000000." 'z "مليار"
		Case Is = 2: Letter6 = "20000000000." 'z "ملياران"
		Case Is > 2: Letter6 = SHorof(C6) + "10000000000." 'z " مليار"
	End Select
	'If Letter6 <> "" And Letter5 <> "" Then Letter6 = Letter6 + "and." + Letter5 'z " و" + Letter5
	If Letter6 <> "" And Letter5 <> "" Then Letter6 = Letter6 + Letter5 'z " و" + Letter5
	If Letter6 = "" Then Letter6 = Letter5
	SHorof = Letter6

End Function

الكود المسئول عن استدعاء الموديول

		Dim ww() As String
		qq = HorofToSound(CLng(IncomeDigits1.Text))
		ww() = Split(qq, ".")
		On Error Resume Next
		For x = 0 To 100
			aa = ww(x)
			If Err Or ww(x) = "" Then
				Err.Clear
				Exit For
			End If
			CtrlObject2.PlaybackFile App.Path & "\digits\" & ww(x) & ".wav"
		Next x

ملحوظة

CtrlObject2 هي اداة لتشغيل الصوت عندي لذلك ممكن تستعيض عنها باي اداة لتشغيل الصوت

IncomeDigits1.Text هي TextBox المحتوي علي الارقام

تم تعديل هذه المشاركة بواسطة adel_elgo في 3 أكتوبر 2006 في 23:44

زيارة موقعي - شبكة وسيط العرب