Heute verraten wir Ihnen, wie sich in der TextBox das Wort ermitteln lässt, auf dem sich der Mauszeiger aktuell befindet. So könnte man bspw. immer das aktuelle Wort als ToolTip anzeigen, oder bspw. auch prüfen, ob es sich bei dem Wort um eine URL oder EMail-Adresse handelt und den Mauszeiger entsprechend als Hansymbol anzuzeigen. Erstellen Sie ein neues Projekt und platzieren auf die Form eine TextBox mit der Eigenschaft "MultiLine = True". Ferner brauchen wir noch ein Label-Control (lblWord) für die Anzeige des aktuellen Wortes, auf das sich der Mauszeiger aktuell befindet. Fügen Sie nachfolgenden Code in den Codeteil der Form ein: Option Explicit ' zunächst die benötigten API-Deklarationen Private Declare Function GetCursorPos Lib "user32" ( _ lpPoint As POINTAPI) As Long Private Declare Function WindowFromPoint Lib "user32" ( _ ByVal xPoint As Long, _ ByVal yPoint As Long) As Long Private Declare Function ScreenToClient Lib "user32" ( _ ByVal hWnd As Long, _ lpPoint As POINTAPI) As Long 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 Declare Function GetDC Lib "user32" ( _ ByVal hWnd As Long) As Long Private Declare Function SelectObject Lib "gdi32" ( _ ByVal hdc As Long, _ ByVal hObject As Long) As Long Private Declare Function DrawText Lib "user32" _ Alias "DrawTextA" ( _ ByVal hdc As Long, _ ByVal lpStr As String, _ ByVal nCount As Long, _ lpRect As RECT, _ ByVal wFormat As Long) As Long Private Declare Function PtInRect Lib "user32" ( _ lpRect As RECT, _ ByVal X As Long, _ ByVal Y As Long) As Long Private Declare Function ReleaseDC Lib "user32" ( _ ByVal hWnd As Long, _ ByVal hdc As Long) As Long Private Type POINTAPI X As Long Y As Long End Type Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Const WM_GETFONT As Long = &H31 Private Const EM_CHARFROMPOS As Long = &HD7 Private Const EM_GETRECT As Long = &HB2 Private Const EM_LINELENGTH As Long = &HC1 Private Const EM_LINEFROMCHAR As Long = &HC9 Private Const EM_GETLINE As Long = &HC4 Private Const DT_CALCRECT = &H400 Private Const DT_EDITCONTROL = &H2000 Private Const DT_WORDBREAK = &H10 ' Wort unter dem Mauszeiger ermitteln (TextBox) Public Function WordFromMousePos(ByVal oControl As Control) As String Dim xPos As Integer Dim yPos As Integer Dim CharPos As Long Dim LinePos As Long Dim TmpStr As String Dim Retval As Long Dim TextDC As Long Dim R As RECT Dim P As POINTAPI Dim hFont As Long With oControl ' aktuelle Mausposition On Error Resume Next GetCursorPos P If WindowFromPoint(P.X, P.Y) = .hWnd Then ' Pixelkoordinaten ermitteln ScreenToClient .hWnd, P xPos = P.X yPos = P.Y ' Ermitteln der Positionen für Zeichen und Zeile Retval = SendMessage(.hWnd, EM_CHARFROMPOS, 0&, ByVal Dword(yPos, xPos)) CharPos = Retval And &HFFFF& ' Textbox vorbereiten TextDC = GetDC(.hWnd) hFont = SendMessage(.hWnd, WM_GETFONT, 0, ByVal 0&) hFont = SelectObject(TextDC, hFont) ' Befindet sich die Maus innerhalb des Textbereichs? SendMessage .hWnd, EM_GETRECT, 0, R DrawText TextDC, .Text, Len(.Text), R, DT_CALCRECT Or DT_EDITCONTROL Or DT_WORDBREAK If PtInRect(R, xPos, yPos) = 0 Then Exit Function End If ' Befindet sich die Maus neben (rechts) vom Textbereich? TmpStr = Space$(SendMessage(.hWnd, EM_LINELENGTH, CharPos, ByVal 0&)) LinePos = SendMessage(.hWnd, EM_LINEFROMCHAR, CharPos, ByVal 0&) SendMessage .hWnd, EM_GETLINE, LinePos, ByVal TmpStr DrawText TextDC, TmpStr, Len(TmpStr), R, DT_CALCRECT Or DT_EDITCONTROL Or DT_WORDBREAK ' Textbox wiederherstellen SelectObject TextDC, hFont ReleaseDC .hWnd, TextDC If xPos > R.Right Then Exit Function End If ' Wort anhand der Positionen extrahieren If CharPos = 0 Then CharPos = CharPos + 1 TmpStr = Replace(.Text, vbCrLf, " ") TmpStr = Left$(TmpStr & " ", InStr(CharPos, TmpStr & " ", " ") - 1) TmpStr = Mid$(TmpStr, InStrRev(TmpStr, " ") + 1) ' Wort zurückgeben WordFromMousePos = TmpStr End If End With End Function Den Aufruf der WordFromMousePos-Funktion setzen wir in das "MouseMove"-Ereignis der TextBox: Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) ' Wort unter dem Mauszeiger ermitteln lblWord.Caption = WordFromMousePos(Text1) End Sub |