frmimport.frm

一个交通专用的gis-T系统

        flxPreview.Rows = flxPreview.Rows + 1
    Loop
    Close #1

    'Display the column captions
    flxPreview.Row = 0
    For intLoop = 1 To UBound(aryFields)
        flxPreview.Col = intLoop - 1
        flxPreview.Text = aryFields(intLoop)
    Next intLoop

    flxPreview.Rows = flxPreview.Rows - 1

    If chkFirstRow.Value = False Then
        flxPreview.Row = 0
        For intLoop = 1 To UBound(aryFields)
            flxPreview.Col = intLoop - 1
            flxPreview.Text = aryNameAndType(intLoop, 1)
        Next intLoop
    Else
        flxPreview.RemoveItem 1
    End If

    cmdFinish.Enabled = True

    Exit Function

ErrHndl:
    MsgBox Err.Description, vbInformation, "Error:"

End Function

Private Sub cboType_Click()
    SaveType
End Sub

Private Sub cboType_Change()
    SaveType
End Sub

Private Sub SaveType()
    If flxPreview.Col = -1 Then Exit Sub
    aryNameAndType(flxPreview.Col + 1, 2) = cboType.Text
End Sub

Private Sub chkFirstRow_Click()
    optDelimiter_Click (intIndex)
End Sub

Private Sub cmbfield_Click()

    If cmbfield.Text <> "自定义..." Then
        If flxPreview.Col = -1 Then Exit Sub
        aryNameAndType(flxPreview.Col + 1, 1) = cmbfield.Text
        flxPreview.Row = 0
        flxPreview.Text = cmbfield.Text
        flxPreview.RowSel = flxPreview.Rows - 1
        TxtField.Visible = False
    Else
        TxtField.Visible = True
        TxtField.SetFocus
        TxtField.SelStart = 0
        TxtField.SelLength = Len(TxtField)
    End If
        
    If cmbfield.Text = "NodeType" Then
        cboType.Text = "TEXT"
    ElseIf cmbfield.Text = "NodeId" Then
        cboType.Text = "NUMBER"
    ElseIf cmbfield.Text = "NodeX" Then
        cboType.Text = "NUMBER"
    ElseIf cmbfield.Text = "NodeY" Then
        cboType.Text = "NUMBER"
    End If
        
        
End Sub



Private Sub Cmdcancel_Click()
    Unload Me
End Sub

Private Sub cmdFinish_Click()
    Dim intLoop As Integer
    Dim strTrashCan As String
    Dim strTrash As String
    'check for junk and duplicate names
    AccessTableName = txtname
    Randomize
    cmdFinish.Enabled = False
    cmdPrevious.Enabled = False
    For intLoop = 1 To UBound(aryNameAndType, 1)
        If InStr(strTrashCan, aryNameAndType(intLoop, 1)) <> 0 Then
            If chkFix.Value = 1 Then
                aryNameAndType(intLoop, 1) = aryNameAndType(intLoop, 1) & Rnd * 100
            Else
                MsgBox "字段名称重复 '" & aryNameAndType(intLoop, 1) & "'", vbInformation, "数据导入向导"
                picWizard(intStep).Visible = False
                picWizard(2).Visible = True
                intStep = 2
                cmdnext.Enabled = True
                cmdFinish.Enabled = True
                Exit Sub
            End If
        Else
            strTrashCan = strTrashCan & "|" & aryNameAndType(intLoop, 1)
            strTrash = RemoveJunk(CStr(aryNameAndType(intLoop, 1)))
            If Len(strTrash) <> Len(aryNameAndType(intLoop, 1)) Or Len(strTrash) = 0 Then
                If chkFix.Value = 1 Then
                    aryNameAndType(intLoop, 1) = RemoveJunk(CStr(aryNameAndType(intLoop, 1)))
                    If Len(aryNameAndType(intLoop, 1)) = 0 Then aryNameAndType(intLoop, 1) = "Field" & intLoop
                Else
                    MsgBox "无效字段名称 '" & aryNameAndType(intLoop, 1) & "'", vbInformation, "数据导入向导"
                    picWizard(intStep).Visible = False
                    picWizard(2).Visible = True
                    intStep = 2
                    cmdnext.Enabled = True
                    cmdFinish.Enabled = True
                    Exit Sub
                End If
            End If
        End If
    Next intLoop
    strTrash = txtname
    If Len(RemoveJunk(txtname)) <> Len(strTrash) Or Len(strTrash) = 0 Then
        If chkFix.Value = 1 Then
            txtname = RemoveJunk(CStr(txtname))
            If Len(txtname) = 0 Then txtname = "Table1"
        Else
            MsgBox "无效的数据表名 '" & txtname & "'", vbInformation, "数据导入向导"
            picWizard(intStep).Visible = False
            picWizard(3).Visible = True
            intStep = 3
            cmdnext.Enabled = True
            cmdFinish.Enabled = True
            Exit Sub
        End If
    End If
    ImportASCII
    
    Frmwizard.lblshow(0).Caption = "节点数据导入成功！"
    
    
End Sub

