frmmain.frm

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

      Begin VB.Menu mnuHelpSearch 
         Caption         =   "1032"
      End
      Begin VB.Menu mnuHelpBar1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuHelpAbout 
         Caption         =   "1033"
      End
   End
   Begin VB.Menu mnuMainTreePopup 
      Caption         =   "mnuMainTreePopup"
      Visible         =   0   'False
      Begin VB.Menu mnuTreeDelete 
         Caption         =   "Delete"
      End
      Begin VB.Menu mnuTreeProperties 
         Caption         =   "Properties..."
      End
      Begin VB.Menu mnuTreeCut 
         Caption         =   "Cut"
      End
      Begin VB.Menu mnuTreeCopy 
         Caption         =   "Copy"
      End
      Begin VB.Menu mnuTreePaste 
         Caption         =   "Paste"
      End
      Begin VB.Menu mnuTreeAddCheckPoint 
         Caption         =   "Add CheckPoint"
      End
      Begin VB.Menu mnuTreeAddDataItem 
         Caption         =   "Add DataItem"
      End
      Begin VB.Menu mnuTreeAddAction 
         Caption         =   "Add Action..."
      End
      Begin VB.Menu mnuTreeAddOutputDefinition 
         Caption         =   "Add Output Links..."
      End
      Begin VB.Menu mnuTreeEditRelationships 
         Caption         =   "Edit Relationships..."
      End
      Begin VB.Menu mnuTreeEditOutputSchema 
         Caption         =   "Edit Output Schema..."
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' 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 Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)

Private Sub MDIForm_DragDrop(Source As Control, x As Single, y As Single)

'    If Source Is Toolbar1 Then
'        If x < 100 Then
'            Source.Align = 3
'            Source.Width = 500
'            'Source.Height = ScaleHeight
'        End If
'    End If

End Sub

Private Sub MDIForm_Load()
    
    tiSetCutCopyPasteItem Nothing, -1
    
    LoadResStrings Me
    Me.left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
    Me.top = GetSetting(App.Title, "Settings", "MainTop", 1000)
    Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
    Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
    LoadNewDoc
End Sub

Private Sub ResetDoc()
    FillCheckPointTree
End Sub

Private Sub LoadNewDoc(Optional Import As CImport = Nothing)
    
    ' Make sure the current project is saved if neccessary.
    If Not CanDeleteProject Then Exit Sub

    ' The archive object is what reads and writes the file.
    Archive.fileName = ""

    Set GImport = Nothing
    
    If Import Is Nothing Then
        Set GImport = New CImport
        GImport.name = "New Project"
    Else
        Set GImport = Import
    End If
    
    FillCheckPointTree

Exit Sub
    
    Static lDocumentCount As Long
    Dim frmD As frmDocument

    lDocumentCount = lDocumentCount + 1
    Set frmD = New frmDocument
    frmD.Caption = "Document " & lDocumentCount
    frmD.Show
End Sub

Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim i As Integer
    If GImport.dirty Then
        i = MsgBox("Save changes to project " & GImport.name, vbYesNoCancel Or vbQuestion, "Save Changes?")
        If i = vbYes Then
            Call mnuFileSave_Click
        ElseIf i = vbCancel Then
            Cancel = 1
        End If
    End If
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)
    If Me.WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "MainLeft", Me.left
        SaveSetting App.Title, "Settings", "MainTop", Me.top
        SaveSetting App.Title, "Settings", "MainWidth", Me.Width
        SaveSetting App.Title, "Settings", "MainHeight", Me.Height
    End If
End Sub

Private Sub mnuAddCheckpoints_Click()
    frmCheckPointEntry.Show vbModal
    FillCheckPointTree
End Sub

Private Sub mnuAddOutputSource_Click()
    On Error GoTo eHandler
    
    Dim sch As New COutputSchema

    ' Edit the schema.
    sch.Edit

    ' Load the form which will add the new import definition.
    'frmSelectOutputDefType.Initialize obj
    'frmSelectOutputDefType.Show vbModal

    Exit Sub

eHandler:
    LogError "frmMain", "mnuAddOutputSource", Error(Err), False

End Sub



Private Sub mnuEditOutputSource_Click()
    On Error GoTo eHandler
    
    Dim arc As New CArchive
    Dim schema As New COutputSchema

    On Error GoTo eHandler
    
    arc.InitialBrowseDirectory = GOutputSourceDirectory
    
    ' Locate the schema file.
    If Not arc.BrowseFileOpen("Edit Output Schema", , _
            "Output Schemas (*.sch)|*.sch|All Files (*.*)|*.*") Then
        
        ' If they cancel the dialogue, exit.
        Exit Sub
    End If

    ' Load the output object.
    If schema.Load(arc) Then
        schema.Edit
    End If

