mi5
asked on
Web URL hot spot on a rich text box
I have a rich text box which holds some text, including a URL (e.g. "www.yahoo.com"). Is it possible to make the mouse pointer change to a hand when the mouse is moved over this URL, and then control what happens when the user clicks on it?
i wrote code for someone to do this but it assumed the url to begin with "http". however it did function just like a hyperlink. heres a function to tell you what word you are over in a richtextbox, just check if the left three letters are "www" in your case:
'SEE WHAT WORD YOU ARE OVER IN RICHTEXTBOX CONTROL
'ADD A RICHTEXTBOX CONTROL AND A LABEL TO THE FORM
'************************* ********** ********** ********** ********** *******
'
'FORM CODE
'
'************************* ********** ********** ********** ********** *******
Private Const EM_CHARFROMPOS& = &HD7
Private Type POINTAPI
X As Long
Y As Long
End Type
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
' Return the word the mouse is over.
Public Function RichWordOver(rch As RichTextBox, X As Single, Y As Single) As String
Dim pt As POINTAPI
Dim pos As Integer
Dim start_pos As Integer
Dim end_pos As Integer
Dim ch As String
Dim txt As String
Dim txtlen As Integer
On Error Resume Next
' Convert the position to pixels.
pt.X = X \ Screen.TwipsPerPixelX
pt.Y = Y \ Screen.TwipsPerPixelY
' Get the character number
pos = SendMessage(rch.hWnd, EM_CHARFROMPOS, 0&, pt)
If pos <= 0 Then Exit Function
' Find the start of the word.
txt = rch.Text
For start_pos = pos To 1 Step -1
ch = Mid$(rch.Text, start_pos, 1)
' Allow digits, letters, and underscores.
If Not ( _
(ch >= "0" And ch <= "9") Or _
(ch >= "a" And ch <= "z") Or _
(ch >= "A" And ch <= "Z") Or _
ch = "_" _
) Then Exit For
Next start_pos
start_pos = start_pos + 1
' Find the end of the word.
txtlen = Len(txt)
For end_pos = pos To txtlen
ch = Mid$(txt, end_pos, 1)
' Allow digits, letters, and underscores.
If Not ( _
(ch >= "0" And ch <= "9") Or _
(ch >= "a" And ch <= "z") Or _
(ch >= "A" And ch <= "Z") Or _
ch = "_" _
) Then Exit For
Next end_pos
end_pos = end_pos - 1
If start_pos <= end_pos Then _
RichWordOver = Mid$(txt, start_pos, end_pos - start_pos + 1)
End Function
Private Sub Form_Load()
RichTextBox1.Text = "Test this code sample to check what" & vbCrLf & _
"word you are over inside the richtextbox control."
End Sub
Private Sub RichTextBox1_MouseMove(But ton As Integer, Shift As Integer, X As Single, Y As Single)
Dim txt As String
txt = RichWordOver(RichTextBox1, X, Y)
If Label1.Caption <> txt Then _
Label1.Caption = txt
End Sub
'SEE WHAT WORD YOU ARE OVER IN RICHTEXTBOX CONTROL
'ADD A RICHTEXTBOX CONTROL AND A LABEL TO THE FORM
'*************************
'
'FORM CODE
'
'*************************
Private Const EM_CHARFROMPOS& = &HD7
Private Type POINTAPI
X As Long
Y As Long
End Type
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
' Return the word the mouse is over.
Public Function RichWordOver(rch As RichTextBox, X As Single, Y As Single) As String
Dim pt As POINTAPI
Dim pos As Integer
Dim start_pos As Integer
Dim end_pos As Integer
Dim ch As String
Dim txt As String
Dim txtlen As Integer
On Error Resume Next
' Convert the position to pixels.
pt.X = X \ Screen.TwipsPerPixelX
pt.Y = Y \ Screen.TwipsPerPixelY
' Get the character number
pos = SendMessage(rch.hWnd, EM_CHARFROMPOS, 0&, pt)
If pos <= 0 Then Exit Function
' Find the start of the word.
txt = rch.Text
For start_pos = pos To 1 Step -1
ch = Mid$(rch.Text, start_pos, 1)
' Allow digits, letters, and underscores.
If Not ( _
(ch >= "0" And ch <= "9") Or _
(ch >= "a" And ch <= "z") Or _
(ch >= "A" And ch <= "Z") Or _
ch = "_" _
) Then Exit For
Next start_pos
start_pos = start_pos + 1
' Find the end of the word.
txtlen = Len(txt)
For end_pos = pos To txtlen
ch = Mid$(txt, end_pos, 1)
' Allow digits, letters, and underscores.
If Not ( _
(ch >= "0" And ch <= "9") Or _
(ch >= "a" And ch <= "z") Or _
(ch >= "A" And ch <= "Z") Or _
ch = "_" _
) Then Exit For
Next end_pos
end_pos = end_pos - 1
If start_pos <= end_pos Then _
RichWordOver = Mid$(txt, start_pos, end_pos - start_pos + 1)
End Function
Private Sub Form_Load()
RichTextBox1.Text = "Test this code sample to check what" & vbCrLf & _
"word you are over inside the richtextbox control."
End Sub
Private Sub RichTextBox1_MouseMove(But
Dim txt As String
txt = RichWordOver(RichTextBox1,
If Label1.Caption <> txt Then _
Label1.Caption = txt
End Sub
There is a very good third party rich edit control called Alltext from Bennet-Tec Information systems that will allow you to do all of what you're asking. They have a demo download at :
http://www.bennet-tec.com
Good luck!!
http://www.bennet-tec.com
Good luck!!
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
http://www.vbexplorer.com/VB_String_Text.asp