Hyperlinks in Rich Text boxes 7

[afryer]

Hi All,

I am using a rich text box in once of my applications and what I need to be able to do is to automatically detect when a hyperlink has been added, i.e if it starts http:// or file:// then it should go to blue underlined in the same way as Microsoft Word.

Does anyone know if there is an easy way to do this or will I have to employ some kind of Windows Hook or something to check after each key press. If that is the case and I detect the http:// then how to I ensure that the hyperlink is displayed correctly and can be clicked?

Any help would be appreciated.

Andrew

 

[MattSTech]

A search of the word hyperlink brought up hundreds of matches in this forum.

Here is one.
222-438924

Matt

 

[strongm]

Do you just want it to automatically "go blue and underlined", or do you want users to be able to click on the URL as well?

 

[MattSTech]

>and can be clicked?

 

[strongm]

<fx: checks eyes and brain...>

Hmm. Must read more carefully...

Although reading the problem again suggests that it is in two parts:

1) Can I easily recognise and correctly highlight a URL in an RTB
2) If so, can it then be clicked?

Interestingly, the answer is "yes, this is pretty easy" to Q1, and "yes, but it is somewhat harder" to Q2

 

[MattSTech]

No offense intended.

Would you then agree with vb5prgrmr's response in the thread I mentioned or do you propose another solution?

Matt

 

[strongm]

No, I wouldn't agree with it. Microsoft's Rich Text control (which underlies the RichTextBox) is reasonably happy dealing with URLs, including automatic URL recognition.

Unfortunately, the RTB:

a) does not expose the recognition methods by default
b) is a wrapper for v1.0 of the Rich Text control, and therefore has no default handler for the URL click notification

What this means is that you can make the RTB work with URLs by
a) simply sending a simple message to the RTB to enable URL recognition (this is the bit that makes 'em go blue and underlined)
b) subclassing the the RTB to provide a handler for the URL click notification

 

[MattSTech]

I am intrigued. Will do some learning on my own about this.

When are you going to write your book of never-ending knowledge?

Matt

 

[afryer]

Hello,

Thanks for the replies....from what I can gather there is a way of doing it, but it is not done by default. Do you have a link/ code snippet about sending messages to the RTB?

Thanks

Andrew

 

[strongm]

I have knocked together an example of a solution, but I was going to give MattSTech more time...

 

[MattSTech]

Thank you strongm, but go ahead and submit the example. I promise I won't peek. I did some research last night and will compare when complete.

Matt

 

[strongm]

OK...

First yoiu will need a form with an RTB and two command buttons. Then paste in this code

[COLOR=blue]
Option Explicit

Private Sub Command1_Click()
    Command1.Enabled = False
    Command2.Enabled = True
    ' Subclass the RTB's parent window
    lpOriginalWndProc = SetWindowLong(lOriginalhWnd, GWL_WNDPROC, AddressOf RichTextBoxSubProc)
End Sub

Private Sub Command2_Click()
    Command1.Enabled = True
    Command2.Enabled = False
    EndSubclassing
End Sub

Private Sub EndSubclassing()
    If lpOriginalWndProc <> 0 Then
        SetWindowLong lOriginalhWnd, GWL_WNDPROC, lpOriginalWndProc
        lpOriginalWndProc = 0
    End If
End Sub

Private Sub Form_Load()
    Dim lngEventMask As Long
    Dim Result As Long
    
    Set myRTB = RichTextBox1
    With myRTB
        ' Here's the easy bit: inform the RTB that is should recognise and highlight URLs
        Result = SendMessage(.hwnd, EM_AUTOURLDETECT, CLng(1), ByVal CLng(0))
        ' Example text. Note that URL recognizer will also happily recognise ftp:// and mailto:// URLs
        .Text = "[URL unfurl="true"]http://www.tek-tips.com"[/URL] & vbCrLf & "ftp.microsoft.com"
        
        ' Get current events that raise notofications in the RTB
        lngEventMask = SendMessage(.hwnd, EM_GETEVENTMASK, 0, ByVal CLng(0))
        ' Enable notifications for a URL being clicked
        ' (note: this only means that the notification is sent, not that VB will
        ' respond to it; we have to code that ourselves)
        If lngEventMask Xor ENM_LINK Then
            lngEventMask = lngEventMask Or ENM_LINK
        End If
        Result = SendMessage(.hwnd, EM_SETEVENTMASK, 0, ByVal CLng(lngEventMask))
         
        ' notifications go to parent of RTB, so the following line grabs and records
        ' the necessary hWnd for subclassing later on
         lOriginalhWnd = GetParent(.hwnd)
    End With
    
    Command1.Caption = "Notifications On"
    Command2.Caption = "Notifications Off"
    Command1.Enabled = True
    Command2.Enabled = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
    EndSubclassing
