visual basic text1 deki kelimeyi hecelere ayırma

artvir' Alıntı:

1. Dim sesliler(7) As Byte
2. Dim sozcuk() As Byte
3. Dim t_str As String
4. 'Dim a As Object
5. Private Sub Command1_Click()
6. hecele
7. End Sub
8.
9. Private Sub Command2_Click()
10. x = seslimi(Asc("a"))
11. MsgBox (x)
12. End Sub
13.
14. Private Sub Form_Load()
15. 'Set a = New SpeechLib.SpVoice
16. Text1.Text = "merhabaa"
17. sesliler(0) = Asc("a")
18. sesliler(1) = Asc("e")
19. sesliler(2) = Asc("ı")
20. sesliler(3) = Asc("i")
21. sesliler(4) = Asc("o")
22. sesliler(5) = Asc("ö")
23. sesliler(6) = Asc("u")
24. sesliler(7) = Asc("ü")
25. End Sub
26. Private Function seslimi(ByVal ch As Byte) As Boolean
27. Dim i_sayac As Integer
28. Dim ustsinir As Integer
29. Dim altsinir As Integer
30. Dim t_donus As Boolean: t_donus = False
31. ustsinir = UBound(sesliler)
32. altsinir = LBound(sesliler)
33. For i_sayac = altsinir To ustsinir
34. If ch = sesliler(i_sayac) Then
35. t_donus = True
36. Exit For
37. End If
38. Next i_sayac
39. seslimi = t_donus
40. End Function
41. Private Sub hecele()
42. t_str = vbNullString
43. If (seslimi(Asc(Mid$(Text1.Text, 1, 1)))) = True Then
44. Text1.Text = " " & Text1.Text
45. End If
46. 'If (seslimi(Asc(Mid$(Text1.Text, Len(Text1.Text), 1)))) = True Then
47. Text1.Text = Text1.Text & "ba"
48. 'End If
49. sozcuk = StrConv(Text1.Text, vbFromUnicode)
50. Dim t As Integer
51. Dim n As Integer
52. Dim ustsinir As Integer
53. Dim altsinir As Integer
54.
55.
56. ustsinir = UBound(sozcuk)
57. altsinir = LBound(sozcuk)
58. For n = altsinir To ustsinir
59. If (seslimi(sozcuk(n)) = True) Then
60. For x = altsinir To n
61. t_str = t_str & Chr(sozcuk(x))
62. Next x
63. Exit For
64. b = n
65. End If
66. Next n
67. If (seslimi(Asc(Mid(Text1.Text, 1, 1))) = False) Then
68. t_str = Mid(Text1.Text, 1, 1)
69. End If
70. For n = b + 1 To ustsinir
71. If (seslimi(sozcuk(n)) = True) Then 'ilk sesli
72. 'List1.AddItem CStr(n)
73. For t = n + 1 To ustsinir
74. If (seslimi(sozcuk(t)) = True) Then 'ikinci sesli
75. 'List1.AddItem CStr(t)
76. If ((t - n) = 1) Then 'aralarındaki fark
77. 't_str = t_str & Chr(sozcuk(n)) & Chr(sozcuk(n + 1))
78. t_str = t_str & " "
79. 'n = t
80. ElseIf ((t - n) = 2) Then 'aralarındaki fark
81. t_str = t_str & Chr(sozcuk(n))
82. t_str = t_str & " "
83. 'n = t
84. ElseIf ((t - n) = 0) Then 'aralarındaki fark
85.
86. 't_str = t_str & " "
87. 't_str = t_str & Chr(sozcuk(n))
88. 'n = t - 1
89. ElseIf ((t - n) = 2) Then 'aralarındaki fark
90. t_str = t_str & Chr(sozcuk(n))
91. t_str = t_str & " "
92. ElseIf ((t - n) = 3) Then 'aralarındaki fark
93. t_str = t_str & Chr(sozcuk(n)) & Chr(sozcuk(n + 1))
94. t_str = t_str & " "
95. 'n = t
96. ElseIf ((t - n) = 4) Then 'aralarındaki fark
97. t_str = t_str & Chr(sozcuk(n)) & Chr(sozcuk(n + 1)) & Chr(sozcuk(n + 2))
98. t_str = t_str & " "
99. 'n = t
100. End If
101. n = t - 1
102. 'Exit For
103. Else
104.
105.
106.
107. End If
108. Next t
109. End If
110. Next n
111. 't_str = t_str & Chr(sozcuk(UBound(sozcuk)))
112. MsgBox (t_str)
113. 'Dim aa() As String
114. 'aa = Split(t_str, " ")
115. 'For n = LBound(aa) To UBound(aa)
116. 'a.Speak aa(n)
117. 'Next n
118. End Sub

Genişletmek için tıkla ...