URL links in ReachTextBox

Greetings.
I saved an RTF file (a word document) in a resource file and then I loaded it to a RichTextBox control.
The RTF file contains some URL links but they appear to be dead in the RichTextBox control.
Any ideas on how I can get those links revived?
Thanks.

I think you have to cut the cur coordinates of the text link in the richtextbox and hence when the cursor is within that area and dbl clicked execute the link.

Perhaps few lines of code?
:o

VB Code:

Private Const WM_USER As Long = &H400
Private Const EM_AUTOURLDETECT As Long = (WM_USER + 91)
Private Const EM_GETSEL As Long = &HB0
 
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 ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
     ByVal hwnd As Long, _
     ByVal lpOperation As String, _
     ByVal lpFile As String, _
     ByVal lpParameters As String, _
     ByVal lpDirectory As String, _
     ByVal nShowCmd As Long) As Long
 
 
Option Explicit
 
Private Sub DetectURL(p_RichText As Object, p_blnDetect As Boolean)
    Dim lngRet As Long
    Dim strText As String
    
    With p_RichText
        ' this line is needed because the function will not update the
        ' url if you had it before
        strText = .Text
        ' 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
        lngRet = SendMessage(RichTextBox1.hwnd, EM_AUTOURLDETECT, Abs(p_blnDetect), ByVal 0)
        ' rewrite the text into the RichText so it will change all URLs if you
        'had them before
        .Text = strText
    End With
End Sub
 
Private Sub Form_Load()
 
    RichTextBox1.Text = "The URL to click is [url]http://www.something.com.[/url]  Please click it." & vbCrLf
    
End Sub
 
Private Sub RichTextBox1_Change()
    DetectURL RichTextBox1, True
    RichTextBox1.SelStart = Len(RichTextBox1.Text)
End Sub
 
 
Private Sub RichTextBox1_Click()
 
    Dim lngRetVal As Long
    
    lngRetVal = SendMessage(RichTextBox1.hwnd, EM_GETSEL, 0, 0)
    
    Dim strBuffer As String, intInStr As Integer, intHi As Integer, intLo As Integer
    
    intHi = HiWord(lngRetVal) + 1
    intLo = LoWord(lngRetVal) + 1
    
    intInStr = InStrRev(RichTextBox1.Text, " ", intLo)
    
    If intInStr = 0 Then 'no space
        strBuffer = Mid(RichTextBox1.Text, 1, intLo)
    Else
        strBuffer = Mid(RichTextBox1.Text, intInStr + 1)
    End If
    
    strBuffer = Trim(strBuffer)
    intInStr = InStr(1, strBuffer, " ")
    
    If intInStr <> 0 Then
        strBuffer = Mid(strBuffer, 1, intInStr - 1)
    End If
    
    If InStr(1, strBuffer, "http:") = 0 And _
        InStr(1, strBuffer, "file:") = 0 And _
        InStr(1, strBuffer, "mailto:") = 0 And _
        InStr(1, strBuffer, "ftp:") = 0 And _
        InStr(1, strBuffer, "https:") = 0 And _
        InStr(1, strBuffer, "gopher:") = 0 And _
        InStr(1, strBuffer, "nntp:") = 0 And _
        InStr(1, strBuffer, "prospero:") = 0 And _
        InStr(1, strBuffer, "telnet:") = 0 And _
        InStr(1, strBuffer, "news:") = 0 And _
        InStr(1, strBuffer, "wais:") = 0 Then Exit Sub
        
    Debug.Print strBuffer
    
    'to run
    'Call ShellExecute(Me.hwnd, "OPEN", strBuffer, vbNullString, vbNullString, 5)
    
End Sub
 
Private Function LoWord(ByVal DWord As Long) As Long
  If DWord And &H8000& Then
    LoWord = DWord Or &HFFFF0000
  Else
    LoWord = DWord And &HFFFF&
  End If
End Function
 
Private Function HiWord(ByVal DWord As Long) As Long
  HiWord = (DWord And &HFFFF0000) \ &H10000
End Function

Nice coding manavo.

manavo, I appreciate your effort. However your code didn't work for me
:(
Do you think you could do one more little effort and attach a small project to demonstrate your code?
Thanks allot!

Quote:

---

Originally posted by Shawn N
Nice coding manavo.

---

I can't take credit for it... I found it somewhere around here and saved it on my PC... It was easier to search my PC then VBF :blush:

Here's the project I have saved on my PC...