Текст, как ссылка) - VB

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 Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
Private Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
 
Private Const IDC_HAND = 32649&
Private Const IDC_IBEAM = 32513&
Private Const HWND_TOPMOST = -1
Private Const SWP_NOMOVE = 2
Private Const SWP_NOSIZE = 1
 
Private Sub txtText_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim Pos As Long, Wrd As String
    x = ScaleX(x, vbTwips, vbPixels): y = ScaleY(y, vbTwips, vbPixels)
    Pos = CLng(x) + (CLng(y) * &H10000)
    Wrd = LCase(GetWord(txtText, Pos))
    Select Case Wrd
    Case "first", "second"
        SetCursor LoadCursor(0, IDC_HAND)
        lblMsg.Caption = Wrd
    Case Else
        SetCursor LoadCursor(0, IDC_IBEAM)
        lblMsg.Caption = vbNullString
    End Select
End Sub
Private Sub txtText_MouseDown(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)
    Select Case LCase(GetWord(txtText, Pos))
    Case "first"
        SetTopMost frmFirst
        frmFirst.Show
    Case "second"
        SetTopMost frmSecond
        frmSecond.Show
    End Select
End Sub
Private Function SetTopMost(Form As Form) As Boolean
    SetTopMost = SetWindowPos(Form.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
End Function
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