RichTextBox Tricks and Tips

[sdowney1]

The RichTextBox control has the ability to detect URLs as they are typed. It can convert this text into a hyperlink which can launch a browser when clicked.

To turn on Auto URL detection simply send the RTB an EM_AUTOURLDETECT message.

When the control detects that a URL is being entered, it reformats the text being entered so that it looks like a hyperlink and marks that text with a CFE_LINK effect.

When the mouse pointer is over text with a CFE_LINK effect, the RTB can be configured to send a message to its parent. In order to respond to mouse events over the hyperlink text, the parent has to be subclassed or hooked.

The following code shows how to setup Auto URL detection

Public Sub EnableAutoURLDetection(RTB As RichTextBox)

    'enable auto URL detection
    SendMessage RTB.hwnd, EM_AUTOURLDETECT, 1&, ByVal 0&

    'subclass the parent of the RTB to receive EN_LINK notifications
    Set FormSubClass = New clsSubClass
    FormSubClass.Enable RTB.Parent.hwnd
    
    'set RTB to notify parent when user has clicked hyperlink
    SendMessage RTB.hwnd, EM_SETEVENTMASK, 0&, ByVal ENM_LINK

End Sub

And to respond to a left mouse click you could do the following in your form's subclass routine.

Private Sub FormSubClass_WMArrival(hwnd As Long, uMsg As Long, wParam As Long, lParam As Long, lRetVal As Long)
Dim notifyCode As nmhdr
Dim LinkData As ENLINK
Dim URL As String

    Select Case uMsg
    Case WM_NOTIFY

        CopyMemory notifyCode, ByVal lParam, LenB(notifyCode)
        If notifyCode.code = EN_LINK Then
        'A RTB sends EN_LINK notifications when it receives certain mouse messages
        'while the mouse pointer is over text that has the CFE_LINK effect:
        
        'To receive EN_LINK notifications, specify the ENM_LINK flag in the mask
        'sent with the EM_SETEVENTMASK message.
        
        'If you send the EM_AUTOURLDETECT message to enable automatic URL detection,
        'the RTB automatically sets the CFE_LINK effect for modified text that it
        'identifies as a URL.
        
            CopyMemory LinkData, ByVal lParam, Len(LinkData)
            If LinkData.Msg = WM_LBUTTONUP Then
                'user clicked on a hyperlink
                'get text with CFE_LINK effect that caused message to be sent
                URL = Mid(RTB.Text, LinkData.chrg.cpMin + 1, LinkData.chrg.cpMax - LinkData.chrg.cpMin)
                'launch the browser here
                ShellExecute 0&, "OPEN", URL, vbNullString, "C:\", SW_SHOWNORMAL
            End If

        End If
        lRetVal = FormSubClass.callWindProc(hwnd, uMsg, wParam, lParam)
        
    Case Else
        lRetVal = FormSubClass.callWindProc(hwnd, uMsg, wParam, lParam)
    End Select

End Sub

Attached is a project that demonstrates the whole idea.

I have done the same using this subroutine for years
BUT, IT autodetects a double backslash then text as a hyperlink by mistake!

Try that yourself. Type \\sometext and it lights up blue as a URL

I assume it is a programming bug MS missed?
And your project file also does the same thing

Is there a way to prevent it from aurtodetecting fake URL?
This one needs no class and can be turned off or on for the RTB control

Public Sub MyDetectURL(p_RichText As Object, p_blnDetect As Boolean, RTB As RichTextBox)
    
  Dim lngRet As Long
  Dim strText As String
  Dim keepstart As Long

  With p_RichText
        keepstart = RTB.SelStart
       ' this line is needed because the function will not update the url if you had it before
        strText = .TextRTF
       ' send message to detect urls
       ' notice the Abs function. This is needed to pass 0 or 1
       ' in VB true is -1, so we have to get the absolute value of that
       ' SendMessage(rtb.hWnd, EM_AUTOURLDETECT, Abs(p_blnDetect), ByVal 0)
       
       If p_blnDetect = True Then
              'turn on autodetect true = 1
           SendMessage RTB.hWnd, EM_AUTOURLDETECT, 1, ByVal 0
      Else
            'turn off autodetect false = 0
            SendMessage RTB.hWnd, EM_AUTOURLDETECT, 0, ByVal 0
      End If
       'rewrite the text into the RichText so it will change all URLs if you had them before
      .TextRTF = strText
       RTB.SelStart = keepstart
       RTB.SelColor = vbBlack '???
   End With
End Sub