End Sub
[/color]

Then you will need to add a module, and paste in the following:

[COLOR=blue]
Option Explicit

Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long

Public Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long     '

Public Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Public Declare Sub RtlMoveMemory Lib "kernel32.dll" (Destination As Any, Source As Any, ByVal Length As Long)
Public 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

Public Const GWL_WNDPROC = (-4)
Public Const WM_USER = &H400
Public Const WM_NOTIFY = &H4E
Public Const WM_LBUTTONDOWN = &H201
Public Const EM_GETEVENTMASK = WM_USER + 59
Public Const EM_SETEVENTMASK = WM_USER + 69
Public Const EM_AUTOURLDETECT = WM_USER + 91
Public Const EM_GETTEXTRANGE = WM_USER + 75
Public Const EN_LINK = &H70B
Public Const ENM_LINK = &H4000000
Public Const SW_SHOWNORMAL = 1

Type tagNMHDR
    hwndFrom As Long
    idFrom   As Long
    code     As Long
End Type

Type CHARRANGE
    cpMin As Long
    cpMax As Long
End Type

Type ENLINK
    nmhdr As tagNMHDR
    msg As Long
    wParam As Long
    lParam As Long
    chrg  As CHARRANGE
End Type

Type TEXTRANGE
    chrg As CHARRANGE
    lpstrText As Long
End Type

Public lpOriginalWndProc As Long
Public lOriginalhWnd As Long
Public myRTB As RichTextBox

Function RichTextBoxSubProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim udtNMHDR  As tagNMHDR
    Dim udtENLINK As ENLINK
    Dim udtTEXTRANGE As TEXTRANGE
    Dim strBuffer As String * 128
    Dim strOperation As String
    Dim strFileName As String
    Dim strDefaultDirectory As String
    Dim lhInstance As Long
    Dim lResult As Long

    ' Do we have a notification?
    If uMsg = WM_NOTIFY Then
        RtlMoveMemory udtNMHDR, ByVal lParam, Len(udtNMHDR) ' Ok, get copy of notification message header
        
        ' Are we dealing with a click on a URL in our RTB
        ' If so, then do our own handling since Microsoft's implimentation
        ' simply ignores the notification
        If udtNMHDR.hwndFrom = myRTB.hwnd And udtNMHDR.code = EN_LINK Then
            RtlMoveMemory udtENLINK, ByVal lParam, Len(udtENLINK)
            
            If udtENLINK.msg = WM_LBUTTONDOWN Then
                strBuffer = ""
                With udtTEXTRANGE
                    .chrg.cpMin = udtENLINK.chrg.cpMin
                    .chrg.cpMax = udtENLINK.chrg.cpMax
                    .lpstrText = StrPtr(strBuffer)
                End With
                With myRTB
                    lResult = SendMessage(.hwnd, EM_GETTEXTRANGE, 0, udtTEXTRANGE)
                End With
                RtlMoveMemory ByVal strBuffer, ByVal udtTEXTRANGE.lpstrText, Len(strBuffer)
                strOperation = "open"
                strFileName = strBuffer
                lhInstance = ShellExecute(Form1.hwnd, strOperation, strFileName, vbNullString, strDefaultDirectory, SW_SHOWNORMAL)
            End If
            
        End If
        
    End If
    
    RichTextBoxSubProc = CallWindowProc(lpOriginalWndProc, hwnd, uMsg, wParam, lParam)
