Making Links Activatable

[Blade_360]

How do I make links activatable in rtb?.

[Ickypoopy]

Send an EM_AUTOURLDETECT message.

[iago]

Use the SendMessage function to send a message to it, and the message that is being sent should be EM_AUTOURLDETECT.  Understand!?

[JaMi]

Well heres a way to make it recognize the link from the rest of the text... but as for making it actually go to the page i havent gotten that far yet :|

Code Select Expand

Private Sub highlightHyperlink()
On Error Resume Next
Dim pos As Long
Dim posEnd As Long
Dim char As String
Dim link As String
pos = InStr(1, LCase$(rtb.Text), "mailto:")

Do While pos > 0

For posEnd = pos To Len(rtb.Text)
char = Mid$(rtb.Text, posEnd, 1)
If char = Chr$(32) Or char = Chr$(10) Or char = Chr$(13) Then Exit _
For
Next posEnd
link = Mid$(rtb.Text, pos, posEnd - pos)
char = Right$(link, 1)

Do While char = "." Or char = "," Or char = "!" Or char = "?" Or _
Len(char) <> 1
link = Left$(link, Len(link) - 1)
char = Right$(link, 1)
Loop

If Len(link) > 7 Then
rtb.SelStart = pos - 1
rtb.SelLength = Len(link)
rtb.SelUnderline = True
rtb.SelColor = vbBlue
End If
pos = InStr(posEnd + 1, LCase$(rtb.Text), "ftp://")
Loop
pos = InStr(1, LCase$(rtb.Text), "ftp://")

Do While pos > 0

For posEnd = pos To Len(rtb.Text)
char = Mid$(rtb.Text, posEnd, 1)
If char = Chr$(32) Or char = Chr$(10) Or char = Chr$(13) Then Exit _
For
Next posEnd
link = Mid$(rtb.Text, pos, posEnd - pos)
char = Right$(link, 1)

Do While char = "." Or char = "," Or char = "!" Or char = "?" Or _
Len(char) <> 1
link = Left$(link, Len(link) - 1)
char = Right$(link, 1)
Loop

If Len(link) > 6 Then
rtb.SelStart = pos - 1
rtb.SelLength = Len(link)
rtb.SelUnderline = True
rtb.SelColor = vbBlue
End If
pos = InStr(posEnd + 1, LCase$(rtb.Text), "ftp://")
Loop
pos = InStr(1, LCase$(rtb.Text), "http://")

Do While pos > 0

For posEnd = pos To Len(rtb.Text)
char = Mid$(rtb.Text, posEnd, 1)
If char = Chr$(32) Or char = Chr$(10) Or char = Chr$(13) Then Exit _
For
Next posEnd
link = Mid$(rtb.Text, pos, posEnd - pos)
char = Right$(link, 1)

Do While char = "." Or char = "," Or char = "!" Or char = "?" Or _
Len(char) <> 1
link = Left$(link, Len(link) - 1)
char = Right$(link, 1)
Loop

If Len(link) > 7 Then
rtb.SelStart = pos - 1
rtb.SelLength = Len(link)
rtb.SelUnderline = True
rtb.SelColor = vbBlue
End If
pos = InStr(posEnd + 1, LCase$(rtb.Text), "http://")
Loop
pos = InStr(1, LCase$(rtb.Text), "www.")

Do While pos > 0

For posEnd = pos To Len(rtb.Text)
char = Mid$(rtb.Text, posEnd, 1)
If char = Chr$(32) Or char = Chr$(10) Or char = Chr$(13) Then Exit _
For
Next posEnd
link = Mid$(rtb.Text, pos, posEnd - pos)
char = Right$(link, 1)

Do While char = "." Or char = "," Or char = "!" Or char = "?" Or _
Len(char) <> 1
link = Left$(link, Len(link) - 1)
char = Right$(link, 1)
Loop

If Len(link) > 4 Then
rtb.SelStart = pos - 1
rtb.SelLength = Len(link)
rtb.SelUnderline = True
rtb.SelColor = vbBlue
End If
pos = InStr(posEnd + 1, LCase$(rtb.Text), "www.")
Loop
rtb.SelStart = Len(rtb.Text)
End Sub


[Etheran]

SendMessage(RTB_HWND,EM_AUTOURLDETECT,(WPARAM)NULL,(LPARAM)NULL);

there's your one line.

[Grok]

That's the kind of help I'm talking about.  People playing elitism with someone who is trying to learn.

Not one of you posted a correct answer while sitting there chuckling and thinking you're so great.

Only I am great, for I have the correct answer!!

Code Select Expand

Option Explicit

Private Const WM_USER = &H400&
Private Const EM_AUTOURLDETECT = (WM_USER + 91)
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 Sub Form_Load()
    Dim lRet As Long
    lRet = SendMessage(rtb.hWnd, EM_AUTOURLDETECT, ByVal 1&, ByVal 0&)
End Sub

Grok,
The Evil Visual Basic Guru
(is Evil a modifier of VB or of Guru?)

[Zorm]

However just setting EM_AUTOURLDETECT to on was not enough when I tried to do this, it still required subclassing of click events.

[Zakath]

Lol...Grok...

Setting the wparam to 0 would disable auto-url detection, not enable it, Etheran.

The way to get the app to respond to this is to have the parent window of the RTB handle the EN_LINK message, which is one of the messages received through the standard parent/child WM_NOTIFY message. I'm not sure whether VB makes this easy or not; I haven't had enough experience with VB message handling.

However, if this'll be any help:
EM_AUTOURLDETECT
EN_LINK
WM_NOTIFY

[iago]

Hmm.. I just realized that any program that uses a RTB can have the links made activatable just by using a SendMessage from another program, right?  hmm :-)

[Noodlez]

you would need to subclass the richtextbox to detect the links and make them launch, however.

[iago]

Ah well, it was a thought

[Zakath]

you would need to subclass the richtextbox to detect the links and make them launch, however.

Actually you don't subclass the RTB...the message you need to deal with is one of the ones the parent window handles via WM_COMMAND.

[Grok]

They won't listen.  The question was for Visual Basic, and I gave them working code which I tested.  If they want to make it more complicated, not much can stop them.

[dxoigmn]

Grok:  Sending EM_AUTOURLDETECT will only underline and highlight links (and set some flags for that text), not handle clicking of those links.  Simply highlighting and underlining the links is not enough which I think Blade_360 would want and others are suggesting.  A sample of how this is done can be found at http://www.developerfusion.com/show/16/12/