Printable View
Hello friends. I'm stuck in one of my project and need ur help. I want to highlight text as we do in MS-Word. Setting forecolor, backcolor are simple things but setting highlight color is really killin me. Though I've come to know a method using DHTMLEDIT control but i need it to be done using Richtextbox. Pls help. I've attached a sample image to get u the right feeling.
This question has been posted before, but I, somehow, never got the following code working using vb:
http://www.vbgarage.com/FileDetail.a...ects&FileId=21
Try this link in this forum
http://forums.vb-world.net/showthrea...hreadid=107655
You can't do it with a the standard RichTextBox that's shipped with VB. You need to create a RichEdit 2.0 control, via API, then send the EM_SETCHARFORMAT message with the crBackColor member set to your highlight colour.
Thanx it may really be of a great help.
can somebody please help me more on this ?
how do you set the crbackcolor ?
and how do you set the selected text range when you send the
message to the richtextbox?
thanks!
I found the solution to the problem
i got some source code from vbaccelerator.com which have made a richtextbox that does exactly this thing
http://www.vbaccelerator.com/home/VB...chEdit_ctl.asp
the only problem is that it uses Richeditbox20 while i do have
richeditbox32 and it does not seem to work !
any help?
Here is the code in a module
-------------
Attribute VB_Name = "highlight"
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const LF_FACESIZE = 32
Public Const EM_SETCHARFORMAT = (WM_USER + 68)
Public Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, lColorRef As Long) As Long
Public Type CHARFORMAT2
cbSize As Integer '2
wPad1 As Integer '4
dwMask As Long '8
dwEffects As Long '12
yHeight As Long '16
yOffset As Long '20
crTextColor As Long '24
bCharSet As Byte '25
bPitchAndFamily As Byte '26
szFaceName(0 To LF_FACESIZE - 1) As Byte ' 58
wPad2 As Integer ' 60
' Additional stuff supported by RICHEDIT20
wWeight As Integer ' /* Font weight (LOGFONT value) */
sSpacing As Integer ' /* Amount to space between letters */
crBackColor As Long ' /* Background color */
lLCID As Long ' /* Locale ID */
dwReserved As Long ' /* Reserved. Must be 0 */
sStyle As Integer ' /* Style handle */
wKerning As Integer ' /* Twip size above which to kern char pair*/
bUnderlineType As Byte ' /* Underline type */
bAnimation As Byte ' /* Animated text like marching ants */
bRevAuthor As Byte ' /* Revision author index */
bReserved1 As Byte
End Type
' /* EM_SETCHARFORMAT wParam masks */
Public Const SCF_SELECTION = &H1&
Public Const SCF_WORD = &H2&
Public Const SCF_DEFAULT = &H0& '// set the default charformat or paraformat
Public Const SCF_ALL = &H4& '// not valid with SCF_SELECTION or SCF_WORD
Public Const SCF_USEUIRULES = &H8& '// modifier for SCF_SELECTION; says that
' // the format came from a toolbar, etc. and
' // therefore UI formatting rules should be
' // used instead of strictly formatting the
' // selection.
Public Const ercSetFormatAll = SCF_ALL
Public Const ercSetFormatSelection = SCF_SELECTION
Public Const ercSetFormatWord = SCF_WORD Or SCF_SELECTION
' /* CHARFORMAT masks */
Public Const CFM_BOLD = &H1
Public Const CFM_ITALIC = &H2
Public Const CFM_UNDERLINE = &H4
Public Const CFM_STRIKEOUT = &H8
Public Const CFM_PROTECTED = &H10
Public Const CFM_LINK = &H20& ' /* Exchange hyperlink extension */
Public Const CFM_SIZE = &H80000000
Public Const CFM_COLOR = &H40000000
Public Const CFM_FACE = &H20000000
Public Const CFM_OFFSET = &H10000000
Public Const CFM_CHARSET = &H8000000
Public Const CFM_BACKCOLOR = &H4000000
' /* CHARFORMAT effects */
Public Const CFE_BOLD = &H1&
Public Const CFE_ITALIC = &H2&
Public Const CFE_UNDERLINE = &H4&
Public Const CFE_STRIKEOUT = &H8&
Public Const CFE_PROTECTED = &H10&
Public Const CFE_LINK = &H20&
Public Const CFE_AUTOCOLOR = &H40000000 ' /* NOTE: this corresponds to */
' /* CFM_COLOR, which controls it */
Public Const yHeightCharPtsMost = 1638&
Public Sub FontBackColour(ByVal oColor As OLE_COLOR)
Dim tCF2 As CHARFORMAT2
Dim lR As Long
' If (m_eVersion = eRICHED20) Then
If oColor = -1 Then
tCF2.dwMask = CFM_BACKCOLOR
tCF2.dwEffects = CFE_AUTOBACKCOLOR
tCF2.crBackColor = -1
Else
tCF2.dwMask = CFM_BACKCOLOR
tCF2.crBackColor = TranslateColor(oColor)
End If
tCF2.cbSize = Len(tCF2)
lR = SendMessage(Form1.EditBox(ei).hwnd, EM_SETCHARFORMAT, ercSetFormatWord, tCF2)
' Else
' Unsupported
'End If
End Sub
Public Function TranslateColor(ByVal clr As OLE_COLOR, _
Optional hPal As Long = 0) As Long
If OleTranslateColor(clr, hPal, TranslateColor) Then
TranslateColor = -1
End If
End Function