maintreecode.bas

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

Attribute VB_Name = "MainTreeCode"
' DataMonkey Data Conversion Application. Written by Theodore L. Ward
' Copyright (C) 2002 AstroComma Incorporated.
'
' This program is free software; you can redistribute it and/or
' modify it under the terms of the GNU General Public License
' as published by the Free Software Foundation; either version 2
' of the License, or (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.
'
' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
' The author may be contacted at:
' [e-mail] or [e-mail]

Option Explicit

'*********************************************************
' Used to allow communication between forms, mod's, etc...
'*********************************************************

Global GCurrentTreeNode As ComctlLib.node

Enum etiType
    
    tiimport
    ticheckpoint
    tioutputlinks
    tioutputobject
    tidataitem
    
    tiImportAction
    tiCheckpointAction
    tiDataItemAction
    
    tiInputFolder
    tiOutputFolder
    tiLinesFolder
    tiFieldsFolder
    
    tiLASTITEM
End Enum

Dim mClipBoardObject As Object
Dim mClipBoardObjectType As etiType

Public Sub tiSetCutCopyPasteItem(obj As Object, objtype As etiType)
    Set mClipBoardObject = Nothing
    Set mClipBoardObject = obj
    mClipBoardObjectType = objtype
End Sub

Public Sub tiGetCutCopyPasteItem(obj As Object, objtype As etiType)
    Set obj = mClipBoardObject
    objtype = mClipBoardObjectType
End Sub

Public Sub tiEnableCutCopyPaste(EnableCut As Boolean, _
                EnableCopy As Boolean, Optional EnablePaste)

    Dim tEnablePaste As Boolean
    
    ' If they didn't supply a value for EnablePaste, we will
    ' determine that ourselves.
    If IsMissing(EnablePaste) Then
        If mClipBoardObject Is Nothing Then
            tEnablePaste = False
        Else
            ' Check to see if pasting this object to the
            ' selected object makes sense or not.
            tEnablePaste = tiCanPaste(mClipBoardObjectType, _
                                    mClipBoardObject, _
                                    tiGetSelectedItemType(), _
                                    tiGetTreeItem())
        End If
    Else
        tEnablePaste = EnablePaste
    End If
    
    fMainForm.mnuTreeCut.Enabled = EnableCut
    fMainForm.mnuEditCut.Enabled = EnableCut
    fMainForm.tbToolBar.Buttons("Cut").Enabled = EnableCut
    
    fMainForm.mnuTreeCopy.Enabled = EnableCopy
    fMainForm.mnuEditCopy.Enabled = EnableCopy
    fMainForm.tbToolBar.Buttons("Copy").Enabled = EnableCopy
    
    fMainForm.mnuTreePaste.Enabled = tEnablePaste
    fMainForm.mnuEditPaste.Enabled = tEnablePaste
    fMainForm.tbToolBar.Buttons("Paste").Enabled = tEnablePaste

End Sub

Public Function tiTagToType(sId As String) As etiType
    
    tiTagToType = -1
    
    On Error GoTo eHandler
    
    Dim id As Integer
    Dim temp As Integer
    
    temp = InStr(sId, "-")
    id = CInt(left$(sId, temp))
    
    If id < etiType.tiLASTITEM And id >= 0 Then
        tiTagToType = id
    End If
    
    Exit Function
    
eHandler:
    LogError "MainTreeCode", "tiTagToType", Error(Err), False
End Function
Public Function tiTagToName(tag As String) As String

    ' The tag is the string from the tree node.tag
    ' property. It is in the format "Type-Name".
    ' and is used to describe the node.
    
    Dim pos As Integer
    
    pos = InStr(tag, "-")
    If pos >= 0 Then
        tiTagToName = right$(tag, Len(tag) - pos)
    Else
        tiTagToName = ""
    End If
    
End Function

'**************************************************
' Create the unique keys for the items in our Tree.
'**************************************************

