Местоположение курсора в текстовом поле и указатель мыши - 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

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

14   голосов , оценка 4.071 из 5
Похожие ответы