⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmmain.frm

📁 Data monkey是一个强大的是数据传输和转换应用程序。使用DataMonkey用户可以把复杂的文本文件格式
💻 FRM
📖 第 1 页 / 共 3 页
字号:
    '***************************************
    ' Add a new DataItem to this checkpoint.
    '***************************************
                            
    ' Get the checkpoint we are adding to.
    
    Set cp = GImport.GetCheckPoint(GCurrentTreeNode.parent.key)
    
    ' Add a new DataItem with a default name.
    Set di = cp.AddDataPoint(True)
    
    ' Add the dataitem to our display tree.
    AddTreeItem GCurrentTreeNode.key, di.GetID, _
        di.name, etiType.tidataitem, "DataItem"
    
    ' Need to save now!
    GImport.dirty = True
    
    ' Free our objects.
    Set di = Nothing
    Set cp = Nothing

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

Private Sub mnuTreeAddOutputDefinition_Click()
    tiAddOutputDefinition
End Sub

Private Sub mnuTreeCopy_Click()
    mnuEditCopy_Click
End Sub

Private Sub mnuTreeCut_Click()
    mnuEditCut_Click
End Sub

Private Sub mnuTreeDelete_Click()
    tiDelete
End Sub

Private Sub mnuTreeEditOutputSchema_Click()
    Dim sch As New COutputSchema
    Dim arc As New CArchive
    Dim ols As COutputLinks
    
    If frmDocument.TreeView1.SelectedItem Is Nothing Then Exit Sub
    
    ' Get the outputlinks that owns this schema.
    Set ols = GImport.GetOutputLinksManager _
        (frmDocument.TreeView1.SelectedItem.parent.key)
    If ols Is Nothing Then Exit Sub

    ' Load the schema.
    arc.fileName = ols.SchemaFileLastKnownLocation
    
    If Not arc.OpenFile() Then
        arc.fileName = ols.LocateSchemaFile()
        If arc.fileName = "" Then Exit Sub
    End If
    
    If sch.Load(arc) Then
        Dim fileName As String
        fileName = sch.Edit()
        If GFormReturnValue = vbOK Then
            ' The name of the output source may have changed.
            frmDocument.TreeView1.SelectedItem.Text = sch.name
            
            ' The file may have been saved with a different name.
            If fileName <> "" Then
                ols.SchemaFileLastKnownLocation = fileName
            End If

        End If
    End If
    
    Set ols = Nothing

End Sub

Private Sub mnuTreeEditRelationships_Click()
    Dim ol As COutputLinks
    Set ol = GImport.GetOutputLinksManager(frmDocument.TreeView1.SelectedItem.key)
    
    ' Show the links mapping form.
    frmIOMapping.SetLinksReference ol
    Set ol = Nothing
    frmIOMapping.Show vbModal
    
End Sub

Private Sub mnuTreePaste_Click()
    mnuEditPaste_Click
End Sub

Private Sub mnuTreeProperties_Click()
    On Error GoTo eHandler
    
    Dim ItemType As etiType
    Dim obj As Object
    
    GFormReturnValue = vbCancel
    
    Set obj = tiGetTreeItem()
    If obj Is Nothing Then Exit Sub
    
    ItemType = tiGetSelectedItemType()
    
    Select Case ItemType
        Case etiType.tiimport
            frmImportProperties.Show vbModal
            frmDocument.TreeView1.SelectedItem.Text = GImport.name

        Case etiType.ticheckpoint
        Case etiType.tidataitem

        Case etiType.tiDataItemAction, etiType.tiCheckpointAction, _
                etiType.tiImportAction
            
            ' Get the parent object so we will have a name to
            ' associate with the command.
            Dim parent As Object
            If ItemType = tiImportAction Then
                Set parent = tiGetTreeItem(frmDocument.TreeView1.SelectedItem.parent.parent.key)
            Else
                Set parent = tiGetTreeItem(frmDocument.TreeView1.SelectedItem.parent.key)
            End If
            
            obj.EditProperties parent.name, GImport
            frmDocument.TreeView1.SelectedItem.Text = obj.GetSpecificDescription

        Case etiType.tioutputlinks
            obj.Edit
            ' The name of the output source may have changed.
            frmDocument.TreeView1.SelectedItem.Child.Text = obj.OutputSourceName
            frmDocument.TreeView1.SelectedItem.Text = obj.name
            
    End Select
    
    If GFormReturnValue = vbOK Then
        ' Need to save now!
        GImport.dirty = True
    End If
    
    Exit Sub
    
eHandler:
    LogError "frmMain", "mnuTreeProperties", Error(Err), False
    'Resume
End Sub
Private Sub mnuViewBrowser_Click()
    'Dim frmB As New frmBrowser
    'frmB.StartingAddress = "http://www.microsoft.com"
    'frmB.Show
End Sub

Private Sub mnuHelpAbout_Click()
    frmAbout.Show vbModal, Me
End Sub

Private Sub mnuViewProjectWindow_Click()
    
    MainDocumentVisible

End Sub

Private Sub mnuViewStatusBar_Click()
    If mnuViewStatusBar.Checked Then
        sbStatusBar.Visible = False
        mnuViewStatusBar.Checked = False
    Else
        sbStatusBar.Visible = True
        mnuViewStatusBar.Checked = True
    End If
