maintreecode.bas

Data monkey是一个强大的是数据传输和转换应用程序。使用DataMonkey用户可以把复杂的文本文件格式

    Set act = Nothing
    Set cp = Nothing
    Set di = Nothing
    
    Exit Sub
eHandler:
    LogError "MainTreeCode", "AddNewAction", Error(Err)
Resume
End Sub

Public Sub tiAddOutputDefinition()
    On Error GoTo eHandler
    Dim i As Integer
    Dim fileName As String
    Dim SourceName As String
    Dim ol As COutputLinks
    
    ' Load the form which will add the new output definition.
    frmSelectOutputSource.Show vbModal
    i = frmSelectOutputSource.GetChosenSource( _
            fileName, SourceName)
    Unload frmSelectOutputSource
    
    ' If we have a new item, add it to the tree.
    If GFormReturnValue = vbOK Then
    
        ' Add a new outputlinks object.
        Set ol = GImport.GetOutputLinksManager.Add(False)
        ol.name = SourceName
        ol.OutputSourceName = SourceName
        ol.SchemaFileLastKnownLocation = fileName
        If ol.Edit() = vbCancel Then
            GImport.GetOutputLinksManager.Remove ol.GetID
            GoTo done
        End If
        
        ' Add the new item to the main tree.
        AddTreeItem frmDocument.TreeView1.SelectedItem.key, _
                    ol.GetID, ol.name, _
                    etiType.tioutputlinks, "Output"
        
        ' Add schema as sub item.
        AddTreeItem ol.GetID, GetUniqueID, ol.OutputSourceName, _
                        tioutputobject, "OutputSchema"
        
        GImport.dirty = True

    End If

done:
    Exit Sub
eHandler:
    LogError "MainTreeCode", "tiAddOutputDefinition", Error(Err), False
End Sub

' Delete the selected tree item.
Public Sub tiDelete()
    On Error GoTo eHandler

    Dim act As Object
    Dim cp As CInputRecord
    Dim di As CInputField

    With frmDocument.TreeView1
    If .SelectedItem Is Nothing Then Exit Sub
    
    Select Case tiGetSelectedItemType()

        Case etiType.ticheckpoint
            
            ' Get the checkpoint we are working with.
            GImport.GetCheckPoints.Remove .SelectedItem.key
        
        Case etiType.tidataitem
            ' Get the checkpoint and dataitem we are working with.
            Set cp = GImport.GetCheckPoint(.SelectedItem.parent.parent.key)
            cp.GetDataPoints.Remove .SelectedItem.key
            
        Case etiType.tiImportAction
            GImport.GetActions.Remove .SelectedItem.key
            GImport.GetActions.Reorder
            
        Case etiType.tiCheckpointAction
            ' Get the checkpoint we are working with.
            Set cp = GImport.GetCheckPoint(.SelectedItem.parent.key)
            cp.GetActions.Remove .SelectedItem.key
            cp.GetActions.Reorder

        Case etiType.tiDataItemAction
            ' Get the checkpoint and dataitem we are working with.
            Set cp = GImport.GetCheckPoint(.SelectedItem.parent.parent.parent.key)
            Set di = cp.GetDataPoint(.SelectedItem.parent.key)
            di.GetActions.Remove .SelectedItem.key
            di.GetActions.Reorder
            
        Case etiType.tioutputlinks
            GImport.GetOutputLinksManager.Remove .SelectedItem.key
        
        Case Else
            Exit Sub
    End Select
    
    ' Remove the item from our tree.
    frmDocument.TreeView1.Nodes.Remove .SelectedItem.index
    
    ' Removing an item will cause some other item to automatically
    ' be selected, so we need to reset the cut/copy/paste stuff.
    tiSetMenuStatus
    
    GImport.dirty = True
    End With
    
    ' Release all our references.
    Set act = Nothing
    Set cp = Nothing
    Set di = Nothing
    
    Exit Sub
eHandler:
    LogError "MainTreeCode", "tiDelete", Error(Err)
End Sub

