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

📄 form1.frm

📁 地图识别通过地图节点识别路经城市和里程,使用VB编写基础程序,可2点跳转
💻 FRM
📖 第 1 页 / 共 2 页
字号:
If Not dbr.EOF Then
    Text1.Text = Text1.Text & "站点ID:" & dbr("city_id") & Chr(13) & Chr(10)
    Text1.Text = Text1.Text & "经过道路:" & ciryroads(dbr("city_id")) & Chr(13) & Chr(10)
Else
    Text1.Text = Text1.Text & "无此站点" & Chr(13) & Chr(10)
End If
dbr.Close

dbr.Open "select top 1 * from citys where city like '%%" & Text3.Text & "%%'", conn, 3, 3
Text1.Text = Text1.Text & "终止城市:" & Text3.Text & Chr(13) & Chr(10)
If Not dbr.EOF Then
    Text1.Text = Text1.Text & "站点ID:" & dbr("city_id") & Chr(13) & Chr(10)
    Text1.Text = Text1.Text & "经过道路:" & ciryroads(dbr("city_id")) & Chr(13) & Chr(10)
Else
    Text1.Text = Text1.Text & "无此站点" & Chr(13) & Chr(10)
End If
dbr.Close

End Sub

Private Sub Command5_Click()
Text1.Text = roadofcitys(Text2.Text, Text3.Text)
End Sub

Private Sub Form_Load()
conn.ConnectionString = "driver={Microsoft Access Driver (*.mdb)};dbq=" & App.Path & "\way.mdb"
conn.Open
dbrs.Open "SELECT waypoints.ncity_id, waypoints.pcity_id FROM waypoints WHERE (((waypoints.city_id)=407))", conn, 1, 1
End Sub
Function add_province(province As String) As Long
    Dim rs As New ADODB.Recordset
    rs.Open "select top 1 * from provinces where province='" & province & "'", conn, 1, 3
    If rs.RecordCount = 1 Then
        add_province = rs("province_ID")
    Else
        rs.AddNew
        rs("province") = province
        rs.Update
        Debug.Print rs("province_ID")
        add_province = rs("province_ID")
    End If
End Function
Function add_city(city As String, province_id As Long) As Long
    Dim rs As New ADODB.Recordset
    rs.Open "select top 1 * from citys where city='" & city & "'", conn, 1, 3
    If rs.RecordCount = 1 Then
        add_city = rs("city_ID")
    Else
        rs.AddNew
        rs("city") = city
    rs("province_id") = province_id
        rs.Update
        Debug.Print rs("city_ID")
        add_city = rs("city_ID")
    End If
End Function
Function add_way(way As String) As Long
    Dim rs As New ADODB.Recordset
    rs.Open "select top 1 * from ways where way='" & way & "'", conn, 1, 3
    If rs.RecordCount = 1 Then
        add_way = rs("way_ID")
    Else
        rs.AddNew
        rs("way") = way
    rs("class") = 1
        rs.Update
        Debug.Print rs("way_ID")
        add_way = rs("way_ID")
    End If
End Function
Function showncity(cityid As Long, Optional mpath$ = "0") As String
Dim dbr As New ADODB.Recordset
Dim tmp_city As String
If n = 8 Then Exit Function
If cityid = 52 Then n = 8: Exit Function
    dbr.Open "SELECT waypoints.ncity_id, waypoints.pcity_id FROM waypoints WHERE (((waypoints.city_id)=" & cityid & ") and not (((waypoints.city_id) in(" & mpath$ & "))))", conn, 1, 1
    Debug.Print mpath$
    Do While Not dbr.EOF
'    'If dbr("ncity_id") <> -1 Then tmp_city = tmp_city & showcity(dbr("ncity_id")) & Chr(13) & Chr(10)
    If dbr("ncity_id") <> -1 Then tmp_city = tmp_city & showncity(dbr("ncity_id"), mpath$ & "," & cityid) & Chr(13) & Chr(10)
        If dbr("ncity_id") <> -1 Then tmp_city = tmp_city & showcity(dbr("ncity_id")) & Chr(13) & Chr(10)
        If dbr("pcity_id") <> -1 Then tmp_city = tmp_city & showcity(dbr("pcity_id")) & Chr(13) & Chr(10)

    dbr.MoveNext
    Loop
    showncity = tmp_city
    dbr.Close
    Set dbr = Nothing
