OLEDragDrop Event

Description

Occurs when a source component is dropped onto a target component when the source component determines that a drop can occur.

Syntax

Public Event OLEDragDrop( _
    ByVal Data As DataObject, _
    ByRef Effect As Long, _
    ByVal Button As Integer, _
    ByVal Shift As Integer, _
    ByVal x As Long, _
    ByVal y As Long _
)

Parameters

Data
A DataObject object containing formats that the source will provide and, in addition, possibly the data for those formats. If no data is contained in the DataObject, it is provided when the control calls the GetData method.
Effect
A long integer set by the target component identifying the action that has been performed (if any), thus allowing the source to take appropriate action if the component was moved (such as the source deleting the data).
Button
An integer which acts as a bit field corresponding to the state of a mouse button when it is depressed. The left button is bit 0, the right button is bit 1, and the middle button is bit 2. These bits correspond to the values 1, 2, and 4, respectively. It indicates the state of the mouse buttons; some, all, or none of these three bits can be set, indicating that some, all, or none of the buttons are depressed.
Shift
An integer which acts as a bit field corresponding to the state of the shift, ctrl, and alt keys when they are depressed. The shift key is bit 0, the ctrl key is bit 1, and the alt key is bit 2. These bits correspond to the values 1, 2, and 4, respectively. The shift parameter indicates the state of these keys; some, all, or none of the bits can be set, indicating that some, all, or none of the keys are depressed. For example, if both the ctrl and alt keys were depressed, the value of shift would be 6.
x
A number which specifies the current location of the mouse pointer. The x and y values are always expressed in terms of the coordinate system set by the ScaleHeight, ScaleWidth, ScaleLeft, and ScaleTop properties of the object.
y
A number which specifies the current location of the mouse pointer. The x and y values are always expressed in terms of the coordinate system set by the ScaleHeight, ScaleWidth, ScaleLeft, and ScaleTop properties of the object.

Example

Drag and Drop from an External Source (Visual Basic)

This sample illustrates how to drag and drop custom items into the Grid control. This sample assumes this is a List View named wndListView.

Dim DragListItem As ListItem

Private Sub Form_Load()
    wndGridControl.Columns.Add 0, "Files", 100, True
    wndListView.ListItems.Add , , "File 1"
    wndListView.ListItems.Add , , "File 2"
    wndListView.ListItems.Add , , "File 3"
End Sub

Private Sub wndListView_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If (Button = vbLeftButton) Then
        Dim Item As ListItem
        Set Item = wndListView.HitTest(x, y)
        If (Not Item Is Nothing) Then
            Set DragListItem = Item
            wndListView.OLEDrag
            Set DragListItem = Nothing
        End If
    End If
End Sub

Private Sub wndListView_OLEStartDrag(Data As MSComctlLib.DataObject, AllowedEffects As Long)
    If Not DragListItem Is Nothing Then
        AllowedEffects = vbDropEffectCopy
        Data.SetData DragListItem.Text, vbCFText
    End If
End Sub

Private Sub wndListView_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
    If (Data.GetFormat(vbCFText)) Then
        Effect = vbDropEffectCopy
        Dim Text As String
        Text = Data.GetData(vbCFText)
    ElseIf Data.GetFormat(vbCFFiles) Then
        Effect = vbDropEffectCopy
        For Each File In Data.Files
            wndListView.ListItems.Add , , File
        Next
    Else
        Effect = vbDropEffectNone
    End If
End Sub

Private Sub wndListView_OLEDragOver(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single, state As Integer)
    If (Data.GetFormat(vbCFText)) Then
        Effect = vbDropEffectCopy
    ElseIf Data.GetFormat(vbCFFiles) Then
        Effect = vbDropEffectCopy
    Else
        Effect = vbDropEffectNone
    End If
End Sub