Public Function tiMakeKey( _
    item As etiType, Optional itemName As String, Optional parentName As String) As String
    
    On Error GoTo eHandler
    
    tiMakeKey = ""
    
    Dim tmp As String

    '****************************
    ' Always start with the type.
    '****************************
    
    tmp = Trim(CStr(item))
    
    ' Add the name of the item if it isn't a folder.
    If Not IsMissing(itemName) Then
        tmp = tmp + "-" + itemName
    End If
    
    ' Add the name of the parent if required
    If Not IsMissing(parentName) Then
        tmp = tmp + "-" + parentName
    End If

    '***************************************************
    ' In case the item doesn't have a name, give it one.
    '***************************************************
    
    Select Case item
        Case etiType.tiInputFolder
            tmp = tmp + "-" + "InputFolder"
        Case etiType.tiOutputFolder
            tmp = tmp + "-" + "OutputFolder"
        Case etiType.tiLinesFolder
            tmp = tmp + "-" + "CheckPointFolder"
        Case etiType.tiFieldsFolder
            tmp = tmp + "-" + "DataItemFolder"
    End Select
    
    tiMakeKey = tmp
    Exit Function
eHandler:
    LogError "MainTreeCode", "tiMakeKey", Error(Err), False
End Function
Public Function tiMakeTag(item As etiType, _
                    Optional ByVal itemName As String) As String

    Static index As Integer

    ' If a name isn't important, just create something random.
    If IsMissing(itemName) Then
        index = index + 1
        itemName = CStr(index) + "&&&&"
    End If
    
    ' Make the tag.
    
    tiMakeTag = Trim(CStr(item)) + "-" + itemName
    
End Function

' If ToPasteType is a command of some sort, CmdApplications may be provided
' to specify the types of objects for which the command is available.
Public Function tiCanPaste(ToPasteType As etiType, ToPaste As Object, _
                            PasteToType As etiType, PasteTo As Object) As Boolean
    tiCanPaste = False
    
    Dim CmdApplications As eCmdApplications
    
    ' Check to see if pasting this object to the
    ' selected object makes sense or not.
    If ToPasteType = tiCheckpointAction Or _
        ToPasteType = tiDataItemAction Or _
        ToPasteType = tiImportAction Then

        CmdApplications = ToPaste.GetApplications()
    End If

    Select Case PasteToType
        Case etiType.ticheckpoint
            ' Can Paste CheckPoint actions.
            If CmdApplications And eCmdApplications.appCheckPoint Then
                tiCanPaste = True
            End If
            
        Case etiType.tidataitem
            ' Can Paste Data Item actions.
            If CmdApplications And eCmdApplications.appDataItem Then
                tiCanPaste = True
            End If
        
        Case etiType.tiInputFolder
            ' Can Paste Import actions.
            If CmdApplications And eCmdApplications.appIMPORT Then
                tiCanPaste = True
            End If

        Case etiType.tiLinesFolder
            ' Can Paste CheckPoint Items.
            If ToPasteType = ticheckpoint Then
                tiCanPaste = True
            End If
        
        Case etiType.tiFieldsFolder
            ' Can Paste DataItems.
            If ToPasteType = tidataitem Then
                tiCanPaste = True
            End If

        Case etiType.tiOutputFolder
            ' Can Paste OutputLinks.
            If ToPasteType = tioutputlinks Then
                tiCanPaste = True
            End If
    End Select
    
End Function

