Results 1 to 5 of 5

Thread: Detect hyperlinks (URL) in a RichTextBox

  1. #1

    Thread Starter
    Super Moderator manavo11's Avatar
    Join Date
    Nov 2002
    Location
    Around the corner from si_the_geek
    Posts
    7,171

    Detect hyperlinks (URL) in a RichTextBox

    VB Code:
    1. Private Const WM_USER As Long = &H400
    2. Private Const EM_AUTOURLDETECT As Long = (WM_USER + 91)
    3. Private Const EM_GETSEL As Long = &HB0
    4.  
    5. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
    6.      ByVal hwnd As Long, _
    7.      ByVal wMsg As Long, _
    8.      ByVal wParam As Long, _
    9.      lParam As Any) As Long
    10.  
    11. Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
    12.      ByVal hwnd As Long, _
    13.      ByVal lpOperation As String, _
    14.      ByVal lpFile As String, _
    15.      ByVal lpParameters As String, _
    16.      ByVal lpDirectory As String, _
    17.      ByVal nShowCmd As Long) As Long
    18.  
    19.  
    20. Option Explicit
    21.  
    22. Private Sub DetectURL(p_RichText As Object, p_blnDetect As Boolean)
    23.     Dim lngRet As Long
    24.     Dim strText As String
    25.    
    26.     With p_RichText
    27.         ' this line is needed because the function will not update the
    28.         ' url if you had it before
    29.         strText = .Text
    30.         ' send message to detect urls
    31.         ' notice the Abs function. This is needed to pass 0 or 1
    32.         ' in VB true is -1, so we have to get the absolute value of that
    33.         lngRet = SendMessage(RichTextBox1.hwnd, EM_AUTOURLDETECT, Abs(p_blnDetect), ByVal 0)
    34.         ' rewrite the text into the RichText so it will change all URLs if you
    35.         'had them before
    36.         .Text = strText
    37.     End With
    38. End Sub
    39.  
    40. Private Sub Form_Load()
    41.  
    42.     RichTextBox1.Text = "The URL to click is [url]http://www.something.com.[/url]  Please click it." & vbCrLf
    43.    
    44. End Sub
    45.  
    46. Private Sub RichTextBox1_Change()
    47.     DetectURL RichTextBox1, True
    48.     RichTextBox1.SelStart = Len(RichTextBox1.Text)
    49. End Sub
    50.  
    51.  
    52. Private Sub RichTextBox1_Click()
    53.  
    54.     Dim lngRetVal As Long
    55.    
    56.     lngRetVal = SendMessage(RichTextBox1.hwnd, EM_GETSEL, 0, 0)
    57.    
    58.     Dim strBuffer As String, intInStr As Integer, intHi As Integer, intLo As Integer
    59.    
    60.     intHi = HiWord(lngRetVal) + 1
    61.     intLo = LoWord(lngRetVal) + 1
    62.    
    63.     intInStr = InStrRev(RichTextBox1.Text, " ", intLo)
    64.    
    65.     If intInStr = 0 Then 'no space
    66.         strBuffer = Mid(RichTextBox1.Text, 1, intLo)
    67.     Else
    68.         strBuffer = Mid(RichTextBox1.Text, intInStr + 1)
    69.     End If
    70.    
    71.     strBuffer = Trim(strBuffer)
    72.     intInStr = InStr(1, strBuffer, " ")
    73.    
    74.     If intInStr <> 0 Then
    75.         strBuffer = Mid(strBuffer, 1, intInStr - 1)
    76.     End If
    77.    
    78.     If InStr(1, strBuffer, "http:") = 0 And _
    79.         InStr(1, strBuffer, "file:") = 0 And _
    80.         InStr(1, strBuffer, "mailto:") = 0 And _
    81.         InStr(1, strBuffer, "ftp:") = 0 And _
    82.         InStr(1, strBuffer, "https:") = 0 And _
    83.         InStr(1, strBuffer, "gopher:") = 0 And _
    84.         InStr(1, strBuffer, "nntp:") = 0 And _
    85.         InStr(1, strBuffer, "prospero:") = 0 And _
    86.         InStr(1, strBuffer, "telnet:") = 0 And _
    87.         InStr(1, strBuffer, "news:") = 0 And _
    88.         InStr(1, strBuffer, "wais:") = 0 Then Exit Sub
    89.        
    90.     Debug.Print strBuffer
    91.    
    92.     'to run
    93.     'Call ShellExecute(Me.hwnd, "OPEN", strBuffer, vbNullString, vbNullString, 5)
    94.    
    95. End Sub
    96.  
    97. Private Function LoWord(ByVal DWord As Long) As Long
    98.   If DWord And &H8000& Then
    99.     LoWord = DWord Or &HFFFF0000
    100.   Else
    101.     LoWord = DWord And &HFFFF&
    102.   End If
    103. End Function
    104.  
    105. Private Function HiWord(ByVal DWord As Long) As Long
    106.   HiWord = (DWord And &HFFFF0000) \ &H10000
    107. End Function


    Has someone helped you? Then you can Rate their helpful post.

  2. #2
    "Digital Revolution"
    Join Date
    Mar 2005
    Posts
    4,471

    Re: Detect hyperlinks (URL) in a RichTextBox

    Just what I was looking for. Very fast and no need for subclassing.

    Thanks.

  3. #3
    Oi, fat-rag! bushmobile's Avatar
    Join Date
    Mar 2004
    Location
    on the poop deck
    Posts
    5,592

    Re: Detect hyperlinks (URL) in a RichTextBox

    I would suggest that the if block should get changed to
    VB Code:
    1. Select Case True
    2.         Case InStr(strBuffer, "http:")
    3.         Case InStr(strBuffer, "file:")
    4.         Case InStr(strBuffer, "mailto:")
    5.         Case InStr(strBuffer, "ftp:")
    6.         Case InStr(strBuffer, "https:")
    7.         Case InStr(strBuffer, "gopher:")
    8.         Case InStr(strBuffer, "prospero:")
    9.         Case InStr(strBuffer, "telnet:")
    10.         Case InStr(strBuffer, "news:")
    11.         Case InStr(strBuffer, "wais:")
    12.         Case Else
    13.             Exit Sub
    14.     End Select
    that way if it finds one of them it'll jump out and won't bother calling the other InStr functions.

  4. #4
    Hyperactive Member
    Join Date
    Aug 2008
    Posts
    353

    Re: Detect hyperlinks (URL) in a RichTextBox

    i tried it with select case...but it does not do the job well when u click on the link.

    seems like its taking the string to open in shellexecute only at the pointers position
    Thanks for helping me out.

  5. #5
    Lively Member
    Join Date
    Aug 2009
    Posts
    113

    Re: Detect hyperlinks (URL) in a RichTextBox

    Quote Originally Posted by bushmobile View Post
    I would suggest that the if block should get changed tothat way if it finds one of them it'll jump out and won't bother calling the other InStr functions.
    they are all AND, then if one fails the program doesnt evaluate others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width