done:
    arc.CloseFile

    Exit Sub

eHandler:
    LogError "frmMain", "mnuEditOutputSource", Error(Err), False
    
End Sub


Private Sub mnuFileNewProject_Click()
    DoNewProject
End Sub

Private Function CanDeleteProject() As Boolean
    CanDeleteProject = True

    ' Make sure the current project is saved if neccessary.
    If GImport.dirty Then
        Dim i As Integer
        i = MsgBox("Save changes to project " & GImport.name, vbYesNoCancel Or vbQuestion, "Save Changes?")
        If i = vbYes Then
            Call mnuFileSave_Click
        ElseIf i = vbCancel Then
            CanDeleteProject = False
            Exit Function
        End If
    End If

End Function

Private Sub DoNewProject()
    Dim name As String, fileName As String

    If Not CanDeleteProject Then Exit Sub
    
    frmNewProjectSelection.Show vbModal
    
    Select Case frmNewProjectSelection.GetSelectionType
    
        Case eNewProjectSelectionType.npstWizard
            frmWiz1.Show vbModal
            If GFormReturnValue = vbOK Then
                ResetDoc
            End If
            
        Case eNewProjectSelectionType.npstBlankProject
            LoadNewDoc
            
        Case eNewProjectSelectionType.npstTemplate
            frmNewProjectSelection.GetSelectedTemplateInfo fileName, name
            Load frmWiz1
            frmWiz1.UseTemplate fileName
            frmWiz1.Show vbModal
            If GFormReturnValue = vbOK Then
                ResetDoc
            End If
            
    End Select
    
    Unload frmNewProjectSelection

End Sub

Private Sub mnuFileCreateTemplate_Click()
    
    Dim tpl As New CWizardTemplate
    Set tpl.Import = GImport
    If tpl.EditProperties = vbCancel Then Exit Sub
    
    Dim arc As New CArchive
    arc.InitialBrowseDirectory = GTemplateDirectory
    If arc.BrowseFileSave("Save project file", tpl.name, _
                "Template Files (*.tpl)|*.tpl" & _
                "|All Files (*.*)|*.*") Then
        If Not tpl.Save(arc) Then
            LogError "frmMain", "mnuFileCreateTemplate", "Unable to save template file", False
        End If
        arc.CloseFile
    End If
End Sub

Private Sub mnuFileNew_Click()
    DoNewProject
End Sub

Private Sub mnuImportSchema_Click()
    DoSchemaImport
End Sub

Private Sub mnuRelationshipWindow_Click()
    GImport.GetOutputLinksManager.Edit
    GImport.dirty = True
End Sub

Private Sub mnuRunImport_Click()
    RunImport
End Sub

Private Sub RunImport()
    On Error GoTo eHandler
    Dim ret As Boolean

    ' Import something.
    ret = GImport.Import()
    If GCancelImport Then Exit Sub

    If ret Then
        If GetErrorCount > 0 Then
            MsgBox "The file was successfully imported." & vbCrLf & _
            "There were " & CStr(GetErrorCount) & _
            " error(s), check the logfile '" & GImport.LogFilePath & "'", _
            vbOKOnly Or vbInformation, "Success"
        Else
            MsgBox "The file was successfully imported", vbOKOnly Or vbInformation, "Success"
        End If
    Else
        MsgBox "The file was not succssfully imported." & vbCrLf & _
            "Check the log file '" & GImport.LogFilePath & "'", _
            vbCritical Or vbOKOnly, "Failure"
    End If
    
    Exit Sub
    
eHandler:
    LogError "frmMain", "RunImport", Error(Err), False

End Sub

Private Sub mnuTreeAddAction_Click()
    AddNewAction
End Sub

Private Sub mnuTreeAddCheckPoint_Click()
    On Error GoTo eHandler
    
    Dim cp As CInputRecord
    
    '****************************************
    ' Add the checkpoint with a default name.
    '****************************************
    
    Set cp = GImport.AddCheckPoint(True)
    
    If Not cp Is Nothing Then
    
        ' Update the Tree with the new item.
        AddTreeItem GCurrentTreeNode.key, cp.GetID, _
            cp.name, etiType.ticheckpoint, "CheckPoint"
        
        ' Add a fields folder.
        AddTreeItem cp.GetID, GetUniqueID, "Fields", _
                etiType.tiFieldsFolder, "ClosedFolder"

    
        ' Need to save now!
        GImport.dirty = True
    End If
    
    Exit Sub
    
eHandler:
    LogError "frmMain", "mnuTreeAddCheckPoint", Error(Err), False

End Sub

Private Sub mnuTreeAddDataItem_Click()
    On Error GoTo eHandler
    
    Dim name As String, temp As String
    Dim cp As CInputRecord
    Dim di As CInputField