Public Sub tiSetMenuStatus(Optional ForTreeItemType)
    
    Dim tiType As etiType
    If IsMissing(ForTreeItemType) Then
        tiType = frmDocument.TreeView1.SelectedItem.tag
    Else
        tiType = ForTreeItemType
    End If
    
    ' Set everything to default: Invisible or Disabled.
    fMainForm.mnuTreeAddCheckPoint.Visible = False
    fMainForm.mnuTreeAddDataItem.Visible = False
    fMainForm.mnuTreeAddAction.Visible = False
    fMainForm.mnuTreeAddOutputDefinition.Visible = False
    fMainForm.mnuTreeEditOutputSchema.Visible = False
    fMainForm.mnuTreeEditRelationships.Visible = False
    
    fMainForm.mnuTreeDelete.Enabled = False
    fMainForm.mnuTreeProperties.Enabled = False
    
    '****************************************************
    ' Figure out at what level in our tree the button was
    ' clicked by counting parent nodes back to the root.
    '****************************************************
    
    Select Case tiType

        Case etiType.tiimport
            fMainForm.mnuTreeProperties.Enabled = True
            tiEnableCutCopyPaste False, False, False

        Case etiType.tiLinesFolder
            fMainForm.mnuTreeAddCheckPoint.Visible = True
            tiEnableCutCopyPaste False, False
            
        Case etiType.tiFieldsFolder
            fMainForm.mnuTreeAddDataItem.Visible = True
            tiEnableCutCopyPaste False, False

        Case etiType.tiOutputFolder
            fMainForm.mnuTreeAddOutputDefinition.Visible = True
            tiEnableCutCopyPaste False, False

        Case etiType.tiCheckpointAction, _
            etiType.tiDataItemAction, _
            etiType.tiImportAction

            fMainForm.mnuTreeDelete.Enabled = True
            fMainForm.mnuTreeProperties.Enabled = True
            tiEnableCutCopyPaste True, True, False

        Case etiType.tiInputFolder
            fMainForm.mnuTreeAddAction.Visible = True
            tiEnableCutCopyPaste False, False

        Case etiType.ticheckpoint, etiType.tidataitem
            fMainForm.mnuTreeDelete.Enabled = True
            fMainForm.mnuTreeAddAction.Visible = True
            tiEnableCutCopyPaste True, True
        
        Case etiType.tioutputlinks
            fMainForm.mnuTreeDelete.Enabled = True
            fMainForm.mnuTreeEditRelationships.Visible = True
            fMainForm.mnuTreeProperties.Enabled = True
            tiEnableCutCopyPaste True, True, False

        Case etiType.tioutputobject
            fMainForm.mnuTreeDelete.Enabled = False
            fMainForm.mnuTreeEditOutputSchema.Visible = True
            tiEnableCutCopyPaste False, False, False
    End Select

End Sub

Public Function tiGetSelectedItemType() As etiType

    tiGetSelectedItemType = -1
    On Error GoTo eHandler
    
    tiGetSelectedItemType = CInt(frmDocument.TreeView1.SelectedItem.tag)
    Exit Function

eHandler:
    LogError "MainTreeCode", "tiGetSelectedItemType", Error(Err), False
    '
End Function

Public Function tiGetTreeItem(Optional ItemKey As String = "") As Object
    On Error GoTo eHandler

    Dim act As Object
    Dim cp As CInputRecord
    Dim di As CInputField
    Dim siKey As String
    Dim ItemType As etiType
    
    With frmDocument.TreeView1
    If ItemKey = "" Then
        siKey = .SelectedItem.key
    Else
        siKey = ItemKey
    End If
    
    ' Get the type of the indicated item.
    ItemType = .Nodes(siKey).tag
    
    Select Case ItemType

        Case etiType.tiimport
            Set tiGetTreeItem = GImport
            
        Case etiType.ticheckpoint
            ' Get the checkpoint we are working with.
            Set tiGetTreeItem = GImport.GetCheckPoints(siKey)
        
        Case etiType.tidataitem
            ' Get the checkpoint and dataitem we are working with.
            Set cp = GImport.GetCheckPoint(.Nodes(siKey).parent.parent.key)
            Set tiGetTreeItem = cp.GetDataPoints(siKey)

        Case etiType.tiImportAction
            Set tiGetTreeItem = GImport.GetActions(siKey)
            
        Case etiType.tiCheckpointAction
            ' Get the checkpoint we are working with.
            Set cp = GImport.GetCheckPoint(.Nodes(siKey).parent.key)
            Set tiGetTreeItem = cp.GetActions(siKey)

        Case etiType.tiDataItemAction
            ' Get the checkpoint and dataitem we are working with.
            Set cp = GImport.GetCheckPoint(.Nodes(siKey).parent.parent.parent.key)
            Set di = cp.GetDataPoint(.Nodes(siKey).parent.key)