Private Sub cmdFrom_Click()
    Dim intFound As Integer
    CD1.DialogTitle = "All Files"
    CD1.Filter = "All Files|*.*"
    CD1.ShowOpen
    ASCIIFileName = CD1.FileName
    If Len(CD1.FileName) > 25 Then
        intFound = InStr(20, CD1.FileName, "\")
        If intFound <> 0 Then
            CD1.FileName = Mid(ASCIIFileName, 1, intFound) & "...\" & CD1.FileTitle
        End If
    End If
    txtFrom = CD1.FileName
    CD1.FileName = ""
End Sub

Private Sub cmdNext_Click()
    If intStep = 0 Then cmdnext.Enabled = False: CheckFileNames
    cmdPrevious.Enabled = True
    picWizard(intStep).Visible = False
    intStep = intStep + 1
    If intStep + 1 = picWizard.Count Then cmdnext.Enabled = False
    If intStep = picWizard.Count Then intStep = intStep - 1
    picWizard(intStep).Visible = True
    picHeader.Visible = True
    DisplayCaption
    If intStep = 3 Then cmdFinish.Enabled = True
End Sub

Private Sub cmdPrevious_Click()
    picWizard(intStep).Visible = False
    cmdnext.Enabled = True
    cmdFinish.Enabled = False
    If intStep <= 1 Then picHeader.Visible = False: cmdPrevious.Enabled = False
    If intStep = 0 Then intStep = intStep + 1
    intStep = intStep - 1
    picWizard(intStep).Visible = True
    DisplayCaption
End Sub

Private Sub DisplayCaption()
    Select Case intStep
        Case 1
            lblHeader = "请选择源数据文件："
            lblStep = "请选择有效的节点数据文件，支持格式为ASCII编码文本文件"
            txtFrom.SetFocus
        Case 2
            lblHeader = "定义字段信息："
            lblStep = "请根据下述预览窗口选择字段之间有效分隔符号"
            'Since this is the screen where the preview is displayed, we need to refresh the preview grid
            If Not Edited Then Call optDelimiter_Click(intIndex)
            flxPreview.SetFocus
        Case 3
            lblHeader = "导入数据至MICROSOFT ACCESS数据库"
            lblStep = "文件所导入的MICROSOFT ACCESS数据库表名"
            txtname.SetFocus
            txtname.SelStart = 0
            txtname.SelLength = Len(txtname)
    End Select
End Sub

Private Sub flxPreview_Click()
    
    If flxPreview.Rows = 0 Then Exit Sub
    flxPreview.Row = 0
    flxPreview.RowSel = flxPreview.Rows - 1
    If flxPreview.Col = -1 Then Exit Sub
    TxtField = aryNameAndType(flxPreview.Col + 1, 1)
    cboType.Text = aryNameAndType(flxPreview.Col + 1, 2)
 
    
End Sub

Private Sub Form_Load()
    
    flxPreview.Cols = 0
    cboQualifier.AddItem Chr$(34)
    cboQualifier.AddItem "'"
    cboQualifier.AddItem "{none}"
    cboQualifier.Text = "{none}"
    cboType.AddItem "DOUBLE"
    cboType.AddItem "NUMBER"
    cboType.AddItem "TEXT"
    cboType.AddItem "MEMO"
    cboType.AddItem "DATE/TIME"
    cboType.AddItem "CURRENCY"
    cboType.AddItem "AUTONUMBER"
    cboType.AddItem "YES/NO"
    
    cmbfield.AddItem "NodeType"
    cmbfield.AddItem "NodeId"
    cmbfield.AddItem "NodeX"
    cmbfield.AddItem "NodeY"
    cmbfield.AddItem "自定义..."
    cmbfield.Text = "选择字段名称..."

    txtTo.Text = MDBPath
    AccessFileName = MDBPath
    intStep = 0
    
End Sub

Private Sub optDelimiter_Click(Index As Integer)
    intIndex = Index
    Select Case Index
        Case 0
            PreviewASCII vbTab
        Case 1
            PreviewASCII ";"
        Case 2
            PreviewASCII ","
        Case 3
            PreviewASCII " "
        Case 4
            txtOther.SetFocus
    End Select
End Sub

Private Sub tmrUnload_Timer()
    Complete = True
    Unload Me
End Sub

Private Sub txtField_Change()
    If flxPreview.Col = -1 Then Exit Sub
    aryNameAndType(flxPreview.Col + 1, 1) = TxtField
    flxPreview.Row = 0
    flxPreview.Text = TxtField
    flxPreview.RowSel = flxPreview.Rows - 1
End Sub

Private Sub txtField_LostFocus()
    Edited = True
End Sub


Private Sub txtTo_Change()
'    CheckFileNames
End Sub

Private Sub txtFrom_Change()
    CheckFileNames
End Sub

Private Sub txtTo_LostFocus()
    If InStr(txtTo, "...") = 0 Then ASCIIFileName = txtTo
End Sub

Private Sub txtFrom_LostFocus()
    If InStr(txtFrom, "...") = 0 Then ASCIIFileName = txtFrom
End Sub

Private Sub txtOther_Change()
    PreviewASCII txtOther
End Sub

Private Sub CheckFileNames()
    If InStr(ASCIIFileName, "...") <> 0 Then txtFrom = "": ASCIIFileName = ""
    If InStr(AccessFileName, "...") <> 0 Then txtTo = "": AccessFileName = ""
    If Dir(ASCIIFileName) <> "" And txtFrom <> "" And Dir(AccessFileName) <> "" And txtTo <> "" Then
        cmdnext.Enabled = True
    Else
        cmdnext.Enabled = False
        cmdFinish.Enabled = False
    End If
End Sub

Private Function RemoveJunk(strData As String)
    Dim lngLoop As Long
    Dim strTmp As String
    Dim strChar As String
    For lngLoop = 1 To Len(strData)
        strChar = Mid(strData, lngLoop, 1)
        If strChar Like "[A-Z]" Or strChar Like "[a-z]" Or strChar Like "[0-9]" Then
            strTmp = strTmp & Mid(strData, lngLoop, 1)
        End If
        DoEvents
    Next lngLoop
    If Mid(strTmp, 1, 1) Like "#" Then strTmp = ""
    RemoveJunk = strTmp
End Function