作者:NOYOKI要跑偏 | 来源:互联网 | 2022-12-02 18:40
我试图使用ListView控件进行拖放事件.我想将一个项目从位置1拖到其他地方......比如说,位置5(没有子项目).但是,当我这样做时,它什么也没做.但实际上,当我单步执行代码时,该remove
方法会删除该项.但它又回到了同一个地方,所以看起来它什么也没做.我需要根据这里添加API,因为它总是将它放在第一个位置.
在研究和添加API(我认为是问题)之前,我从这里获得了代码,并尝试根据我的具体需要定制它,但我无法让它工作.我正在运行32位Excel.
全局常量和句柄
'Windows API Constants
Public Const LOGPIXELSX = 88
Public Const LOGPIXELSY = 90
'Windows API Function Declarations
'Get a handle to the Device Context (a drawing layer) for a window
Public Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
'Get the capabilities of a device, from its Device Context
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, _
ByVal nIndex As Long) As Long
'Release the handle to the Device Context, to tidy up
Public Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, _
ByVal hDC As Long) As Long
拖放事件
Private Sub lvSortableColumn_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
Dim item As MSComctlLib.ListItem
Dim lngXPixelsPerInch As Long, lngYPixelsPerInch As Long
Dim lngDeviceHandle As Long
'We must determine the Pixels per Inch for the display device.
lngDeviceHandle = GetDC(0)
lngXPixelsPerInch = GetDeviceCaps(lngDeviceHandle, LOGPIXELSX)
lngYPixelsPerInch = GetDeviceCaps(lngDeviceHandle, LOGPIXELSY)
ReleaseDC 0, lngDeviceHandle
LVDragDropSingle lvSortableColumn, x * 1440 / lngXPixelsPerInch, y * 1440 / lngYPixelsPerInch
End Sub
程序
Public Sub LVDragDropSingle(ByRef lvList As ListView, ByVal x As Single, ByVal y As Single)
'Item being dropped
Dim objDrag As ListItem
'Item being dropped on
Dim objDrop As ListItem
'Item being readded to the list
Dim objNew As ListItem
'Drop position
Dim intIndex As Integer
'Retrieve the original items
Set objDrop = lvList.HitTest(x, y)
Set objDrag = lvList.SelectedItem
If (objDrop Is Nothing) Or (objDrag Is Nothing) Then
Set lvList.DropHighlight = Nothing
Set objDrop = Nothing
Set objDrag = Nothing
Exit Sub
End If
'Retrieve the drop position
intIndex = objDrop.Index
'Remove the dragged item
lvList.ListItems.Remove objDrag.Index
'Add it back into the dropped position
'Seems to fail on this line*****
Set objNew = lvList.ListItems.Add(intIndex, objDrag.Key, objDrag.Text) ', objDrag.Icon, objDrag.SmallIcon)
'Reselect the item
objNew.Selected = True
'Destroy all objects
Set objNew = Nothing
Set objDrag = Nothing
Set objDrop = Nothing
Set lvList.DropHighlight = Nothing
End Sub
编辑
在我的赏金耗尽之前,只是另外一条可能有用的信息.如果我在其中一个事件中停止,我注意到当我拖动一个项目时,它立即突出显示第一个项目.我想这可能就是为什么它不起作用.它在其他用户表单上的其他ListView中执行相同的操作.例如,如果最终用户单击某个项目,则该项目会突出显示.但如果他直接检查复选框而不点击实际项目,则会突出显示一个随机项目(通常是相同的项目).VBA中的ListView控件有一些非常奇怪的行为(如在线的一些人所指出的).