如何通过鼠标移动来自动选中光标所在的列表项

Question

.

Answer 1

如果是listview控件 listview.HoverSelection = True

Answer 2

'下面程序给你一个思路，稍做改动即可
'添加模块
Option ExplicitPublic Const EM_CHARFROMPOS = &HD7
Public Const EM_GETLINECOUNT = &HBA
Public Const EM_GETLINE = &HC4
Public Const EM_LINEINDEX = &HBB
Public Const EM_LINELENGTH = &HC1
Public Const EM_SETSEL = &HB1Declare Sub RtlMoveMemory Lib "KERNEL32" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
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 Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim pos As Long, lc As Long
    Dim Line As Integer, CharPos As Integer
    
    pos = X / Screen.TwipsPerPixelX + Y / Screen.TwipsPerPixelY * 65536
    lc = SendMessage(Text1.hwnd, EM_CHARFROMPOS, 0, ByVal pos)
    
    Line = lc \ 65536
    CharPos = lc Mod 65536
    
    MsgBox " = " & GetLine(Text1, Line) & vbCrLf & "单词= " & GetWord(Text1, CharPos)
End SubFunction GetWord(txt As TextBox, pos As Integer) As String
    Dim bArr() As Byte, pos1 As Integer, pos2 As Integer, i As Integer
    
    bArr = StrConv(txt.Text, vbFromUnicode)
    pos1 = 0: pos2 = UBound(bArr)
    
    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 FunctionFunction 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 Then
        IsDelimiter = True
    End If
End FunctionFunction 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 FunctionPrivate Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim pos As Long, lc As Long
    Dim Line As Integer, CharPos As Integer
    
    pos = X / Screen.TwipsPerPixelX + Y / Screen.TwipsPerPixelY * 65536
    lc = SendMessage(Text1.hwnd, EM_CHARFROMPOS, 0, ByVal pos)
    
    Line = lc \ 65536
    CharPos = lc Mod 65536
    
    Text1.ToolTipText = GetWord(Text1, CharPos)
End Sub