frmwizard1.frm

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

    '如果没有Mode字段则创建
    TestField = RsTable("Mode").Name
    If Err = NameNotInCollection Then
        ExistsTableQuery = True
        Set Fd = RsTable.CreateField("Mode", dbText)
        RsTable.Fields.Append Fd
        Err = 0
    End If
    '如果没有NetworkType字段则创建
    TestField = RsTable("NetworkType").Name
    If Err = NameNotInCollection Then
        ExistsTableQuery = True
        Set Fd = RsTable.CreateField("NetworkType", dbText)
        RsTable.Fields.Append Fd
        Err = 0
    End If
    '如果没有LaneNum字段则创建
    TestField = RsTable("LaneNum").Name
    If Err = NameNotInCollection Then
        ExistsTableQuery = True
        Set Fd = RsTable.CreateField("LaneNum", dbLong)
        RsTable.Fields.Append Fd
        Err = 0
    End If
    mDbBiblio.TableDefs.Append RsTable

    Dim rs As Recordset
    Set rs = mDbBiblio.OpenRecordset("Links")
    Dim TempNum
    
    rs.MoveLast
    TempNum = rs.RecordCount
    step = 100 / TempNum
    ProgressV = 0
        
    
    rs.MoveFirst
    step = 0
       
    Do Until rs.EOF
        step = step + 1
        rs.Edit
        rs("LinkId") = step
        rs.Update
        rs.MoveNext
        ProgressV = ProgressV + step
        Call Progress(ProgressV, "标准化数据库，")
    Loop
    
    '检查字段的完整性
    TestField = RsTable("NodeI").Name
    If Err = NameNotInCollection Then
        MsgBox "警告：路段数据表中缺少NodeI字段，请重新导入数据！"
        Err = 0
        Unload FrmProgress
        Exit Sub
    End If
    TestField = RsTable("NodeJ").Name
    If Err = NameNotInCollection Then
        MsgBox "警告：路段数据表中缺少NodeJ字段，请重新导入数据！"
        Err = 0
        Unload FrmProgress
        Exit Sub
    End If
    rs.Close
    
    Dim RsTable_Node As TableDef
    Set RsTable_Node = mDbBiblio.TableDefs("Nodes")
        
    '如果没有Nodetype字段则创建
    TestField = RsTable_Node("NodeType").Name
    If Err = NameNotInCollection Then
        ExistsTableQuery = True
        Set Fd = RsTable_Node.CreateField("NodeType", dbText)
        RsTable_Node.Fields.Append Fd
        Err = 0
    End If
    TestField = RsTable_Node("CrossType").Name
    If Err = NameNotInCollection Then
        ExistsTableQuery = True
        Set Fd = RsTable_Node.CreateField("CrossType", dbLong)
        RsTable_Node.Fields.Append Fd
        Err = 0
    End If
    mDbBiblio.TableDefs.Append RsTable_Node
    
    TestField = RsTable_Node("NodeId").Name
    If Err = NameNotInCollection Then
        MsgBox "警告：节点数据表中缺少NodeId字段，请重新导入数据！"
        Err = 0
        Unload FrmProgress
        Exit Sub
    End If
    TestField = RsTable_Node("NodeX").Name
    If Err = NameNotInCollection Then
        MsgBox "警告：路段数据表中缺少NodeX字段，请重新导入数据！"
        Err = 0
        Unload FrmProgress
        Exit Sub
    End If
    TestField = RsTable_Node("NodeY").Name
    If Err = NameNotInCollection Then
        MsgBox "警告：路段数据表中缺少NodeY字段，请重新导入数据！"
        Err = 0
        Unload FrmProgress
        Exit Sub
    End If
    
    Unload FrmProgress
    
    Dim Msg, Style, Title, response
    Msg = "数据导入成功完成，点击确定继续绘制道路路网图！"   ' 定义信息。
    Style = vbOKOnly
    Title = "数据成功导入！"
    response = MsgBox(Msg, Style, Title, Help, Ctxt)
    If response = vbOK Then   ' 用户按下“是”。
       Load FrmProgress
       FrmProgress.Show
       Call Build
    End If
    
    '写入设置文件
    ProjectPath = txtdir.Text
    Open ProjectPath & "setup.ini" For Output As #1
        Write #1, NodeRadius, NodeColor, LinkWidth, LinkColor
    Close #1
    
    Open App.Path & "\setup\recent.dat" For Append As #1
    Print #1, MDBPath
    Close #1
    
    Call MnuControl