Private Sub wndGridControl_OLEDragDrop(ByVal Data As XtremeGridControl.DataObject, Effect As Long, ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    Dim Record As GridRecord
    If Data.GetFormat(vbCFText) Then
        Effect = vbDropEffectCopy
        Dim Text As String
        Text = Data.GetData(vbCFText)
        Dim ht As GridHitTestInfo
        Set ht = wndGridControl.HitTest(x / Screen.TwipsPerPixelX, y / Screen.TwipsPerPixelY)
        Dim Index As Long
        Index = wndGridControl.Records.Count
        If (Not ht.Row Is Nothing) Then
            If (Not ht.Row.Record Is Nothing) Then
                Index = ht.Row.Record.Index
                Dim RowLeft As Long, RowTop As Long, RowRight As Long, RowBottom As Long
                ht.Row.GetRect RowLeft, RowTop, RowRight, RowBottom
                If (RowTop + RowBottom) / 2 < y / Screen.TwipsPerPixelY Then Index = Index + 1
            End If
        End If
        Set Record = wndGridControl.Records.Insert(Index)
        Record.AddItem Text
        wndGridControl.Populate
    ElseIf Data.GetFormat(vbCFFiles) Then
        For Each File In Data.Files
            Set Record = wndGridControl.Records.Add
            Record.AddItem File
        Next
        wndGridControl.Populate
    Else
        Effect = vbDropEffectNone
    End If
End Sub

Private Sub wndGridControl_OLEDragOver(ByVal Data As XtremeGridControl.DataObject, Effect As Long, ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single, ByVal state As Integer)
    If (Data.GetFormat(vbCFText)) Then
        Effect = vbDropEffectCopy
    ElseIf Data.GetFormat(vbCFFiles) Then
        Effect = vbDropEffectCopy
    Else
        Effect = vbDropEffectNone
    End If
End Sub

Drop File Names from Windows Explorer Using GridControl_OLEDragDrop (Visual Basic)

This sample illustrates how to drag and drop file names from a Windows Explorer window into the Grid using the GridControl_OLEDragDrop event.

'Credits: to Karl E. Peterson (http://www.mvps.org/vb) for the FileInfo classes used.
'Credits: to Peter59 in Codejock Forums for the base sample we modified

Option Explicit

Private Const Modulname = "frmMain"
Dim xX As Integer, yY As Integer
Dim bAbove As Boolean

Private Sub Form_Load()
    InitGridControl
End Sub 'Form_Load()

Private Sub Form_Resize()
    wndGridControl.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
End Sub 'Form_Resize()

Private Sub InitGridControl()
    With wndGridControl
        .PaintManager.ColumnStyle = xtpColumnResource
        .PaintManager.NoItemsText = "Drop files here..."
        .OLEDropMode = xtpOLEDropManual
        .EnableDragDrop "AUselessString", xtpGridAllowDrop
    End With

    With wndGridControl.Columns
        .Add 0, "FileNo", 30, True
        .Add 1, "Fullname", 150, True
        .Add 2, "Path", 150, True
        .Add 3, "Name", 150, True
    End With

    bAbove = True
    wndGridControl.SortedDragDrop = True
End Sub 'InitGridControl()

Private Sub wndGridControl_MouseMove(Button As Integer, Shift As Integer, x As Long, y As Long)
    xX = x
    yY = y
End Sub

Private Sub wndGridControl_OLEDragDrop(ByVal Data As XtremeGridControl.DataObject, Effect As Long, ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    Debug.Print "wndGridControl_OLEDragDrop..."
    If Data.GetFormat(vbCFFiles) Then
        Dim DroppedFiles As XtremeGridControl.DataObjectFiles
        Dim rptRec As XtremeGridControl.GridRecord
        Dim rptRowDrop As XtremeGridControl.GridRow
        Dim i As Integer, offset As Integer

        offset = 0
        Set rptRowDrop = Nothing

        If Not wndGridControl.HitTest(xX, yY).Row Is Nothing Then
            Set rptRowDrop = wndGridControl.HitTest(xX, yY).Row
            bAbove = False
        Else
            Select Case wndGridControl.HitTest(xX, yY).ht
                Case xtpHitTestGridArea:
                    bAbove = False
                Case xtpHitTestGroupBox, xtpHitTestHeader:
                    bAbove = True
                Case Default:
                    bAbove = False
            End Select
        End If

        Set DroppedFiles = Data.Files
        If (DroppedFiles Is Nothing) Then Exit Sub

        If Not rptRowDrop Is Nothing Then
            offset = rptRowDrop.Record.Index
        End If

        wndGridControl.SelectedRows.DeleteAll
        For i = 0 To DroppedFiles.Count - 1
            '-- add a new GridRecord to the collection of records
            Set rptRec = New GridRecord
            With rptRec
                .AddItem i + 1 + offset
                .AddItem DroppedFiles(i + 1)
                .AddItem GetPathPart(DroppedFiles(i + 1))
                .AddItem GetNamePart(DroppedFiles(i + 1))
            End With

            If wndGridControl.Records.Count = 0 Or bAbove = True Then
                wndGridControl.Records.InsertAt 0, rptRec
            ElseIf bAbove = False Then
                If rptRowDrop Is Nothing Then
                    wndGridControl.Records.InsertAt wndGridControl.Records.Count, rptRec
                Else
                    If wndGridControl.OLEDropAbove Then
                        wndGridControl.Records.InsertAt (offset), rptRec
                    Else
                        wndGridControl.Records.InsertAt (offset + 1), rptRec
                    End If
                End If
            End If
        Next i

        wndGridControl.Populate
    End If
End Sub 'wndGridControl_OLEDragDrop()

Private Sub wndGridControl_OLEDragOver(ByVal Data As XtremeGridControl.DataObject, Effect As Long, ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single, ByVal state As Integer)
End Sub 'wndGridControl_OLEDragOver()

Public Function GetNamePart(sFile As String) As String
    Dim iPos As Long
    On Error Goto Err_GetNamePart
    '-- search last backslash  
    iPos = InStrRev(sFile, "\", -1, vbBinaryCompare)
    If iPos > 0 Then
        GetNamePart = Mid$(sFile, iPos + 1)
    Else
        GetNamePart = sFile
    End If

Exit_GetNamePart:
    Exit Function

Err_GetNamePart:
    MsgBox "Error: " & Err.Number & ". " & Err.Description, , Modulname & "_GetNamePart"
    Resume Exit_GetNamePart
End Function 'GetNamePart()

Public Function GetPathPart(sFile As String) As String
    Dim iPos As Long
    On Error Goto Err_GetPathPart
    '-- search last backslash  
    iPos = InStrRev(sFile, "\", -1, vbBinaryCompare)
    If iPos > 0 Then
        GetPathPart = Left$(sFile, iPos)
    Else
        GetPathPart = sFile
    End If

Exit_GetPathPart:
    Exit Function

Err_GetPathPart:
    MsgBox "Error: " & Err.Number & ". " & Err.Description, , Modulname & "_GetPathPart"
    Resume Exit_GetPathPart
End Function 'GetPathPart()