[VB6] Register any control as a drop target that shows the Explorer drag image

[fafalone]

So I was writing some code to use this class with a TreeView, and wanted to replicate the expand-on-hover of Explorer.

So the first step was making a generic DragHover event:

Private Declare Function GetTickCount Lib "kernel32" () As Long

Private lHover1 As Long, lHover2 As Long
Private xHover As Long, yHover As Long
Private lRaiseHover As Long 'NOT SHOWN BUT NEEDED: set a default value in Class_Initialize. I use 2500 (2.5 seconds)
Private bHoverFired As Boolean

Public Event DragHover(X As Long, Y As Long, lKeyState As Long)

Public Property Let HoverTime(lMillisecs As Long): lRaiseHover = lMillisecs: End Property
Public Property Get HoverTime() As Long: HoverTime = lRaiseHover: End Property

Private Sub IDropTarget_DragOver(ByVal grfKeyState As Long, ByVal ptx As Long, ByVal ptY As Long, pdwEffect As oleexp3.DROPEFFECTS)
If (xHover <> ptx) Or (yHover <> ptY) Then
    lHover1 = GetTickCount()
    xHover = ptx
    yHover = ptY
    bHoverFired = False
Else
    If lHover1 = 0 Then 'initial run
        lHover1 = GetTickCount()
        xHover = ptx
        yHover = ptY
    Else
        If bHoverFired = False Then
            lHover2 = GetTickCount()
            If (lHover2 - lHover1) > lRaiseHover Then
                RaiseEvent DragHover(ptx, ptY, grfKeyState)
                bHoverFired = True 'set flag to not raise again until pt changes
            End If
        End If
    End If
End If

'[...] - end of added code; the rest of IDropTarget_DragOver is omitted

Now that we have a DragHover event (use not limited to or dependent on a treeview, useful for many situations with many controls), we can do autoexpand like this:

Private Sub cTVDrop_DragHover(X As Long, Y As Long, lKeyState As Long)
Dim tvhti As TVHITTESTINFO
Dim ppt As oleexp3.POINT
ppt.X = X
ppt.Y = Y
Call ScreenToClient(hTVD, ppt)
tvhti.pt.X = ppt.X
tvhti.pt.Y = ppt.Y
TreeView_HitTest hTVD, tvhti
If (tvhti.Flags And TVHT_ONITEM) Then
    TreeView_Expand hTVD, tvhti.hItem, TVE_EXPAND
End If

End Sub
Public Function TreeView_Expand(hWnd As Long, hItem As Long, dwFlags As Long) As Boolean
    TreeView_Expand = SendMessage(hWnd, TVM_EXPAND, ByVal dwFlags, ByVal hItem)
End Function

Getting closer to a release of this epic drop target class.. plan on getting it out before the new year.