SftTree/OCX 7.5 - ActiveX Tree Control

DragDrop Sample (VB6)

This sample illustrates drag & drop.

The source code is located at C:\Program Files (x86)\Softelvdm\SftTree OCX 7.5\Samples\VB6\DragDrop\Form1.frm or C:\Program Files\Softelvdm\SftTree OCX 7.5\Samples\VB6\DragDrop\Form1.frm (on 32-bit Windows versions).

Private Sub Command1_Click()
    End
End Sub

Private Sub Form_Load()
    Dim i As Integer
    With SftTree1
        .Items.Add "Item 0"
         i = .Items.Add("Item 1")
         .Item(i).Level = 1
        i = .Items.Add("Item 2")
         .Item(i).Level = 2
        i = .Items.Add("Item 3")
         .Item(i).Level = 1
    End With
End Sub

Private Sub DropTarget_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
    If Data.GetFormat(vbCFText) Then
        DropTarget.Caption = Data.GetData(vbCFText)
    End If
    If Data.GetFormat(vbCFDIB) Then
        Set DropTargetPic.Picture = Data.GetData(vbCFDIB)
    End If
End Sub


Private Sub SftTree1_OLEStartDrag(Data As SftTreeLib75.DataObject, AllowedEffects As Long)
    Dim curr As Integer
    curr = SftTree1.Items.Current
    ' cell text
    Data.SetData SftTree1.Cell(curr, 0).Text, vbCFText
    ' item picture
    If SftTree1.Item(curr).Image.Type = sftTypeIDispatch Then
        Data.SetData SftTree1.Item(curr).Image.Picture, vbCFDIB
    Else
        If SftTree1.Item(curr).Expanded Then
            Data.SetData SftTree1.Items.ItemImageExpanded.Picture, vbCFDIB
        ElseIf SftTree1.Item(curr).DependentAllCount > 0 Then
            Data.SetData SftTree1.Items.ItemImageExpandable.Picture, vbCFDIB
        Else
            Data.SetData SftTree1.Items.ItemImageLeaf.Picture, vbCFDIB
        End If
    End If
End Sub

Private Sub SftTree1_OLEDragDrop(Data As SftTreeLib75.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim insertAt As Integer
    Dim str As String
    Dim lvl As Integer, newItem As Integer
    Dim horzExtent As Single, col0Width As Single

    ' get horizontal extent and width of column 0
    horzExtent = SftTree1.Items.HorizontalExtent
    col0Width = SftTree1.Column(0).Width

    insertAt = SftTree1.Items.DropHighlight
    If insertAt < 0 Then Exit Sub

    If Data.GetFormat(vbCFText) Then
        lvl = SftTree1.Item(insertAt).Level
        str = Data.GetData(vbCFText)
        newItem = SftTree1.Items.Insert(insertAt + 1, str)
        SftTree1.Item(newItem).Level = lvl + 1
    ElseIf Data.GetFormat(vbCFDIB) Then
        Set SftTree1.Cell(insertAt, 0).Image.Picture = Data.GetData(vbCFDIB)
        SftTree1.Cell(insertAt, 0).ImageHAlign = halignSftTreeRight
    ElseIf Data.GetFormat(vbCFFiles) Then
        SftTree1.BulkUpdate = True
        lvl = SftTree1.Item(insertAt).Level
        newItem = insertAt + 1
        For i = Data.Files.Count To 1 Step -1
            newItem = SftTree1.Items.Insert(newItem, Data.Files.Item(i))
            SftTree1.Item(newItem).Level = lvl + 1
        Next
        SftTree1.BulkUpdate = False
    End If

    ' make horizontal extent and width of column 0 wider than previous
    ' setting, but never smaller
    SftTree1.ColumnsObj.MakeOptimal
    SftTree1.Items.RecalcHorizontalExtent

    If horzExtent > SftTree1.Items.HorizontalExtent Then
        SftTree1.Items.HorizontalExtent = horzExtent
    End If
    If col0Width > SftTree1.Column(0).Width Then
        SftTree1.Column(0).Width = col0Width
    End If
End Sub