End Function
Function showcity(cityid As Long) As String
Dim dbr As New ADODB.Recordset
    dbr.Open "select top 1 city from citys where (city_id=" & cityid & ")", conn, 1, 1
showcity = dbr("city")
Debug.Print showcity
DoEvents
    dbr.Close
    Set dbr = Nothing
End Function

Function ciryroads(cityid As Long) As String
Dim dbr As New ADODB.Recordset
Dim tciryroads  As String
dbr.Open "SELECT ways.way, ways.way_id FROM waypoints INNER JOIN ways ON waypoints.way_id = ways.way_id WHERE (((waypoints.city_id)=" & cityid & "))", conn, 1, 1
Do While Not dbr.EOF
    tciryroads = tciryroads & dbr("way") & "--"
dbr.MoveNext
tciryroads = Left(tciryroads, Len(tciryroads) - 1)
ciryroads = tciryroads
Loop
End Function
Function roaddis(sw, ew, wayid) As Long
Dim startwpoint&
Dim endwpoint&
Dim dbrsql As String
Dim dbr As New ADODB.Recordset
dbr.Open "select top 1 waypoint_id from waypoints where (way_id=" & wayid & " and  city_id=" & sw & ")", conn, 1, 1
startwpoint = dbr("waypoint_id")
dbr.Close
dbr.Open "select top 1 waypoint_id from waypoints where (way_id=" & wayid & " and  city_id=" & ew & ")", conn, 1, 1
endwpoint = dbr("waypoint_id")
dbr.Close

If startwpoint > endwpoint Then
Debug.Print 1
    dbrsql = "SELECT Sum([pdistance]) AS thesum FROM waypoints where (waypoint_id>= " & endwpoint & " and waypoint_id <= " & startwpoint & " and way_id = " & wayid & " )"
   
Else
Debug.Print 2
    dbrsql = "SELECT Sum([ndistance]) AS thesum FROM waypoints where (waypoint_id>= " & startwpoint & " and waypoint_id < " & endwpoint & " and way_id = " & wayid & " )"
End If
dbr.Open dbrsql, conn, 1, 1
roaddis = dbr("thesum")
dbr.Close
End Function


Function roadofcitys(ByVal startcityname As String, ByVal endcityname As String) As String
Dim tmpstring
Dim startid&, endid&

startid = 0
endid = 0


Dim dbr As New ADODB.Recordset
tmpstring = ""

dbr.Open "select top 1 * from citys where city like '%%" & startcityname & "%%'", conn, 3, 3
tmpstring = tmpstring & "起始城市:" & startcityname & Chr(13) & Chr(10)

If Not dbr.EOF Then
    tmpstring = tmpstring & "站点ID:" & dbr("city_id") & Chr(13) & Chr(10)
    tmpstring = tmpstring & "经过道路:" & ciryroads(dbr("city_id")) & Chr(13) & Chr(10)
    startid = dbr("city_id")
Else
    tmpstring = tmpstring & "无此站点" & Chr(13) & Chr(10)
End If
dbr.Close

dbr.Open "select top 1 * from citys where city like '%%" & endcityname & "%%'", conn, 3, 3
tmpstring = tmpstring & "终止城市:" & endcityname & Chr(13) & Chr(10)
If Not dbr.EOF Then
    tmpstring = tmpstring & "站点ID:" & dbr("city_id") & Chr(13) & Chr(10)
    tmpstring = tmpstring & "经过道路:" & ciryroads(dbr("city_id")) & Chr(13) & Chr(10)
    endid = dbr("city_id")
Else
    tmpstring = tmpstring & "无此站点" & Chr(13) & Chr(10)
End If
dbr.Close

