VB6.0文本框定位操作

'修改完善人：李荣慧 联系QQ：196110053
Option Explicit
Private Const EM_GETLINECOUNT = &HBA
'Public Const WM_USER = &H400
'Public Const EM_SETREADONLY = (WM_USER + 31)
Private Const EM_GETSEL = &HB0

Private Const EM_LINEFROMCHAR = &HC9
Private Const EM_GETLINE = &HC4
Private Const EM_LINELENGTH = &HC1
Private Const EM_LINEINDEX = &HBB
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
Private Declare Sub RtlMoveMemory Lib “KERNEL32” (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

Public Function GetaLine(Text1 As TextBox, ByVal ntx As Long) As String
Dim iB As Long
iB = LenB(StrConv(Text1.Text, vbFromUnicode))
'如果字串大于 255 byte，需增加该Byte Array。
ReDim str5(iB) As Byte
Dim str6 As String, i As Long
'字串的前两个Byte存该字串的最大长度。
str5(0) = 255
str5(1) = 255
'取出文字。

i = SendMessage(Text1.hWnd, EM_GETLINE, ntx, str5(0))
If i = 0 Then
    GetaLine = ""
Else
    str6 = StrConv(str5, vbUnicode)
    GetaLine = Left(str6, InStr(1, str6, Chr(0)) - 1)
End If

End Function

Public Function GetCurLineText(Text1 As TextBox) As String
Dim nLine As Long
Dim strContent As String

strContent = Text1.Text
nLine = GetCurLineNo(Text1)

GetCurLineText = GetaLine(Text1, nLine)

End Function

Public Function GetCurLineNo(Text1 As TextBox) As Integer
Dim nLine As Long
Dim strContent As String

strContent = Text1.Text

Dim i As Long, j As Long
Dim lparam As Long, wparam As Long
Dim k As Long
'向文本框传递EM_GETSEL消息以获取从起始位置到光标所在位置的字符数
i = SendMessage(Text1.hWnd, EM_GETSEL, wparam, lparam)
j = i / 2 ^ 16
'向文本框传递EM_LINEFROMCHAR消息根据获得的字符数确定光标所在行数
nLine = SendMessage(Text1.hWnd, EM_LINEFROMCHAR, j, 0)

GetCurLineNo = nLine

End Function
Function TB_GetLine(ByVal hWnd As Long, ByVal whichLine As Long, Line As String) As Long
Dim length As Long, bArr() As Byte, bArr2() As Byte, lc As Long
lc = SendMessage(hWnd, EM_LINEINDEX, whichLine, ByVal 0&)
length = SendMessage(hWnd, EM_LINELENGTH, lc, ByVal 0&)
If length > 0 Then
ReDim bArr(length + 1) As Byte, bArr2(length - 1) As Byte
Call RtlMoveMemory(bArr(0), length, 2) '准备一个存储器，传递消息之前先在存储器的前两个字节填入存储器的长度
Call SendMessage(hWnd, EM_GETLINE, whichLine, bArr(0))
Call RtlMoveMemory(bArr2(0), bArr(0), length)
Line = StrConv(bArr2, vbUnicode)
Else
Line = “”
End If
End Function
Function TB_GetLins(Text1 As TextBox) As Long
Dim lc As Long
lc = SendMessage(Text1.hWnd, EM_GETLINECOUNT, 0&, 0&)
TB_GetLins = lc
End Function