Line and Character Position in Rich Text Box 5

[victoryhighway2]

Hello Group,
I'm trying to use the Microsoft Rich Text Box control as the basis of a basic text editor. I'm also using a Status Bar control in the form and I'd like to provide the line and character position of the cursor in the status bar. Getting the (absolute) character position is easy with the SelStart property of the RichTextBox control. However, I've been having difficulty trying to break that down into the line and the relative character position. This is the code that I've written so far:

Private Sub GetPosition()
    
    Dim strCAMS() As String
    Dim intCount As Integer
    Dim lngCount As Integer
    Dim lngLine As Long
    Dim lngChar As Long
    Dim strTest As String
    Dim intTest As Integer
    Dim strCharTest As String
    
    strCAMS = Split(Me.txtAddCams.Text, vbCrLf)
    
    intCount = 0
    lngCount = 0
    
    For intCount = LBound(strCAMS) To UBound(strCAMS)
    
        If intCount = LBound(strCAMS) Then
            intLineStart = 1
        End If
        
        intLineEnd = intLineStart + Len(strCAMS(intCount))
        
        lngCount = lngCount + Len(strCAMS(intCount)) + 2
        
        If (Me.txtAddCams.SelStart >= lngCount) And (Me.txtAddCams.SelStart <= lngCount) Then
            
            strTest = Mid(Me.txtAddCams.Text, lngCount, Len(strCAMS(intCount)))
            
            For intTest = 1 To Len(strTest)
                strCharTest = Mid(strTest, intTest, 1)
                
                If Asc(strCharTest) < &H20 And Asc(strCharTest) > &H7F Then
                    lngCount = lngCount + 1
                End If
            Next intTest
            
            If strCAMS(intCount) = strTest Then
                lngLine = intCount + 1
            
                lngChar = (Me.txtAddCams.SelStart - lngCount) + 1

                Me.sbStatusBar.Panels(Panels.Line).Text = "Line: " & lngLine
                Me.sbStatusBar.Panels(Panels.Char).Text = "Char: " & lngChar
            End If
            
            Exit For
        End If
        
    Next intCount
    
End Sub

So far, I haven't been able to figure this out.
Could anyone give me a hand with it?

I appreciate in advance and help you can offer.

Regards,
Geoffrey

 

[strongm]

[blue]Option Explicit

Private Const EM_LINEINDEX = &HBB
Private Const EM_LINEFROMCHAR = &HC9
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 Sub RichTextBox1_KeyUp(KeyCode As Integer, Shift As Integer)
    Label1.Caption = "Line: " & SendMessage(RichTextBox1.hwnd, EM_LINEFROMCHAR, -1, 0&) + 1 & " Position: " & RichTextBox1.SelStart - SendMessage(RichTextBox1.hwnd, EM_LINEINDEX, -1, 0&)
End Sub[/blue]

 

[Hypetia]

You can retrieve this info by sending appropriate messages to the RichTextBox control.
See the following code.
___
[tt]
'Declarations
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
Const WM_USER = &H400
Const EM_EXGETSEL = (WM_USER + 52)
Const EM_EXLINEFROMCHAR = (WM_USER + 54)
Const EM_LINEINDEX = &HBB
'
'Code
Dim Pos As Long, Row As Long, Col As Long, strStatus As String
Pos = RichTextBox1.SelStart
Row = SendMessage(RichTextBox1.hwnd, EM_EXLINEFROMCHAR, 0, ByVal Pos)
Col = Pos - SendMessage(RichTextBox1.hwnd, EM_LINEINDEX, Row, ByVal 0&)
strStatus = "Row: " & (Row + 1) & ", Col: " & (Col + 1)[/tt]

 

[strongm]

Too slow, Hypetia

 

[victoryhighway2]

Hello strongm and Hypetia,
I knew that there had to be an easier way to do this than what I was trying to do. I'll give this a shot and see what happens.

Many thanks for your help.

Regards,
Geoffrey

 

[Hypetia]

>Too slow, Hypetia
I can never be faster than you...

Actually, I was posting the same code as yours, but the documentation suggested that EM_EXLINEFROMCHAR message is more favorable for rich text boxes as the text size can exceed the 64K limits. Therefore I modified my code to make it fit for RTBs.

 

[strongm]

It's a fair point

 

[strongm]

(mind you, for a text editor based on an RTB I'd tend to use the alternative Text Object Model interface, as I've banged on about in the past ...)

 

[victoryhighway2]

Hello strongm and Hypetia,
This approach seems to work great! I'm giving both of you a star.

Thanks,
Geoffrey

 

[strongm]

What? No-one interested in tom?

 

[three57m]

>What? No-one interested in tom?

Dont know about everyone else but I for one am interested in tom.

 

[strongm]

Ok, a quick illustration. There's a little bit more set up to do, but once we have the tom interface (in the shape of ITextDocument) we have a lot more (and better) control over our RTB. You'll need a form with an RTB and a status bar with 6 panels. The just paste in the following code:

[blue]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 Const WM_USER = &H400&
Private Const EM_GETOLEINTERFACE = (WM_USER + 60)

Private tomDoc As ITextDocument

Private Sub Form_Load()
    Dim myIUnknown As Object
    
    ' OK, let's get the tom interface for our RichTextBox ...
    SendMessage RichTextBox1.hwnd, EM_GETOLEINTERFACE, 0&, myIUnknown
    Set tomDoc = myIUnknown
End Sub

Private Sub Command2_Click()
    RichTextBox1.SaveFile "c:\mytest3.rtf" ',
End Sub

Private Sub RichTextBox1_SelChange()
    Dim myRange As ITextSelection
    With tomDoc.Selection.Duplicate
        StatusBar1.Panels(3).Text = "Char: " & .GetIndex(tomCharacter)
        StatusBar1.Panels(1).Text = "Line: " & .GetIndex(tomLine)
        StatusBar1.Panels(4).Text = "Word: " & .GetIndex(tomWord)
        StatusBar1.Panels(5).Text = "Sent: " & .GetIndex(tomSentence)
        StatusBar1.Panels(6).Text = "Para: " & .GetIndex(tomParagraph)
        ' Do this next line last as it changes the selection, which would
        ' affect all our other counters
        StatusBar1.Panels(2).Text = "Col: " & Abs(.StartOf(tomLine, 0)) + 1
    End With
End Sub[/blue]

 

[strongm]

Er ... oops ... most importantly, you will, of course, need to set a reference to the tom object library (riched20.dll)

 

[RonRepp]

Cool!

Will this also work in .Net?



Ron Repp

If gray hair is a sign of wisdom, then I'm a genius.

 

[three57m]

Superb, thank you strongm