If startid <> 0 And endid <> 0 Then
    tmpstring = tmpstring & "数据库包含起点和终点,可以寻找路径" & Chr(13) & Chr(10)
    
    tmpstring = tmpstring & "寻找同一路段路径" & Chr(13) & Chr(10)
    oneway = False
    dbr.Open "SELECT ways.way_id, ways.way FROM ways WHERE (((ways.way_id)IN (SELECT waypoints.way_id FROM waypoints WHERE (((waypoints.city_id)=" & startid & "))))) AND (((ways.way_id) IN (SELECT waypoints.way_id FROM waypoints WHERE (((waypoints.city_id)=" & endid & ")))))", conn, 1, 1
    
    Do While Not dbr.EOF
    oneway = True
            tmpstring = tmpstring & Chr(9) & "经过公路:" & dbr("way") & "  ID:" & dbr("way_id") & Chr(13) & Chr(10)
            tmpstring = tmpstring & Chr(9) & "里程:" & roaddis(startid, endid, dbr("way_id")) & Chr(13) & Chr(10)
    dbr.MoveNext
    Loop
    dbr.Close
    
    
    If oneway = False Then
    tmpstring = tmpstring & "不存在同一路段路径,查找单中转点路径:" & Chr(13) & Chr(10)
    dbrstr = "SELECT DISTINCT citys.city_id, citys.city FROM citys INNER JOIN waypoints ON citys.city_id = waypoints.city_id "
    dbrstr = dbrstr & " WHERE (("
    dbrstr = dbrstr & "(waypoints.city_id) In (SELECT waypoints.city_id FROM waypoints WHERE (((waypoints.way_id) In (SELECT waypoints.way_id FROM waypoints WHERE (((waypoints.city_id)=" & startid & "))))))"
    dbrstr = dbrstr & " And "
    dbrstr = dbrstr & "(waypoints.city_id) In (SELECT waypoints.city_id FROM waypoints WHERE (((waypoints.way_id) In (SELECT waypoints.way_id FROM waypoints WHERE (((waypoints.city_id)=" & endid & "))))))"
    dbrstr = dbrstr & "))"
    dbr.Open dbrstr, conn, 1, 1
    toweay = False
    Do While Not dbr.EOF
        towway = True
        tmpstring = tmpstring & Chr(9) & "经过城市:" & dbr("city") & "  ID:" & dbr("city_id") & Chr(13) & Chr(10)
        tmpstring = tmpstring & Chr(9) & Chr(9) & "中转里程:" & Chr(13) & Chr(10)
        tmpstring = tmpstring & Chr(9) & Chr(9) & startcityname & "-" & dbr("city") & "里程:" & roaddis(startid, dbr("city_id"), wayid(startid, dbr("city_id"))) & "(" & wayname(startid, dbr("city_id")) & ")" & Chr(13) & Chr(10)
        tmpstring = tmpstring & Chr(9) & Chr(9) & dbr("city") & "-" & endcityname & "里程:" & roaddis(dbr("city_id"), endid, wayid(dbr("city_id"), endid)) & "(" & wayname(dbr("city_id"), endid) & ")" & Chr(13) & Chr(10)
    dbr.MoveNext
    Loop
    dbr.Close
    End If
    
    
End If

roadofcitys = tmpstring
End Function

Function wayid(city1 As Long, city2 As Long) As Long
Dim dbr As New ADODB.Recordset
    dbr.Open "SELECT ways.way_id, ways.way FROM ways WHERE (((ways.way_id)IN (SELECT waypoints.way_id FROM waypoints WHERE (((waypoints.city_id)=" & city1 & "))))) AND (((ways.way_id) IN (SELECT waypoints.way_id FROM waypoints WHERE (((waypoints.city_id)=" & city2 & ")))))", conn, 1, 1
    wayid = dbr("way_id")
    dbr.Close
End Function
Function wayname(city1 As Long, city2 As Long) As String
Dim dbr As New ADODB.Recordset
    dbr.Open "SELECT ways.way_id, ways.way FROM ways WHERE (((ways.way_id)IN (SELECT waypoints.way_id FROM waypoints WHERE (((waypoints.city_id)=" & city1 & "))))) AND (((ways.way_id) IN (SELECT waypoints.way_id FROM waypoints WHERE (((waypoints.city_id)=" & city2 & ")))))", conn, 1, 1
    wayname = dbr("way")
    dbr.Close
End Function

⌨️ 快捷键说明

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