ListView控件拖放 [英] ListView Control Drag and Drop

问题描述

我正在尝试将ListView控件用于拖放事件.我想将项目从位置1拖到其他地方...例如，位置5(没有子项目).但是，当我这样做时，它什么也没做.但是，实际上，当我单步执行代码时， remove 方法会删除该项目.但是它直接放回原处，因此看起来什么也没做.我需要根据此处添加API，因为始终将其放在第一位.

I am trying to use a ListView control for a drag and drop event. I want to drag an item from position 1 to somewhere else...say, position 5 (there are no subitems). But when I do that it does nothing. But, actually, when I step through the code the remove method removes the item. But it places right back in the same place so it looks like it does nothing. I needed to add the APIs according to here because it would always place it in the first position.

在研究和添加API之前，我从此处获取了代码(我认为是一个问题)，并尝试根据我的特定需求进行调整，但我无法使其正常工作.我正在运行32位Excel.

I got the code from here before researching and adding the API (which I thought was the issue) and tried to tailor it to my specific need, but I can't get it to work. I am running 32-bit 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控件有一些非常奇怪的行为(在线上有些人指出).

Just an additional piece of information that might prove helpful before my bounty runs out. If I place a stop in one of the events I notice that when I drag an item it immediately highlights the first item. I think this could be why it won't work. It does this same thing in other ListViews on other userforms. For example, if the end user clicks an item, that item highlights. But if he checks the checkbox directly without clicking the actual item it highlights a random item (usually the same one). There is some very strange behavior with the ListView control in VBA (as noted by a few people online).

推荐答案

@Brian我使您的代码以某种粗略的方式工作首先将 Set objNew = lvList.ListItems.Add(intIndex，objDrag.Key，objDrag.Text)更改为 lvList.ListItems.Add intIndex，objDrag.Key，objDrag.Text 代码>使其工作.最后还添加了 LvList.refresh .然后乘以X&具有15的Y使 drophighlight 以某种粗略的方式工作.我还用了(20个要点来表示)

@Brian I made your code to work in some crude way 1st of all changing Set objNew = lvList.ListItems.Add(intIndex, objDrag.Key, objDrag.Text) to lvList.ListItems.Add intIndex, objDrag.Key, objDrag.Text made it work. Also LvList.refresh added at the end. Then multpliying X & Y with 15 make drophighlight to work in some crude way. Further I used (20 as twips to point)

Xp = Application.ActiveWindow.PointsToScreenPixelsX(X * 20)
Yp = Application.ActiveWindow.PointsToScreenPixelsY(Y * 20)

并使用Xp&是HitTest的Yp.它给出了更接近的结果(但仍然不完全准确).Xp&Yp没有声明，仅用作变体.声明Xp Yp为single会停止转换结果为0，因为hittest X Y为single并且 PointstoScreen 为Long. Csng()不起作用.我的显示器是1366 X 768.

and used Xp & Yp for HitTest. It gives more close result (but still not exactly). Xp & Yp are not declared and used as variant only. Declaring Xp Yp single will stop the conversion result to 0 as hittest X Y is single and PointstoScreen is Long. Csng() not working. My monitor is 1366 X 768.

以下是我的观察(仍未在程序中使用)我成功地使用了私有声明函数GetSystemMetrics Lib"user32"(ByVal whichMetric As Long)As Long 成功获取监视器宽度等.无法使gdi32正常工作.

Following are my observations (still not used in the program) I used Private Declare Function GetSystemMetrics Lib "user32" (ByVal whichMetric As Long) As Long successfully to get monitor width etc. Could not get gdi32 to work.

Xw = Application.ActiveWindow.UsableWidth
Yh = Application.ActiveWindow.UsableHeight

带来1009.5&399.不知道什么是单位

bringing in 1009.5 & 399. don't know what is the unit

Edit2:我忘记提及了，我直接在OLEDragDrop事件中使用了您的过程代码.我还使用了OLEDragOver事件

I forget to mention, I used your procedure code directly in OLEDragDrop event. I have also used OLEDragOver Event

Xp = Application.ActiveWindow.PointsToScreenPixelsX(X * 20)
Yp = Application.ActiveWindow.PointsToScreenPixelsY(Y * 20)
Set lvList.DropHighlight = lvList.HitTest(Xp, Yp)
  If lvList.DropHighlight Is Nothing Then
  Set lvList.DropHighlight = lvList.ListItems(lvList.ListItems.Count)
  End If

这篇关于ListView控件拖放的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！