End Function
[/color]

It may look like alot of code but lmost half of it is comments

 

[vb5prgrmr]

strongm you have done it again! I guess it has to be the classical education that you have (that I missed in the fast track). I guess I need to play some catch up. What and where do you get this info??? I guess it's time to hit the book stores again. What do you suggest?

And have another

on me.

 

[Hypetia]

Really cool stuff! Another

for strongm.

 

[afryer]

Hello,

Thanks for your all your help guys!!! really appreciated!

 

[Technokrat]

Is it possible to extend the functionality of RichTextBox hyperlinks in the following ways...

1) Use quotation marks, or some other character to allow hyperlinks to include space characters. For example, "\\MyPC\My Documents". As the code is currently it thinks that \\MyPC\My is the link.

2) Tagging a word or words with a hyperlink. For example, if the word TIPS were in a RTB, could it be selected, and then right click, or click another button and enter the URL

http://www.tek-tips.com

into the other field.

 

[strongm]

What we are using here is autorecognition of a URL. URL's cannot contain spaces, hence the technique shown here will (correctly) not recognise

file://MyPC/My Documents

as a URL

Basically, to address your points 1 and 2 you need to handle the links yourself. For this you need to be able to apply the CFE_LINK character format effect to the character strings that you want as links. Characters with this effect applied to them will then raise EN_LINK notifications (which the code I've presented already responds to). Given this info you should be able to figure out a way to achieve your goals.

 

[Technokrat]

Is there a way to have hyperlinks in a control array of RTBs?

 

[CubeE101]

A control array is just a collection of controls...

Why could you not have hyper links in them...

with a VERY slight modification to strongm's code, it works fine...

assuming RichTextBox1 is a control array...

Private Sub Form_Load()
    Dim lngEventMask As Long
    Dim Result As Long
    
    [b][COLOR=green]'Set myRTB = RichTextBox1[/color]
    [COLOR=blue]For Each myRTB In RichTextBox1[/color][/b]
    With myRTB
        ' Here's the easy bit: inform the RTB that is should recognise and highlight URLs
        Result = SendMessage(.hwnd, EM_AUTOURLDETECT, CLng(1), ByVal CLng(0))
        ' Example text. Note that URL recognizer will also happily recognise ftp:// and mailto:// URLs
        .Text = "[URL unfurl="true"]http://www.tek-tips.com"[/URL] & vbCrLf & "ftp.microsoft.com"
        
        ' Get current events that raise notofications in the RTB
        lngEventMask = SendMessage(.hwnd, EM_GETEVENTMASK, 0, ByVal CLng(0))
        ' Enable notifications for a URL being clicked
        ' (note: this only means that the notification is sent, not that VB will
        ' respond to it; we have to code that ourselves)
        If lngEventMask Xor ENM_LINK Then
            lngEventMask = lngEventMask Or ENM_LINK
        End If
        Result = SendMessage(.hwnd, EM_SETEVENTMASK, 0, ByVal CLng(lngEventMask))
         
        ' notifications go to parent of RTB, so the following line grabs and records
        ' the necessary hWnd for subclassing later on
         lOriginalhWnd = GetParent(.hwnd)
    End With
    [b][COLOR=blue]Next[/color][/b]
    
    Command1.Caption = "Notifications On"
    Command2.Caption = "Notifications Off"
    Command1.Enabled = True
    Command2.Enabled = False
End Sub

That's all you need...

BTW... Another

from me strongm... Good Stuff ;-)

Have Fun, Be Young... Code BASIC
-Josh

http://cubee.topcities.com

PROGRAMMER: Red-eyed, mumbling mammal capable of conversing with inanimate objects.

 

[ZmrAbdulla]

Hi all,
This is a great info provided here. I have tried this in MS Access forms with small modifications (CommandButton.SetFocus etc..). Almost works fine. Need to look into this later.

Here is my question something related to this.
How can I [blue]highlight[/blue] some [blue]KEYWORDS[/BLUE] in different color as they typed in?
thanks

Zameer Abdulla

http://www.geocities.com/zameerabd/