Option Explicit
Private 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
Private Const EM_GETSEL = &HB0
Private Const EM_LINEINDEX = &HBB
Private Const EM_LINELENGTH = &HC1
Private Const EM_LINEFROMCHAR = &HC9
Dim overallCursorPos As Long
Dim currLinePos As Long
Dim chrsBeforeCurrLine As Long
Dim CurrLineCursorPos As Long
Private Sub DispCaretPos()
On Local Error Resume Next
' cursor position i rtfkontrollen (med CR & LF om de finns, 0-baserad)
overallCursorPos = SendMessageLong(RichTextBox1.hwnd, EM_GETSEL, 0, 0&) \ &H10000
' aktuell kolumn position (Notera: 0-baserad)
currLinePos = SendMessageLong(RichTextBox1.hwnd, EM_LINEFROMCHAR, _
overallCursorPos, 0&)
' antal tecken fram, men före början av aktuell rad
chrsBeforeCurrLine = SendMessageLong(RichTextBox1.hwnd, EM_LINEINDEX, _
currLinePos, 0&)
' cursor position endast på aktuell rad
CurrLineCursorPos = overallCursorPos - chrsBeforeCurrLine
RichTextBox1.SetFocus
StatusBar1.Panels(1).Text = "Pos: " & CStr(currLinePos + 1) & ":" & _
CStr(CurrLineCursorPos + 1) & Space(1)
End Sub
Private Sub RichTextBox1_KeyDown(KeyCode As Integer, Shift As Integer)
DispCaretPos
End Sub
Private Sub RichTextBox1_KeyPress(KeyAscii As Integer)
DispCaretPos
End Sub
Private Sub RichTextBox1_KeyUp(KeyCode As Integer, Shift As Integer)
DispCaretPos
End Sub
Private Sub RichTextBox1_Change()
DispCaretPos
End Sub
Private Sub richtextbox1_Click()
DispCaretPos
End Sub