高分求listbox右键弹出位置问题，分数不够可再加100分，一定要解决

Question

我想在listbox控件中按右键弹出一个编辑菜单，但是做好后发现无论你在listbox控件中的任何位置点右键都弹出此菜单，感觉不好。我的意思是想在有内容的地方点右键才能弹出菜单，并且这个内容在点右键时也高亮。请大家帮忙。
我的弹出右键代码如下：
Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
   PopupMenu menu1
End If
End Sub
其中menu1菜单已经做好了。关键是何时应该弹出和内容高亮问题

Answer 1

//可以用子类处理消息事件
listbox提供了相应的消息，不用进行子类处理：Option Explicit
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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As _
    Any, dest As Any, ByVal numBytes As Long)
Const LB_ITEMFROMPOINT = &H1A9
Function ListBoxItemFromPoint(hwnd As Long, ByVal X As Long, ByVal Y As Long) As Long
    Dim lParam As Long
    lParam = X
    CopyMemory ByVal VarPtr(lParam) + 2, Y, 2
    ListBoxItemFromPoint = SendMessage(hwnd, LB_ITEMFROMPOINT, 0, ByVal lParam)
End FunctionPrivate Sub Form_Load()
    Dim i As Long
    For i = 1 To 50
        List1.AddItem "line " + CStr(i)
    Next
End SubPrivate Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 2 Then
        Dim ItemIndex As Long
        ItemIndex = ListBoxItemFromPoint(List1.hwnd, ScaleX(X, vbTwips, vbPixels), ScaleY(Y, vbTwips, vbPixels))
        If ItemIndex > 32767 Then
            Exit Sub
        End If
        List1.ListIndex = ItemIndex
        PopupMenu menu1
     End If
End Sub

Answer 2

'添加listbox和command控件
Option Explicit
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
Const LB_ITEMFROMPOINT = &H1A9Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim pos As Long, idx As Long
pos = X / Screen.TwipsPerPixelX + Y / Screen.TwipsPerPixelY * 65536
idx = SendMessage(List1.hWnd, LB_ITEMFROMPOINT, 0, ByVal pos)
' idx 即等于鼠标所在位置的选项
If idx < 65536 And Button = 2 Then
List1.ListIndex = idx
PopupMenu menu
End If
End SubPrivate Sub Command1_Click()
Static i
i = i + 1
List1.AddItem "text" & i
End Sub