Library articles and tutorials
RichTextBox Control
Automatic URL detection
The code below adds an automatic URL detection facility to the RichTextBox (which again, is actually built into it). The code uses subclassing, and the SSUBTMR.DLL (only 27K) file so that VB does not crash when you try to debug the program! The richtextbox is named rtfText, and you need a label called lblStatus.
Private m_bAutoURLDetect As Boolean
'// subclassing implementation
Implements ISubclass
Private m_emr As EMsgResponse
Private Sub rtfText_MouseMove(Button As Integer, Shift As Integer, x As Single,
y As Single)
lblStatus = ""
End Sub
Private Sub Form_Load()
AttachMessages
'// auto detect urls
AutoURLDetect = True
Form_Resize
End Sub
Private Sub Form_Unload(Cancel As Integer)
'// unsubclass!
DetachMessages
End Sub
Private Sub Form_Resize()
On Error Resume Next
rtfText.Move 0, 0, ScaleWidth, ScaleHeight
End Sub
'///////////////////////////////////////////////////////
'// Subclassing
'// Required for automatic url detection
'///////////////////////////////////////////////////////
Private Sub AttachMessages()
Dim dwMask As Long
AttachMessage Me, hwnd, WM_NOTIFY
'// we need to detect the link over messages
'// by setting enm_link, however, this then
'// cancels any other messages (such as the
'// change event, so we need to specify
'// these too.
' Key And Mouse Events
dwMask = ENM_KEYEVENTS Or ENM_MOUSEEVENTS
' Selection change
dwMask = dwMask Or ENM_SELCHANGE
' Update
dwMask = dwMask Or ENM_DROPFILES
' Scrolling
dwMask = dwMask Or ENM_SCROLL
' Update:
dwMask = dwMask Or ENM_UPDATE
' Change:
dwMask = dwMask Or ENM_CHANGE
dwMask = dwMask Or ENM_LINK
SendMessageLong rtfText.hwnd, EM_SETEVENTMASK, 0, dwMask
End Sub
Private Sub DetachMessages()
DetachMessage Me, hwnd, WM_NOTIFY
End Sub
Private Function ISubclass_WindowProc(ByVal hwnd As Long, ByVal iMsg As Long,
ByVal wParam As Long, ByVal lParam As Long) As Long
Dim tNMH As NMHDR_RICHEDIT
Dim tEN As ENLINK
Select Case iMsg
Case WM_NOTIFY
CopyMemory tNMH, ByVal lParam, Len(tNMH)
If (tNMH.hwndFrom = rtfText.hwnd) Then
Select Case tNMH.code
Case EN_LINK
CopyMemory
tEN, ByVal lParam, Len(tEN)
LinkOver
tEN.msg, tEN.chrg.cpMin, tEN.chrg.cpMax - tEN.chrg.cpMin
End Select
End If
End Select
End Function
Private Property Let ISubclass_MsgResponse(ByVal RHS As SSubTimer.EMsgResponse)
'// this sub has to exist whether you like it or not
End Property
Private Property Get ISubclass_MsgResponse() As SSubTimer.EMsgResponse
ISubclass_MsgResponse = emrPostProcess
End Property
'///////////////////////////////////////////////////////
'// URL detection
Public Property Let AutoURLDetect(ByVal bState As Boolean)
m_bAutoURLDetect = bState
SendMessageLong rtfText.hwnd, EM_AUTOURLDETECT, Abs(bState),
0
End Property
Public Property Get AutoURLDetect() As Boolean
AutoURLDetect = m_bAutoURLDetect
End Property
'// occurs when the mouse is moved over a link, or it is clicked
Public Sub LinkOver(ByVal iType As ERECLinkEventTypeCOnstants, ByVal lStart
As Long, ByVal lLength As Long)
Dim strText As String
strText = Mid$(rtfText.Text, lStart + 1, lLength + 1)
If (iType = ercLButtonUp) Then
If ShellExecute(hwnd, vbNullString,
strText, vbNullString, vbNullString, vbNormalFocus) = 2 Then
MsgBox "Link
Failed", vbExclamation
End If
Else
'lblStatus = "LinkOver: "
& strText
End If
End Sub
Then, add this code to a module
Public Type CHARRANGE
cpMin As Long
cpMax As Long
End Type
'// notification structures
Public Type NMHDR_RICHEDIT
hwndFrom As Long
wPad1 As Integer
idfrom As Integer
code As Integer
wPad2 As Integer
End Type
Public Type ENLINK
NMHDR As NMHDR_RICHEDIT
msg As Integer
wPad1 As Integer
wParam As Integer
wPad2 As Integer
lParam As Integer
chrg As CHARRANGE
End Type
'// events and messages
Public Const ENM_LINK = &H4000000
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBLCLK = &H206
Public Const WM_MBUTTONDOWN = &H207
Public Const WM_MBUTTONUP = &H208
Public Const WM_SETCURSOR = &H20
Public Const WM_MOUSEMOVE = &H200
Public Enum ERECLinkEventTypeCOnstants
ercLButtonDblClick = WM_LBUTTONDBLCLK
ercLButtonDown = WM_LBUTTONDOWN
ercLButtonUp = WM_LBUTTONUP
ercMouseMove = WM_MOUSEMOVE
ercRButtonDblClick = WM_RBUTTONDBLCLK
ercRButtonDown = WM_RBUTTONDOWN
ercRBUttonUp = WM_RBUTTONUP
ercSetCursor = WM_SETCURSOR
End Enum
Public Const WM_USER = &H400
Public Const EM_SETEVENTMASK = (WM_USER + 69)
Public Const WM_NOTIFY = &H4E
Public Const EN_LINK = &H70B&
'// Event Masks
Public Const ENM_NONE = &H0
Public Const ENM_CHANGE = &H1
Public Const ENM_UPDATE = &H2
Public Const ENM_SCROLL = &H4
Public Const ENM_KEYEVENTS = &H10000
Public Const ENM_MOUSEEVENTS = &H20000
Public Const ENM_REQUESTRESIZE = &H40000
Public Const ENM_SELCHANGE = &H80000
Public Const ENM_DROPFILES = &H100000
Public Const ENM_PROTECTED = &H200000
Public Const ENM_CORRECTTEXT = &H400000
' /* PenWin specific */
Public Const ENM_SCROLLEVENTS = &H8
Public Const ENM_DRAGDROPDONE = &H10
Public Const EM_SETTARGETDEVICE = (WM_USER + 72)
Public Const EM_SETTEXTMODE = (WM_USER + 89)
Public Const EM_AUTOURLDETECT = (WM_USER + 91)
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory"
(lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Public Declare Function SendMessageLong Lib "user32" Alias "SendMessageA"
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam
As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA"
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam
As Any) 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
That's it! This code has been adapted from VB Accelerator's RichEdit control.
Related articles
Related discussion
-
ditto
by zapthedingbat (2 replies)
-
Mousewheel
by jonh (3 replies)
-
True multithread VB source code controls
by James Crowley (3 replies)
-
Rely
by Yujvendra Verma (4 replies)
-
True multithread VB source code controls
by James Crowley (3 replies)
This is long past the topic post date but...
I used the selection method (where you select text and then update it), for formatting the output of an application's process in a RTF. This worked great until I needed to buffer the contents of the RTF. Once I started removing content from the RTF, the formatting I had applied through the selection method caused other text to be come improperly formatted.
I am now proceeding with the inserting text as RTF method.
I am had the same proplems;
RichTextBox1.SelectionFont.Bold
RichTextBox1.SelectionFont.Underline etc are readonly
Solved them the following way
Me.RichTextBox1.SelectionColor = Color.Blue Me.RichTextBox1.SelectionFont = New System.Drawing.Font("Tahoma", 8.25!, System.Drawing.FontStyle.Bold) Me.RichTextBox1.SelectedText = BlueBoldTextMe.RichTextBox1.SelectionColor = Color.Black
Me.RichTextBox1.SelectionFont = New System.Drawing.Font("Tahoma", 8.25!, System.Drawing.FontStyle.Regular)
Me.RichTextBox1.SelectedText = BlackRegularText
Kylua, your efforts were not wasted...
You have probably saved me a week's worth of head-pounding. Why it is so difficult to programmatically modify RTF using this control is beyond me. All of the examples I have seen rely on the .Find method to select the text you want to modify.
I am still going to learn the intricacies of RTF and what the difference is between a replace and simply assigning a string. Maybe there's some hidden header we can't see in the RTF property that an assignment overwrites but a replace does not.
Anyway, thanks for sharing this!![Big Smile [:D]](/emoticons/emotion-2a.gif)
I spent AGES working thru this one and couldn't find it anywhere!
The basic problem is that you have to update the richtextbox.rtf, not .text.
And it is very fussy about goes in there!!
A quick and dirty method is to set the richtextbox.text to a value such as "WHATEVER" and then replace that in the richtextbox.rtf with your rtf enabled code. As for what .rtf recognises in formatting, I resorted to copying and pasting rtf into the richtextbox and then looking at the .rtf value.
I only wanted a bit of bold!! By the time I had sorted it out I had decided on a different display method anyway so I hope someone uses this so I haven't wasted my time!!
The working code from my project, before I dump it:
richtextbox.Text =
"REPLACETHIS"Do While Not EOF(1)
Input(1, aLine)
info = Split(Replace(aLine, "\", "\\"), ",")
TempInfo = TempInfo & "\b Result Displayed: \b0" & info(1) & " \par " & "\b URL: \b0 " & info(0) & " \par " & "\b Interval: \b0 " & info(2) & " \par " & "\b Log Path: \b0 " & info(3) & " \par " & " \par "
Loop
richtextbox.Rtf = Replace(richtextbox.Rtf, "REPLACETHIS", TempInfo)
I've just done bolds and replaced the slashes as I was showing URLs and file paths.
James Crowley:
I am using vb6sp6(EMSETTEXTMODE didn't work with vb6sp4 either) RTB control, I have already implemented URL detection similar to yours. However now i am trying to get MULTI-LEVEL UNDO to work, which you stated can be revealed with EMSETTEXTMODE. My attempts at setting a value(42 or any value for that matter) using EMSETTEXTMODE(WMUSER+89) have been unsuccessful, by using EMGETTEXTMODE(WMUSER+90) to read the value(EMGETTEXTMODE always returns a 38). I have previously cleared the RTB with WMSETTEXT. I tried SendMessageLong and SendMessage. EM_SETTEXTMODE always returns a zero(non-error). Can you shed some light on why this may not be working? Can you pop an RTB control(VB6) on a form and test this again?
Thank you
Hi
These days I am trying to figure out why I get another new line in a RTB when I save the contents to a file. This line is placed at the position around 68000. There are about 72000 characters in the RTB.
I tried with FileSave method and with Open command. In both cases result was the same.
Oh, one thing to add. The change is not visible immediately. The new line is there when the file is reopened.
If the file is opened with WordPad the new line is there.
Marko
I think its to late to answer but, maybe someone uses it , huh?
You can use UpTo method.
Richtextbox1.UpTo strSTRING
it search text and goes there if there is strSTRING in richtextbox1 text. if there is no text it goes to the end.
You must enable Vertical Scroll Bar , and then samply use
Richtextbox1.UpTo "§"
Note: "§"=CHR(245), i use it because , i know there is no "§" in my richtextbox control, you can use something like that who wouldnt write it to the richtextbox.
Sorry for my english
Keep in Peace...
EceL sTyLe
How can I format text that I'm adding to the box? IE, the program prints a string into the box, and I want to change the colour of some of the text in the string. Also how can I find the cursor's position and the character it's in front of?
i am very like this code. it prints all the text. but how can extract some line from rtf.
for e.g. print 26 lines each from the rtf text.
hi
how can i call another form from the current MDI child form
ebi
hi
we used pre printed paper for printing. so i want spilt the contents of RTF text and print it on multiple page on particular start line and end line
pls help me
ebi
hi
i also want the same thong for my application
if u find any answer how to do this plz let me know
thanks in anticapation
mtikoo
I am writing code for a connection routine and am using a rich text box to display the responses from the server. However as the text is added the user is constantly haveing to manually scroll the window to see the new text. I would like the program to automaically scroll the window for the user. Any help on this would be appreciated. thanks
I'm using VB6 - sp5 - -
This code absolutely does not work with my system..... I've been told that it's because the RichTextBox that comes with VB is an older version of the dll -----
Can I get it to work by replacing the RichEd dll?
If so, where can I get it?
how can inert image into richtextbox ?
I believe the problem for VB'ers is that the RichText control is from richtx32.ocx, which is based on riched32.dll. As per Microsoft ( http://msdn.microsoft.com/library/en-us/shellcc/platform/commctls/richedit/richeditcontrols/aboutricheditcontrols.asp ) this library only supports one level of undo. Later versions of riched (riched20.dll, etc.) allow for multiple levels, but I have found no Microsoft ocx that uses this library.
Bottom line, not going to happen using ONLY Richtext control, even with the correct messages sent to it.
As a side note, I found a few logic errors in above code...
1)
Public Property Get CanCopy() As Boolean
If rtb1.SelLength < 0 Then
CanCopy = True
End If
End Property
Should read as
Public Property Get CanCopy() As Boolean
If rtb1.SelLength > 0 Then
CanCopy = True
End If
End Property
2)
With richtx32.ocx, the above code will display the undo all the time. This is confusing during runtime. Really we only want it to show if there is no redo. This requires one of any number of possible revisions. Generate your favorite.
I believe the problem for VB'ers is that the RichText control is from richtx32.ocx, which is based on riched32.dll. As per Microsoft ( http://msdn.microsoft.com/library/en-us/shellcc/platform/commctls/richedit/richeditcontrols/aboutricheditcontrols.asp ) this library only supports one level of undo. Later versions of riched (riched20.dll, etc.) allow for multiple levels, but I have found no Microsoft ocx that uses this library.
Bottom line, not going to happen using ONLY Richtext control, even with the correct messages sent to it.
As a side note, I found a few logic errors in above code...
1)
Public Property Get CanCopy() As Boolean
If rtb1.SelLength < 0 Then
CanCopy = True
End If
End Property
Should read as
Public Property Get CanCopy() As Boolean
If rtb1.SelLength > 0 Then
CanCopy = True
End If
End Property
2)
With richtx32.ocx, the above code will display the undo all the time. This is confusing during runtime. Really we only want it to show if there is no redo. This requires one of any number of possible revisions. Generate your favorite.
Is it possible to highlight a word in a "rich text box" and add a link to that word?
For example in Microsoft Word you can highlight a word, click "insert" on the tool bar, select Hyperlink and add an url address to that word. This word can then be clicked on to go to that web page.
Is this possible in RTB?
Thanks
Chris
cgroves@lycos.co.uk
How do you autodetect URL's in VB? Not .net!
RichTextBOx1.SelectionFont.Bold
RichTextBOx1.SelectionFont.Underline etc are readonly
How to set the formating for the selected text???
Hi,
Can u please tell me, how to do this in VB.NET or C#. I need it urgently.
Thanx
Ashok
VB.net has introduced a number of changes to the way you access the RichTextBox's properties. SelUnderline, SelBold, SelStrikethrough etc are now available in the
richTextBox1.SelectionFont
property. For example, in VB.net, use
richTextBox1.SelectionFont.Underline
instead of
richTextBox1.SelUnderline
I will try to update the tutorial to be .net compliant in the next month or so.
but still can only undo level 1,why?can u tell me?thank you very much.
What o/s are you running? on Windows 2000/XP, the richtext box has been "upgraded" to include multiple undo/redo.. otherwise, you'll probably be left with the old single undo/redo..
i expirienced the same thing... does anyone have a working example on this?
After using this code the undo level is still 1.
Can someone help me out ?
Thank you !