怎样获得指定行内容
如果我想获得Richtextbox中光标所在行的内容,并将行内容中指定字符串改变颜色,请问怎样实现?
[解决办法]
我这里有个TEXT的,不过Richtextbox需要改改
睡觉了
窗体
Option Explicit
Dim LineNo As Long, ColNo As Long, TmpStr As String
Private Sub Form_Load()
TxtTest.Text = "00000000 " & vbCrLf & "111111111 " & vbCrLf & "2222222222222 "
End Sub
Private Sub txttest_KeyUp(KeyCode As Integer, Shift As Integer)
Call GetCaretPos(TxtTest.hwnd, LineNo, ColNo)
lblLine.Caption = LineNo
lblCol.Caption = ColNo
Call TB_GetLine(TxtTest.hwnd, lblLine.Caption, TmpStr)
Me.Caption = TmpStr
End Sub
Private Sub txttest_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Call GetCaretPos(TxtTest.hwnd, LineNo, ColNo)
lblLine.Caption = LineNo
lblCol.Caption = ColNo
Call TB_GetLine(TxtTest.hwnd, lblLine.Caption, TmpStr)
Me.Caption = TmpStr
End Sub
模块
Option Explicit
Const EM_GETSEL = &HB0
Const EM_LINEFROMCHAR = &HC9
Const EM_LINEINDEX = &HBB
Public Const EM_GETLINE = &HC4
Public Const EM_LINELENGTH = &HC1
Private Declare Sub RtlMoveMemory Lib "KERNEL32 " (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
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
Public Sub GetCaretPos(ByVal hwnd5 As Long, LineNo As Long, ColNo As Long)
Dim i As Long, j As Long
Dim lParam As Long, wParam As Long
Dim k As Long
i = SendMessage(hwnd5, EM_GETSEL, wParam, lParam)
j = i / 2 ^ 16 '取得目前光标所在位置前有多少个Byte
LineNo = SendMessage(hwnd5, EM_LINEFROMCHAR, j, 0) '取得光标前面有多少行
LineNo = LineNo + 1
k = SendMessage(hwnd5, EM_LINEINDEX, -1, 0)
'取得目前光标所在行前面有多少个Byte
ColNo = j - k + 1
End Sub
Sub TB_GetLine(ByVal hwnd As Long, ByVal whichLine As Long, Line As String)
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 Sub