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 Function CuentaLineas(ByVal Hwnd As Long) As Long
Const EM_GETLINECOUNT = &HBA
CuentaLineas = SendMessage(Hwnd, EM_GETLINECOUNT, 0&, 0&)
End Function
Private Function LargoLinea(ByVal Hwnd As Long, ByVal Linea As Long) As Long
Const EM_LINEINDEX = &HBB
Const EM_LINELENGTH = &HC1
Dim l1 As Long
l1 = SendMessage(Hwnd, EM_LINEINDEX, Linea, 0&)
If l1 > -1 Then
LargoLinea = SendMessage(Hwnd, EM_LINELENGTH, l1, 0&)
Else
LargoLinea = 0
End If
End Function
Private Sub Text1_Click()
debug.print RowCol
End Sub
Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
debug.print RowCol
End Sub
Private Function RowCol() As String
Dim lRow As Long, lLen As Long
Dim lStart As Long, lPos As Long
lStart = Text1.SelStart
lPos = InStr(1, Text1.Text, vbCrLf)
While lPos < Text1.SelStart And lPos > 0
lStart = lStart - 2
lPos = InStr(lPos + 1, Text1.Text, vbCrLf)
Wend
lPos = 0
Do
lLen = LargoLinea(Text1.Hwnd, lRow)
lRow = lRow + 1
If lStart > lLen Then
lStart = lStart - lLen
Else
If Text1.SelStart > 2 Then
If Mid(Text1.Text, Text1.SelStart - 1, 2) = vbCrLf Then
lStart = 0
lRow = lRow + 1
End If
End If
If lStart = lLen And Text1.SelStart < Len(Text1.Text) - 1 Then
If Mid(Text1.Text, Text1.SelStart + 1, 2) <> vbCrLf Then
lStart = 0
lRow = lRow + 1
End If
End If
lStart = lStart + 1
Exit Do
End If
Loop
RowCol = "Fila " & lRow & " , columna " & lStart
End Function