End Sub

Private Sub cmdNext_Click()
    'show step 1
    Picture1.Visible = False
    Picture2.Visible = True
    Frame1.Visible = True
    Wizard.Visible = True
    Frame2.Visible = False
    
    cmddraw.Visible = True
    cmdnext.Visible = False
    cmdprev.Visible = True
    
    
Dim Lyr_Node As mapxlib.Layer
Dim LayerInfo_Node As New mapxlib.LayerInfo
Dim Flds_Node As New mapxlib.Fields

Dim Lyr_link As mapxlib.Layer
Dim LayerInfo_link As New mapxlib.LayerInfo
Dim Flds_link As New mapxlib.Fields
  
    
    'creat a database
    ProjectName = txtname.Text
        
    Dim DBStr As Database, DBWor As Workspace
    
    If txtname <> "" And txtdir <> "" Then
    
        MDBPath = txtdir & txtname & ".mdb"
        NodeTablePath = txtdir & "node.tab"
        LinkTablePath = txtdir & "link.tab"
        ImageTablePath = txtdir & "image.tab"
        
        '清除原来图层
        Set mDbBiblio = Nothing
        Main.Mapshow.Datasets.RemoveAll
        Main.Mapshow.Layers.RemoveAll
        Main.Mapshow.Refresh
        
        If Dir(MDBPath) <> "" Then
            Kill (MDBPath)
        End If
        If Dir(NodeTablePath) <> "" Then
            Kill (NodeTablePath)
        End If
        If Dir(LinkTablePath) <> "" Then
            Kill (LinkTablePath)
        End If

        
        Flds_Node.AddStringField "NodeID", 10
        LayerInfo_Node.Type = miLayerInfoTypeNewTable
        LayerInfo_Node.AddParameter "FileSpec", NodeTablePath
        LayerInfo_Node.AddParameter "NAME", "Node"
        LayerInfo_Node.AddParameter "Fields", Flds_Node
        Set Lyr_Node = Main.Mapshow.Layers.Add(LayerInfo_Node, 1)

        Flds_link.AddStringField "LinkID", 10
        LayerInfo_link.Type = miLayerInfoTypeNewTable
        LayerInfo_link.AddParameter "FileSpec", LinkTablePath
        LayerInfo_link.AddParameter "NAME", "Link"
        LayerInfo_link.AddParameter "Fields", Flds_link
        Set Lyr_link = Main.Mapshow.Layers.Add(LayerInfo_link, 1)

        Set DBWor = DBEngine.Workspaces(0)
        Set DBStr = DBWor.CreateDatabase(MDBPath, dbLangGeneral, dbVersion30)
        Set mDbBiblio = DBEngine.Workspaces(0).OpenDatabase(MDBPath)
        
    End If
    
End Sub

Private Sub cmdprev_Click()
    'show step 1
    Picture1.Visible = True
    Picture2.Visible = False
    Frame1.Visible = False
    Wizard.Visible = False
    Frame2.Visible = True
    
    cmddraw.Visible = False
    cmdnext.Visible = True
    cmdprev.Visible = False
End Sub

Private Sub Command1_Click()
Load FrmImportNode
FrmImportNode.Show
End Sub

Private Sub Command2_Click()

Load FrmImportLink
FrmImportLink.Show
    
End Sub


Private Sub Form_Load()
    
    
If ProjectName = "" Then

    'show step 1
    Frmwizard.Caption = "数据导入向导"
    Picture1.Visible = True
    Picture2.Visible = False
    Frame1.Visible = False
    Wizard.Visible = False
    Frame2.Visible = True
    cmddraw.Visible = False
    cmdnext.Visible = True
    cmdprev.Visible = False
    cmdnext.Enabled = False
    
Else

    'show step 2
    Picture1.Visible = False
    Picture2.Visible = True
    Frame1.Visible = True
    Wizard.Visible = True
    Frame2.Visible = False
    
    cmddraw.Visible = True
    cmdnext.Visible = False
    cmdprev.Visible = False

End If

End Sub

Private Sub txtdir_Change()
    
    If txtdir <> "" And txtname <> "" Then
        cmdnext.Enabled = True
    Else
        cmdnext.Enabled = False
    End If
    
End Sub