问题是:
我只想在第二列单击鼠标出现下拉框,这个目的达到了.
但是,如果我将横向滚动条向右移动,然后在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
我只想在第二列单击鼠标出现下拉框,这个目的达到了.
但是,如果我将横向滚动条向右移动,然后在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
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