Public Sub MoveTreeItem(ByRef ItemToMove As ComctlLib.node, _
                ByRef MoveToItem As ComctlLib.node)

    On Error GoTo eHandler
    
    Dim InsertRelationship As Integer
    Dim temp As ComctlLib.node
    Dim movingUp As Boolean
    Dim MoveToIndex As Integer
    
    ' If the item is not being moved, exit.
    If MoveToItem Is ItemToMove Then Exit Sub
    If MoveToItem Is Nothing Or ItemToMove Is Nothing Then Exit Sub

    movingUp = False
    Set temp = ItemToMove

    ' Figure out if the node being moved is being moved UP or DOWN.
    Do While Not temp Is Nothing
        If temp Is MoveToItem Then
            movingUp = True
            Exit Do
        End If
        Set temp = temp.Previous
    Loop
    
    If MoveToItem.Previous Is Nothing Then
        ' If there is no node before the node we are moving to
        ' this item is going to be first.
        InsertRelationship = tvwFirst
    ElseIf MoveToItem.Next Is Nothing Then
        ' If there no node after the node we are moving to,
        ' this item is going to be last.
        InsertRelationship = tvwLast
    ElseIf movingUp Then
        ' If the item is moving UP in the list, we want to make
        ' the node the previous node of the item being dropped on.
        InsertRelationship = tvwPrevious
    Else
        ' If the item is moving DOWN in the list, we want to move
        ' the node the next node of the item being dropped on.
        InsertRelationship = tvwNext
    End If
    
    ' Figure the type of item we are moving.
    Select Case ItemToMove.tag
        Case etiType.ticheckpoint
        
            ' Moving a Checkpoint.
            Dim cpToMove As CInputRecord, cpMoveTo As CInputRecord
            
            ' Get the Checkpoint we are moving.
            Set cpToMove = GImport.GetCheckPoint(ItemToMove.key)
            
            ' Get the Checkpoint we are displacing.
            Set cpMoveTo = GImport.GetCheckPoint(MoveToItem.key)

            ' Remove the checkpoint being moved.
            GImport.GetCheckPoints.Remove cpToMove.GetID
            
            ' Store this before reordering, as reorder will
            ' change this value.
            MoveToIndex = cpMoveTo.index
            
            ' Reorder the checkpoints so everything is kosher.
            GImport.GetCheckPoints.Reorder
            
            ' Reinsert the checkpoint being moved in the correct
            ' position.
            GImport.GetCheckPoints.InsertCheckpointObject _
                                cpToMove, MoveToIndex

            Set cpMoveTo = Nothing: Set cpToMove = Nothing

        Case etiType.tidataitem
            ' Moving a Checkpoint.
            Dim cp As CInputRecord
            Dim diMoveTo As CInputField, diToMove As CInputField
            
            ' Get the Checkpoint.
            Set cp = GImport.GetCheckPoint(ItemToMove.parent.parent.key)
            
            ' Get the DataItem we are moving.
            Set diToMove = cp.GetDataPoint(ItemToMove.key)
            ' Get the DataItem we are displacing.
            Set diMoveTo = cp.GetDataPoint(MoveToItem.key)

            ' Remove the checkpoint being moved.
            cp.GetDataPoints.Remove diToMove.GetID

            ' Store this before reordering, as reorder will
            ' change this value.
            MoveToIndex = diMoveTo.index
            
            ' Reorder the checkpoints so everything is kosher.
            cp.GetDataPoints.Reorder
            
            ' Reinsert the checkpoint being moved in the correct
            ' position.
            cp.GetDataPoints.InsertDataItemObject diToMove, MoveToIndex

            Set cp = Nothing: Set diMoveTo = Nothing: Set diToMove = Nothing
        
        Case etiType.tiCheckpointAction, etiType.tiDataItemAction, _
            etiType.tiImportAction

            Dim obj As Object
            Dim actMoveTo As Object, actToMove As Object

            ' Get the owner of the actions.
            If ItemToMove.tag = etiType.tiImportAction Then
                Set obj = tiGetTreeItem(ItemToMove.parent.parent.key)
            Else
                Set obj = tiGetTreeItem(ItemToMove.parent.key)
            End If
            If obj Is Nothing Then Exit Sub
            
            ' Get the action we are moving.
            Set actToMove = obj.GetAction(ItemToMove.key)
            
            ' Get the action we are displacing.
            Set actMoveTo = obj.GetAction(MoveToItem.key)
            If actToMove Is Nothing Or actMoveTo Is Nothing Then Exit Sub

            ' Remove the checkpoint being moved.
            obj.GetActions.Remove actToMove.GetID
            
            ' Store this before reordering, as reorder will
            ' change this value.
            MoveToIndex = actMoveTo.index
            
            ' Reorder the checkpoints so everything is kosher.
            obj.GetActions.Reorder
            
            ' Reinsert the checkpoint being moved in the correct
            ' position.
            obj.GetActions.InsertActionObject _
                                actToMove, MoveToIndex

            Set actMoveTo = Nothing: Set actToMove = Nothing: Set obj = Nothing

        Case Else
            Exit Sub
    End Select

    '*********************
    ' Move the tree items.
    '*********************
    
    ' Store the ID's for later.
    Dim ToMoveKey As String, MoveToKey As String
    ToMoveKey = ItemToMove.key
    MoveToKey = MoveToItem.key

    ' Change the key on the item we are going to move.
    ItemToMove.key = "TEMPKEYTODESTROYLATER1"

    ' Insert a new item using the key for the item being moved.
    Set temp = frmDocument.TreeView1.Nodes.Add(MoveToKey, _
        InsertRelationship, ToMoveKey, ItemToMove.Text, ItemToMove.Image)
    temp.tag = ItemToMove.tag

    ' Change the parent of all the children of the item being moved
    ' to be the newly inserted item.
    While Not ItemToMove.Child Is Nothing
        Set temp = ItemToMove.Child.LastSibling
        Set temp.parent = frmDocument.TreeView1.Nodes(ToMoveKey)
    Wend

    ' Delete the original item that was to be moved.
    frmDocument.TreeView1.Nodes.Remove ItemToMove.key
    
    ' Set the changed flag for the import.
    GImport.dirty = True
    Exit Sub
    