End Sub

Private Sub mnuViewToolbar_Click()
    If mnuViewToolbar.Checked Then
        tbToolBar.Visible = False
        mnuViewToolbar.Checked = False
    Else
        tbToolBar.Visible = True
        mnuViewToolbar.Checked = True
    End If
End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As ComctlLib.Button)

    Select Case Button.key

        Case "New"
            LoadNewDoc
        Case "New"
            mnuFileNewProject_Click
        Case "Open"
            mnuFileOpen_Click
        Case "Save"
            mnuFileSave_Click
        Case "Print"
            'mnuFilePrint_Click
        Case "Cut"
            mnuEditCut_Click
        Case "Copy"
            mnuEditCopy_Click
        Case "Paste"
            mnuEditPaste_Click
        Case "Exclamation"
            RunImport
    End Select
End Sub

Private Sub mnuHelpContents_Click()
    
    Dim nRet As Integer

    'if there is no helpfile for this project display a message to the user
    'you can set the HelpFile for your application in the
    'Project Properties dialog
    If Len(App.HelpFile) = 0 Then
        MsgBox "Unable to display Help Contents. There is no Help associated with this project.", vbInformation, Me.Caption
    Else
        On Error Resume Next
        nRet = OSWinHelp(Me.hwnd, App.HelpFile, 3, 0)
        If Err Then
            MsgBox Err.Description
        End If
    End If
End Sub

Private Sub mnuHelpSearch_Click()
    
    Dim nRet As Integer

    'if there is no helpfile for this project display a message to the user
    'you can set the HelpFile for your application in the
    'Project Properties dialog
    If Len(App.HelpFile) = 0 Then
        MsgBox "Unable to display Help Contents. There is no Help associated with this project.", vbInformation, Me.Caption
    Else
        On Error Resume Next
        nRet = OSWinHelp(Me.hwnd, App.HelpFile, 261, 0)
        If Err Then
            MsgBox Err.Description
        End If
    End If
End Sub

Private Sub mnuWindowArrangeIcons_Click()
    Me.Arrange vbArrangeIcons
End Sub

Private Sub mnuWindowCascade_Click()
    Me.Arrange vbCascade
End Sub

Private Sub mnuWindowTileHorizontal_Click()
    Me.Arrange vbTileHorizontal
End Sub

Private Sub mnuWindowTileVertical_Click()
    Me.Arrange vbTileVertical
End Sub

Private Sub mnuEditCopy_Click()
    Dim obj As Object
    Dim objtype As etiType
    
    Set obj = tiGetTreeItem()
    objtype = tiGetSelectedItemType()

    tiSetCutCopyPasteItem obj.Copy(), objtype

End Sub


Private Sub mnuEditCut_Click()

    tiSetCutCopyPasteItem tiGetTreeItem(), tiGetSelectedItemType()
    tiDelete

End Sub

Private Sub mnuEditPaste_Click()
    
    Dim obj As Object
    Dim objtype As etiType
    
    ' Get the clipboard object to be pasted.
    tiGetCutCopyPasteItem obj, objtype
    
    tiPutItem obj, objtype
    
    ' The user may try to paste the same object more than
    ' once so make a new copy of the this item with a new ID.
    tiSetCutCopyPasteItem obj.Copy, objtype

End Sub

Private Sub mnuFileOpen_Click()
    Dim sFile As String
    
    ' Make sure the current project is saved if neccessary.
    If Not CanDeleteProject Then Exit Sub
    
    If Not Archive.BrowseFileOpen("Open project file", , _
                "Project Files (*.import)|*.import|All Files (*.*)|*.*") Then
        Exit Sub
    End If
    
    Set GImport = Nothing
    Set GImport = New CImport

    If Not GImport.Load(Archive) Then
        LogError "frmMain", "mnuFileOpen", "Unable to load import file", False
    Else
        FillCheckPointTree
        Archive.CloseFile
    End If
End Sub

Private Sub mnuFileClose_Click()
    
    ' Make sure the current project is saved if neccessary.
    If Not CanDeleteProject Then Exit Sub
    
    Set GImport = Nothing
    
    ' Create the default project.
    Set GImport = New CImport
    GImport.name = "Default Project"
    
End Sub

Private Sub mnuFileSave_Click()
    
    If Archive.fileName = "" Then
    
        If Not Archive.BrowseFileSave("Save project file", _
                                    Archive.fileName, _
                                    "Project Files (*.import)|*.import|All Files (*.*)|*.*") Then
            Exit Sub
        End If
    End If
    
    ' Save the project file.
    GImport.Save Archive
    Archive.CloseFile
    
End Sub

Private Sub mnuFileSaveAs_Click()
    
    If Archive.BrowseFileSave("Save project file", Archive.fileName, _
                "Project Files (*.import)|*.import" & _
                "|All Files (*.*)|*.*") Then
        GImport.Save Archive
        Archive.CloseFile
    End If

End Sub

Private Sub mnuFileSaveAll_Click()
    Call mnuFileSave_Click
End Sub

Private Sub mnuFilePageSetup_Click()
    dlgCommonDialog.ShowPrinter
End Sub

Private Sub mnuFileExit_Click()
    'unload the form
    Unload Me
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -