VBNet - Форум - Слово под курсором (помогите найти ошибку)

Вопрос: Слово под курсором (помогите найти ошибку) Добавлено: 17.01.10 08:09

Автор вопроса: Андрей

Изменил чуть распространенный в сети код. Мне нужно, чтобы в подсказке показывало слово и гласную. Так и есть, но когда попадаються две гласных, например слово "сбирается", то показывает ток "а" и ни как не хочет показывать "е". Мож кто видит ошибку, подскажите плиз, а то в холостую ковыряю всю ночь.

На форму кинуть ток RichTextBox1.

Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal msg As Long, ByVal wp As Long, lp As Any) As Long
Private Const EM_CHARFROMPOS& = &HD7
Private Type POINTAPI
x As Long
y As Long
End Type
Dim start_pos1 As Integer

Public Function RichWordOver(rch As RichTextBox, x As Single, y As Single) As String
On Local Error Resume Next
Dim pt As POINTAPI
Dim pos As Integer
Dim end_pos As Integer
Dim ch As String
Dim txt As String
Dim txtlen As Integer
pt.x = x \ Screen.TwipsPerPixelX
pt.y = y \ Screen.TwipsPerPixelY
pos = SendMessage(rch.hwnd, EM_CHARFROMPOS, 0&, pt) + 1
If pos <= 0 Then Exit Function
txt = rch.Text
For start_pos1 = pos To 1 Step -1
ch = Mid$(rch.Text, start_pos1, 1)
If Not (InStr("УЕЫАОЭЯИЮЁуеыаоэяиюё", ch) <> 0) Then Exit For
Next start_pos1
start_pos1 = start_pos1 + 1
txtlen = Len(txt)
For end_pos = pos To txtlen
ch = Mid$(txt, end_pos, 1)
If Not (InStr("УЕЫАОЭЯИЮЁуеыаоэяиюё", ch) <> 0) Then Exit For
Next end_pos
end_pos = end_pos - 1
If start_pos1 <= end_pos Then RichWordOver = Mid$(rch.Text, start_pos1, 1)
End Function

Public Function RichWord(rch As RichTextBox, x As Single, y As Single) As String
On Local Error Resume Next
Dim pt As POINTAPI
Dim pos As Integer
Dim start_pos As Integer
Dim end_pos As Integer
Dim ch As String
Dim txt As String
Dim txtlen As Integer
pt.x = x \ Screen.TwipsPerPixelX
pt.y = y \ Screen.TwipsPerPixelY
pos = SendMessage(rch.hwnd, EM_CHARFROMPOS, 0&, pt) + 1
If pos <= 0 Then Exit Function
txt = rch.Text
For start_pos = pos To 1 Step -1
ch = Mid$(rch.Text, start_pos, 1)
If Not (InStr(Chr(10) & "УЕЫАОЭЯИЮЁЙЦКНГШЩЗХЪФВПРЛДЖЧСМТЬБуеыаоэяиюёйцкнгшщзхъфвпрлджчсмтьб", ch) <> 0) Then Exit For
Next start_pos
start_pos = start_pos + 1
txtlen = Len(txt)
For end_pos = pos To txtlen
ch = Mid$(txt, end_pos, 1)
If Not (InStr(Chr(10) & "УЕЫАОЭЯИЮЁЙЦКНГШЩЗХЪФВПРЛДЖЧСМТЬБуеыаоэяиюёйцкнгшщзхъфвпрлджчсмтьб", ch) <> 0) Then Exit For
Next end_pos
end_pos = end_pos - 1
If start_pos <= end_pos Then RichWord = Mid$(txt, start_pos, end_pos - start_pos + 1)
End Function

Private Sub Form_Load()
RichTextBox1.Text = "Как ныне сбирается вещий Олег Отмстить неразумным хазарам. Их нивы и сёла за буйный набег Обрёк он мечам и пожарам."
End Sub

Private Sub RichTextBox1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Len(RichWordOver(RichTextBox1, x, y)) > 0 Then RichTextBox1.ToolTipText = " Слово " & Chr(34) & Replace(RichWord(RichTextBox1, x, y), "'", "") & Chr(34) & ", гласная " & Chr(34) & RichWordOver(RichTextBox1, x, y) & Chr(34) & ". "
End Sub

Ответить

Ответы Всего ответов: 0

Нет ответов

Страница: