Hi Maaspuck,
I was trying to enable multiple selection drag, that is why I changed the Events used
The problem lies here
The thing is that depending on the monitor / resolution and who knows what else the 19 and 14 do change
The recommended way to get the underlying index shoud be
But the problem here is that I'm getting x and y as pixel values and hittest needs twips.
I solved this with
Code: Select all
Dim TwipsPerPixelX
Dim TwipsPerPixelY
Dim strComputer
Dim objWMIService
Dim colItems
Dim objItem
TwipsPerPixelX = 0
TwipsPerPixelY = 0
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_DesktopMonitor")
For Each objItem in colItems
i=0
If objItem.PixelsPerXLogicalInch<>0 Then
i = 1440 \ objItem.PixelsPerXLogicalInch
End If
If i>TwipsPerPixelX Then
TwipsPerPixelX = i
End If
i=0
If objItem.PixelsPerYLogicalInch<>0 Then
i = 1440 \ objItem.PixelsPerYLogicalInch
End If
If i>TwipsPerPixelY Then
TwipsPerPixelY = i
End If
Next
If TwipsPerPixelX=0 Then TwipsPerPixelX=15
If TwipsPerPixelY=0 Then TwipsPerPixelY=15
Set objWMIService = Nothing
Set colItems = Nothing
Set objItem = Nothing
In a global scope (line 32)
and
Code: Select all
Set ListItem = ListView.Interf.HitTest(x * TwipsPerPixelX, y * TwipsPerPixelY)
I even got autoscrolling going on the listview
Can you test this sub to see if it highlights and scrolls for you? (It won't rearange the items yet)
Code: Select all
Sub lstDestination_OLEDragOver(Data, Effect, Button, Shift, x, y, State)
Dim ListView
Dim ListItem
Dim i, j
Set ListView = SDB.Objects("Destination")
ListView.Interf.MousePointer = 14
Set ListItem = ListView.Interf.HitTest(x * TwipsPerPixelX, y * TwipsPerPixelY)
j=0
If Not (IsNull(ListView.Interf.DropHighlight) Or IsEmpty(ListView.Interf.DropHighlight) Or ListView.Interf.DropHighlight Is Nothing) Then
j = ListView.Interf.DropHighlight.Index
End If
i=0
If ListItem Is Nothing Then
i=j
ElseIf Not (IsNull(ListItem) Or IsEmpty(ListItem)) Then
i = ListItem.Index
End If
If y >= ListView.Common.ClientHeight Then
If j<ListView.Interf.ListItems.Count Then
ListView.Interf.ListItems(j+1).EnsureVisible
Set ListView.Interf.DropHighlight = ListView.Interf.ListItems(j+1)
End If
ElseIf x<>0 And y<10 Then
If j>1 Then
ListView.Interf.ListItems(j-1).EnsureVisible
Set ListView.Interf.DropHighlight = ListView.Interf.ListItems(j-1)
End If
ElseIf i=0 Or j=0 Or i<>j Then
Set ListView.Interf.DropHighlight = ListItem
End If
Set ListItem = Nothing
Set ListView = Nothing
End Sub
So far so good, but I cannot get the OLEDragDrop event to fire
Code: Select all
Script.RegisterEvent .Interf, "OLEDragDrop","lstDestination_OLEDragDrop"
Private Sub lstDestination_OLEDragDrop(Data, Effect, Button, Shift, x, y)
SDB.MessageBox "In DragDrop",mtInformation,Array(mbOk)
End Sub
Gives an error on media monkey
Also I do beleive that some method to send a track to the bottom or first part of the list would be very usefull