'add a textbox with "multiline=true","scrollbars=2".
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 Declare Function SendMessageByNum Lib "USER32" _
Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SendMessageByString Lib "USER32" Alias _
"SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam _
As Long, ByVal lParam As String) As Long
Function GetLineText(ByVal txtbox As TextBox, ByVal LineIndex As Long) As String '返回指定行的内容
Dim lc As Long, linechar As Long
linechar = SendMessageByNum(txtbox.hWnd, EM_LINEINDEX, LineIndex, 0)
lc = SendMessageByNum(txtbox.hWnd, EM_LINELENGTH, linechar, 0) + 1
GetLineText = String(lc + 2, 0)
Mid(GetLineText, 1, 1) = Chr(lc And &HFF)
Mid(GetLineText, 2, 1) = Chr(lc \ &H100)
lc = SendMessageByString(txtbox.hWnd, EM_GETLINE, LineIndex, GetLineText)
GetLineText = Left(GetLineText, lc)
End Function
Function getlinewithstr(ByVal txtbox As TextBox, ByVal mystr As String) As String
Dim linecount As Long, temp() As String, i As Long
linecount = SendMessage(txtbox.hWnd, EM_GETLINECOUNT, 0, 0) '返回行数
ReDim temp(1 To linecount)
For i = 1 To linecount
temp(i) = "第" & i & "行:" & GetLineText(txtbox, i - 1) '添加行号
Next
getlinewithstr = Join(Filter(temp, mystr), vbCrLf) ' 字符串过滤
Erase temp
End Function
Private Sub Command1_Click()
MsgBox getlinewithstr(Text1, "asdf"), 0, "包含“asdf”的行"
End Sub
Private Sub Form_Load()
Dim a(20) As String, i As Long
For i = 0 To 20
a(i) = String(30, Chr(i + 65))
Next
Text1.Text = Join(a, "asdf")
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
Dim TxtInf As GetTextWord
Dim SelFlag As Boolean
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 '取得目前Caret所在前面有多少个byte
LineNo = SendMessage(hwnd5, EM_LINEFROMCHAR, j, 0) '取得前面有多少行
LineNo = LineNo + 1
k = SendMessage(hwnd5, EM_LINEINDEX, -1, 0)
'取得目前caret所在行前面有多少个byte
ColNo = j - k + 1
End Sub
Private Sub Form_Load()
Dim LineNo As Long, ColNo As Long
Call GetCaretPos(Text1.hwnd, LineNo, ColNo)
List1.AddItem "中国人民"
List1.AddItem "ASDZXSD"
List1.AddItem "ASCASD"
List1.AddItem "ASDFASDF"
List1.AddItem "ASDFASDF"
List1.AddItem "ASDFASDF"
List1.AddItem "ASDFASDF"
List1.AddItem "ASDFASDF"
List1.AddItem "ASDFASDF"
List1.AddItem "ASDFASDF"
List1.AddItem "ASDZXSD"
List1.AddItem "ASCASD"
List1.AddItem "ASDFASDF"
List1.AddItem "ASDFASDF"
List1.AddItem "ASDFASDF"
List1.AddItem "ASDFASDF"
List1.AddItem "ASDFASDF"
List1.AddItem "ASDFASDF"
End Sub
Private Sub List1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Or KeyAscii = 32 Then
SelFlag = True
Text1.SelStart = Text1.SelStart - Len(TxtInf.Word)
Text1.SelLength = Len(TxtInf.Word)
Text1.SelText = List1.List(List1.ListIndex) & "]"
List1.Visible = False
End If
SelFlag = False
End Sub
Private Sub Text1_Change()
If SelFlag Then Exit Sub
Call Text1_MouseDown(0, 0, TxtInf.X * Me.TextWidth("A"), TxtInf.Y * Me.TextHeight("A"))
Dim Index As Long
If List1.Visible Then
Index = SendMessage(List1.hwnd, LB_SELECTSTRING, -1, ByVal (TxtInf.Word))
Text1.SetFocus
End If
End Sub
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 32 Then Exit Sub
If List1.Visible Then
If KeyCode = 38 Then
KeyCode = 0
If List1.ListIndex > 0 Then
List1.ListIndex = List1.ListIndex - 1
End If
End If
If KeyCode = 40 Then
KeyCode = 0
If List1.ListIndex < List1.ListCount - 1 Then
List1.ListIndex = List1.ListIndex + 1
End If
End If
End If
Call Text1_MouseDown(0, 0, TxtInf.X * Me.TextWidth("A"), TxtInf.Y * Me.TextHeight("A"))
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
Dim i As Long
If KeyAscii = Asc("[") Then
List1.ListIndex = 0
List1.Visible = True
List1.SetFocus
Text1.SetFocus
End If
If KeyAscii = Asc("]") Then
List1.Visible = False
End If
If List1.Visible Then
If KeyAscii = 13 Or KeyAscii = 32 Then
SelFlag = True
Text1.SelStart = Text1.SelStart - Len(TxtInf.Word)
Text1.SelLength = Len(TxtInf.Word)
Text1.SelText = List1.List(List1.ListIndex) & "]"
List1.Visible = False
KeyAscii = 0
End If
End If
SelFlag = False
End Sub
Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
Dim LineNo As Long, ColNo As Long
If SelFlag Then Exit Sub
If KeyCode = 32 Then Exit Sub
Call GetCaretPos(Text1.hwnd, LineNo, ColNo)
TxtInf.Y = LineNo
TxtInf.X = ColNo
List1.Top = Text1.Top + TxtInf.Y * Me.TextHeight("A") + 45
List1.Left = Text1.Left + TxtInf.X * Me.TextWidth("A") - 120
End Sub
Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim LineNo As Long, ColNo As Long
For i = pos - 1 To 0 Step -1
If IsDelimiter(bArr(i)) Then
pos1 = i + 1
Exit For
End If
Next
For i = pos To UBound(bArr)
If IsDelimiter(bArr(i)) Then
pos2 = i - 1
Exit For
End If
Next
If pos2 >= pos1 Then
ReDim bArr2(pos2 - pos1) As Byte
For i = pos1 To pos2
bArr2(i - pos1) = bArr(i)
Next
GetWord = StrConv(bArr2, vbUnicode)
'SendMessage txt.hwnd, EM_SETSEL, pos1, ByVal CLng(pos2 + 1)
Else
GetWord = ""
End If
End Function
Function IsDelimiter(ByVal Char As Byte) As Boolean
Dim S As String
S = Chr(Char)
IsDelimiter = False
If S = " " Or S = "," Or S = "." Or S = "?" Or S = vbCr Or S = vbLf Or S = "[" Or S = "]" Then
IsDelimiter = True
End If
End Function
Function GetLine(txt As TextBox, ByVal Line As Integer) As String
Dim S As String, Length As Integer, pos As Long
GetLine = ""
pos = SendMessage(txt.hwnd, EM_LINEINDEX, Line, ByVal 0&)
Length = SendMessage(txt.hwnd, EM_LINELENGTH, pos, ByVal 0&)
S = String(Length, Chr(0))
RtlMoveMemory ByVal S, Length, 2
If SendMessage(Text1.hwnd, EM_GETLINE, Line, ByVal S) > 0 Then
GetLine = S
End If
End Function