eHandler:
    LogError "MainTreeCode", "MoveTreeItem", Error(Err), False
    
End Sub

' Add a new item to the tree.
Public Function tiPutItem(obj As Object, objtype As etiType)
    On Error GoTo eHandler
    
    Dim ParentItem As Object
    Dim ParentType As etiType
    
    If obj Is Nothing Then
        
        Exit Function
    End If
    
    ' Get the selected item which will be the parent of the item
    ' we paste into it.
    Set ParentItem = tiGetTreeItem()
    ParentType = tiGetSelectedItemType()
    
    ' Add this item to our import structure.
    Select Case objtype
        Case etiType.tiimport
        Case etiType.ticheckpoint
            If ParentType = tiLinesFolder Then
                GImport.GetCheckPoints.Add obj
            Else
                Exit Function
            End If
        Case etiType.tidataitem
            If ParentType = tiFieldsFolder Then
                Set ParentItem = tiGetTreeItem()
                Set ParentItem = tiGetTreeItem(ParentItem.parent.key)
                ParentItem.GetDataPoints.Add obj
            Else
                Exit Function
            End If
        Case etiType.tiDataItemAction, etiType.tiCheckpointAction, _
                etiType.tiImportAction

            If ParentType = ticheckpoint Or _
                ParentType = tidataitem Then
                                
                ' Get the parent of the folder item.
                Dim key As String
                key = frmDocument.TreeView1.SelectedItem.key
                
                ' Add a new action to the parent of the action folder.
                tiGetTreeItem(key).GetActions.AddObject obj
                
            ElseIf ParentType = tiInputFolder Then
                ' Add a new action to the parent of the action folder.
                GImport.GetActions.AddObject obj
            Else
                Exit Function
            End If

            ' Select the correct new type for this action.
            Select Case ParentType
                Case etiType.tidataitem
                    objtype = tiDataItemAction
                Case etiType.ticheckpoint
                    objtype = tiCheckpointAction
                Case etiType.tiInputFolder
                    objtype = tiImportAction
            End Select

        Case etiType.tioutputlinks
            If ParentType = tiOutputFolder Then
                GImport.GetOutputLinksManager.AddObject obj
            Else
                Exit Function
            End If
        
    End Select
    
    Dim ParentKey As String
    ParentKey = frmDocument.TreeView1.SelectedItem.key

    ' Add this item and any applicable subitems to the output tree.
    AutoAddTreeItem ParentKey, obj, objtype
    
    Exit Function
eHandler:
    LogError "MainTreeCode", "tiPutItem", Error(Err), False
    

End Function