Местоположение курсора в текстовом поле и указатель мыши - VB
Формулировка задачи:
В этой теме речь идёт о следующем:
По текстовом полю скользит указатель мыши. Вот этот
указатель "наткнулся" на слово. Как определить местоположение
этого слова? Скопировать это слово? И перебросить на метку?
Первый шаг в этом направлении я сделал. Можно просто кликнуть
мышкой. Предлагаемая вашему вниманию программа находит
английское слово, если клик был на этом слове.
Но тема создана для решения другого вопроса. (без клика).
Как связать координаты курсора мыши и местоположение
слова в тексте??
Решение. Если мы имеем однострочное поле и моноширинный
шрифт (например Lucida Console), то не так сложно увязать
координату X с позицией текстового курсора.
А если шрифт иной (например Arial), то тут надо просчитывать
ширину каждого символа, учитывать размер шрифта, его стиль
И самое главное положение полосы прокрутки.
В общем случае (мультиполе) придётся высчитывать номер строки
Можно конечно сделать массив текстовых полей и о строке
более не заботится. Однако проблем в решении этой задачи
более, чем достаточно.
Буду рад любой подсказке (например, если какие Api-функции)?
Что-то ещё? Как справится с полосами прокрутки? И .... ???
Удачи вам всем!
Решение задачи: «Местоположение курсора в текстовом поле и указатель мыши»
textual
Листинг программы
Option Explicit Private Const EM_CHARFROMPOS& = &HD7 Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Sub txtText_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim Pos As Long X = ScaleX(X, vbTwips, vbPixels): Y = ScaleY(Y, vbTwips, vbPixels) Pos = CLng(X) + (CLng(Y) * &H10000) Me.Caption = GetWord(txtText, Pos) End Sub Private Function GetWord(Text As TextBox, Pos As Long) As String Dim ptChar As Long, PtLine As Long Dim ptStart As Long, ptEnd As Long ptChar = SendMessage(Text.hWnd, EM_CHARFROMPOS, 0, ByVal Pos) PtLine = ptChar \ &H10000 ptChar = ptChar And &HFFFF& If ptChar <= 0 Then Exit Function ptStart = ptChar Do Until ptStart <= 0 If Mid$(Text.Text, ptStart, 1) <= " " Then Exit Do ptStart = ptStart - 1 Loop ptEnd = ptChar Do Until ptEnd > Len(Text.Text) Or Mid$(Text.Text, ptEnd, 1) <= " " ptEnd = ptEnd + 1 Loop If ptStart = ptEnd Then Exit Function GetWord = Mid$(Text.Text, ptStart + 1, ptEnd - ptStart - 1) End Function
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д