问题是:
我只想在第二列单击鼠标出现下拉框,这个目的达到了.
但是,如果我将横向滚动条向右移动,然后在listview中点击,又会在其它列中出现下拉框?这个问题怎么解决??
代码如下:
Option Explicit
 Dim iFontHeight As LongPrivate Sub Form_Load()
  Dim j As Integer
  Dim itmX As ListItem
  Dim ColHead As ColumnHeader
  ListView1.ColumnHeaders.Add , , "This1"
  ListView1.ColumnHeaders.Add , , "This2"
  ListView1.ColumnHeaders.Add , , "This3"
  ListView1.ColumnHeaders.Add , , "This4"
  ListView1.ColumnHeaders.Add , , "This5"
  ListView1.ColumnHeaders(1).Width = 2000
  ListView1.ColumnHeaders(2).Width = 2000
  ListView1.View = lvwReport
  ListView1.GridLines = True
  ListView1.GridLines = True
  ListView1.Checkboxes = True
  ListView1.LabelEdit = lvwManual
  ListView1.Width = 7000
  ListView1.Height = 3000
  Combo1.ZOrder 0
  
  '添加一些实验数据
  For j = 1 To 33
    Set itmX = ListView1.ListItems.Add(, , "Data" & j)
    itmX.SubItems(1) = "Column2Row" & j
  Next j
  
  Set picGreenbar.Font = ListView1.Font
  iFontHeight = picGreenbar.TextHeight("b") + 78
  Set Combo1.Font = ListView1.Font
  End Sub
Private Sub ListView1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  
  Combo1.Width = ListView1.ColumnHeaders(2).Width
  
  If (x - ListView1.ColumnHeaders(1).Width) > 0 And (x - ListView1.ColumnHeaders(1).Width) < ListView1.ColumnHeaders(2).Width Then
     Combo1.Left = ListView1.ColumnHeaders(1).Width + ListView1.Left + 50
     Combo1.Top = Int(y / iFontHeight) * iFontHeight + ListView1.Top
     Combo1.Visible = True
  Else
     Combo1.Visible = False
  End If
  
End Sub

解决方案 »

  1.   

    按字体求行高也是不正确的,下面时除 Form_Load 之外的代码,注意要将 ListView 的 FullRowSelect 设为 True。
    Option Explicit
    Private Const LVM_FIRST As Long = &H1000
    Private Const LVM_GETSUBITEMRECT As Long = (LVM_FIRST + 56)
    Private Const LVIR_BOUNDS As Long = 0
    Private Const LVIR_ICON As Long = 1
    Private Const LVIR_LABEL As Long = 2Private Type POINTAPI
        x As Long
        y As Long
    End TypePrivate Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
    End TypeDeclare Function MapWindowPoints Lib "user32.dll" (ByVal hwndFrom As Long, _
                        ByVal hwndTo As Long, ByRef lppt As Any, ByVal cPoints As Long) As Long
    Declare Function MoveWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal x As Long, _
                        ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _
                        ByVal bRepaint As Long) As Long
    Declare Function PtInRect Lib "user32.dll" (ByRef lpRect As RECT, ByVal x As Long, _
                        ByVal y As Long) As Long
    Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, _
                        ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As LongPrivate Sub ListView1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
        Dim oItem As ListItem
        Dim rc As RECT, pt As POINTAPI
        
        Combo1.Visible = False
        
        Set oItem = ListView1.HitTest(x, y) '要求 FullRowSelect 必须为 True,否则第一列以外点不中
        If oItem Is Nothing Then Exit Sub
        
        rc.Top = 1 '第二列的 SubItems 的 Index 为 1
        rc.Left = LVIR_BOUNDS
        SendMessage ListView1.hwnd, LVM_GETSUBITEMRECT, oItem.Index - 1, rc
        
        pt.x = ScaleX(x, vbTwips, vbPixels)
        pt.y = ScaleY(y, vbTwips, vbPixels)
        If Not CBool(PtInRect(rc, pt.x, pt.y)) Then Exit Sub
        
        MapWindowPoints ListView1.hwnd, Me.hwnd, rc, 2
        MoveWindow Combo1.hwnd, rc.Left, rc.Top, (rc.Right - rc.Left), (rc.Bottom - rc.Top), 0&
        Combo1.Visible = True
    End Sub