mappingformcode.bas

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

Attribute VB_Name = "MappingFormCode"
' 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
Private mOutputLinks As COutputLinks
Private mOutputTree As TreeView
Private mInputTree As TreeView
Private mSchema As New COutputSchema
Private mImport As CImport

Public Sub miSetTreeReference(Import As CImport, InputTree As TreeView, OutputTree As TreeView)
    Set mImport = Nothing
    Set mOutputTree = Nothing
    Set mInputTree = Nothing
    Set mImport = Import
    Set mInputTree = InputTree
    Set mOutputTree = OutputTree
End Sub

Public Sub miSetSchemaReference(schema As COutputSchema)
    Set mSchema = Nothing
    Set mSchema = schema
End Sub

Public Sub miSetLinksReference(links As COutputLinks)
    Set mOutputLinks = Nothing
    Set mOutputLinks = links
End Sub

Public Sub miLoadForm()
    
    Dim arc As New CArchive
    arc.fileName = mOutputLinks.SchemaFileLastKnownLocation
    Do While Not arc.OpenFile()
        arc.fileName = mOutputLinks.LocateSchemaFile
        If arc.fileName = "" Then Exit Sub
    Loop
    
    mSchema.Load arc
    miFillDataInputTree
    miFillDataOutputTree mSchema
    
End Sub

Public Function miFillDataOutputTree()
    On Error GoTo eHandler
    
    Dim newItem As node
    Dim ot As COutputTargetTable
    Dim Picture As String

    ' Delete any existing items from the tree.
    mOutputTree.Nodes.Clear

    ' Add the root object to the tree.
    miAddTreeItem mOutputTree, "", mSchema.GetID, mSchema.name, etiType.tiimport, "Output"

    ' Add each target to the tree.
    For Each ot In mSchema.GetOutputTables
        
        ' If there is a link to this item, use the colored in picture.
        If mOutputLinks.GetLinkTo(ot.name) Is Nothing Then
            Picture = "CheckPointBlank"
        Else
            Picture = "CheckPoint"
        End If
        
        miAddTreeItem mOutputTree, mSchema.GetID, ot.GetID, ot.name, _
                        etiType.ticheckpoint, Picture
        
        ' Add all the field items for this table.
        miLoadOutputTreeBranch mOutputTree, ot

    Next ot
    
    Exit Function
    
eHandler:
    LogError "MappingFormCode", "miFillDataOutputTree", Error(Err), False
    
End Function

Public Function miLoadOutputTreeBranch(tree As TreeView, targ As COutputTargetTable)
    Dim of As COutputTargetField
    Dim Picture As String
    
    ' Add each target to the tree.
    For Each of In targ.GetFields
        ' If there is a link to this item, use the colored in picture.
        If mOutputLinks.GetLinkTo(targ.name, of.name) Is Nothing Then
            Picture = "DataItemBlank"
        Else
            Picture = "DataItem"
        End If

        miAddTreeItem tree, targ.GetID, of.GetID, of.name, _
                        etiType.tidataitem, Picture
    Next of
End Function

Public Function miFillDataInputTree()
    On Error GoTo eHandler
    
    Dim newItem As node
    Dim cp As CInputRecord
    Dim Picture As String
    
    ' Delete any existing items from the tree.
    mInputTree.Nodes.Clear

    ' Add the root object to the tree.
    miAddTreeItem mInputTree, "", mImport.GetID, mImport.name, etiType.tiimport, "Input"

    ' Add each target to the tree.
    For Each cp In mImport.GetCheckPoints
        ' If there is a link to this item, use the colored in picture.
        If mOutputLinks Is Nothing Then
            Picture = "CheckPointBlank"
        ElseIf mOutputLinks.GetLinkFrom(cp.name) Is Nothing Then
            Picture = "CheckPointBlank"
        Else
            Picture = "CheckPoint"
        End If

        miAddTreeItem mInputTree, mImport.GetID, cp.GetID, cp.name, _
                        etiType.ticheckpoint, Picture
        
        ' Add all the field items for this table.
        miLoadInputTreeBranch mInputTree, cp

    Next cp
    
    Exit Function
    
eHandler:
    LogError "MappingFormCode", "miFillDataInputTree", Error(Err), False
'
End Function

Public Function miLoadInputTreeBranch(tree As TreeView, cp As CInputRecord)
    Dim di As CInputField
    Dim Picture As String
    
    ' Add each target to the tree.
    For Each di In cp.GetDataPoints
        ' If there is a link to this item, use the colored in picture.
        If mOutputLinks Is Nothing Then
            Picture = "DataItemBlank"
        ElseIf mOutputLinks.GetLinkFrom(cp.name, di.name) Is Nothing Then
            Picture = "DataItemBlank"
        Else
            Picture = "DataItem"
        End If
        
        miAddTreeItem tree, cp.GetID, di.GetID, di.name, _
                        etiType.tidataitem, Picture
    Next di
End Function

Public Sub miAddTreeItem(tree As TreeView, ParentKey As String, key As Variant, _
                        DisplayText As String, _
                        tag As Variant, ImageTag As String)
    On Error GoTo eHandler
    Dim newItem As ComctlLib.node
    
    If ParentKey = "" Then
        ' Add a root item.
        Set newItem = tree.Nodes.Add(, , key, DisplayText)
    Else
        ' Add a sub item.
        Set newItem = tree.Nodes.Add(ParentKey, _
            tvwChild, key, DisplayText)
    End If
    
    newItem.Image = ImageTag
    newItem.tag = tag
        
    Set newItem = Nothing
    Exit Sub
eHandler:
    LogError "MappingFormCode", "miAddTreeItem", Error(Err), False
'
End Sub

Public Sub miHighlightOutputLink(InputTable As String, InputField As String)
    On Error GoTo eHandler
    
    ' Let the user know the current link information
    ' for the selected item.
    Dim ol As COutputLink
    Dim ot As COutputTargetTable
    Dim of As COutputTargetField
    
    If mOutputLinks Is Nothing Then Exit Sub
    
    ' Get the link.
    Set ol = mOutputLinks.GetLinkFrom(InputTable, InputField)
    If ol Is Nothing Then Exit Sub
    
    ' Get the schema target object.
    Set ot = mSchema.GetOutputTables.ItemByName(ol.LinkToTable)
    If ot Is Nothing Then Exit Sub
    
    ' Get the target field.
    Set of = ot.GetFields.ItemByName(ol.LinkToField)
    If of Is Nothing Then Exit Sub

    ' If the item exists in the tree, select it.
    If mOutputTree.Nodes(of.GetID) Is Nothing Then Exit Sub
    Set mOutputTree.SelectedItem = mOutputTree.Nodes(of.GetID)

    ' Update the display with this links status.
    ' Let the user know what the selected item is linked to.
    fMainForm.sbStatusBar.Panels(1).Text = ol.LinkFromTable & "," & ol.LinkFromField + " -> " + ol.LinkToTable + "," + ol.LinkToField
    
    Exit Sub
eHandler:
    ' Element not found in treeview.nodes
    If Err = 35601 Then Exit Sub
    LogError "MappingFormCode", "miHighlightOutputLink", Error(Err), False
End Sub
' ToOrFrom=1 table, field represent InputTree items.
' ToOrFrom=2 they represent OutputTree items.
Public Sub miFillLinkBox(Table As String, Field As String, lst As ListView, ToOrFrom As Integer)
    
    On Error GoTo eHandler
    Dim ol As COutputLink
    
    If mOutputLinks Is Nothing Then Exit Sub
    lst.ListItems.Clear