RTF selstart compared to position in textrtf 1

[Disferente]

Is there any way of relating selstart in a rtftextbox to where in the textrtf property it is?

What I want to do is to change the background color of the text where the cursor (selstart) is. The only way for me to know where to change the color is in the rtfcode, starting with \sub and ending with \nosupersub.

The only way I have found so far is to loop back decreasing selstart and checking selrtf for the startchar and then loopingn forwards increasing sellength.

I would rather not change the selstart and sellength at all.

 

[three57m]

>I would rather not change the selstart and sellength at all.
Below is code using windows API to achieve background highlighting and it does not change the selstart and sellength

Form Code

Private Sub Command1_Click()
    HighLightText RichTextBox1.hWnd, vbYellow
End Sub

Module Code

Option Explicit

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 Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, lColorRef As Long) As Long
Private Const WM_USER = &H400
Private Const EM_SETCHARFORMAT = (WM_USER + 68)
Private Const CFM_BACKCOLOR = &H4000000
Private Const CFE_AUTOBACKCOLOR = CFM_BACKCOLOR
Private Const LF_FACESIZE = 32
Private Const SCF_SELECTION = &H1&

Private Type RTFFORMAT
    cbSize As Integer
    wPad1 As Integer
    dwMask As Long
    dwEffects As Long
    yHeight As Long
    yOffset As Long
    crTextColor As Long
    bCharSet As Byte
    bPitchAndFamily As Byte
    szFaceName(0 To LF_FACESIZE - 1) As Byte
    wPad2 As Integer
    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


Public Function HighLightText(MyHwnd As Long, HighLightColor As OLE_COLOR)
    Dim MyFormat As RTFFORMAT
    
    If HighLightColor = -1 Then '// If value is -1 then
        MyFormat.dwMask = CFM_BACKCOLOR '// Set BackColor mask
        MyFormat.dwEffects = CFE_AUTOBACKCOLOR '// Set AutoBackColor Effect
        MyFormat.crBackColor = -1 '// Set color to autocolor
    Else
        MyFormat.dwMask = CFM_BACKCOLOR '// Set BackColor mask
        MyFormat.crBackColor = ColorTranslate(HighLightColor) '// Set backcolor to new value
    End If
    MyFormat.cbSize = Len(MyFormat) '// Size of structure
    '// Set char format to selection
    SendMessage MyHwnd, EM_SETCHARFORMAT, SCF_SELECTION, MyFormat
    
End Function

Private Function ColorTranslate(ByVal clr As OLE_COLOR, Optional hPal As Long = 0) As Long
    If OleTranslateColor(clr, hPal, ColorTranslate) Then
        ColorTranslate = -1
    End If
End Function

 

[Disferente]

Not quite what I wanted.
It's not the selected text that I want to highlight, it's the text around selstart.

 

[three57m]

not sure if I understand your need yet but try this:

Private Sub RichTextBox1_KeyDown(KeyCode As Integer, Shift As Integer)
    HighLightText RichTextBox1.hWnd, vbYellow
End Sub

 

[Disferente]

That just highlights the text that is selected.
What I need is something that highlights text that are not selected.

From selstart it need to check backwards until it finds \sub and then it needs to check forwards until it finds \nosupersub and then highlight everything in between.

 

[strongm]

>code using windows API to achieve background highlighting and it does not change the selstart and sellength

There are much easier ways of doing this with an RTB ...

So here's an example that changes the background colour in a much simpler fashion and provides a possible solution for the original post. You will need to add a reference to 'tom', the Text Object Model (a keyword search inthis forum should find a number of additional my examples of tom in action). Oh, and this illustrative code expects a form with an RTB called RichTextBox1:

[blue]    Dim myIUnknown As Object
    Dim tomDoc As ITextDocument

    SendMessage RichTextBox1.hwnd, EM_GETOLEINTERFACE, 0&, myIUnknown
    Set tomDoc = myIUnknown
    
    With tomDoc.Selection.Duplicate
        .StartOf tomCharFormat, 1
        .EndOf tomCharFormat, 1
        .Font.BackColor = vbYellow
    End With[/blue]

And yes, that's the whole example...

 

[three57m]

Adding to the post by strongm we can add support for hex color values by adding the colortranslate function

'Set a reference to "Tom"
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 Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, lColorRef As Long) As Long
Private Const WM_USER = &H400&
Private Const EM_GETOLEINTERFACE = (WM_USER + 60)


Private Sub Command1_Click()
    Dim myIUnknown As Object
    Dim tomDoc As ITextDocument

    SendMessage RichTextBox1.hWnd, EM_GETOLEINTERFACE, 0&, myIUnknown
    Set tomDoc = myIUnknown
    
    With tomDoc.Selection.Duplicate
        .StartOf tomCharFormat, 1
        .EndOf tomCharFormat, 1
        
        .Font.BackColor = ColorTranslate(&H8000000F) 'This would error without colortranslate
    End With
End Sub

Private Function ColorTranslate(ByVal clr As OLE_COLOR, Optional hPal As Long = 0) As Long
    If OleTranslateColor(clr, hPal, ColorTranslate) Then
        ColorTranslate = -1
    End If
End Function

 

[strongm]

>support for hex color values

I think you might want to clarify what you actually mean here is support for OLE_COLOR types such as the system colours like &H80000000F (vbButtonFace) or palette-matching like as &H2EECC99, since tom's font backcolor property quite happily handles all hex RGB COLORREFs

 

[three57m]

>what you actually mean here is...
Support for OLE_COLOR types.

Thank you for the clarification.