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

[progame]

.

[anosoft]

如果是listview控件 listview.HoverSelection = True

[bydisplay]

'下面程序给你一个思路，稍做改动即可
'添加模块
Option Explicit

Public 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 = &HB1

Declare 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 Sub

Function 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 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 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

Private 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

[progame]

LB_ITEMFROMPOINT

应该是这个了

[rappercn]

什么控件？ListBox吗？

[rappercn]

恭喜恭喜。

[progame]

同喜同喜