北斗定位代码
- 格式：doc
- 大小：47.50 KB
- 文档页数：6
'目标运动轨迹显示
Private Sub baidu_trace_Click()
' WebBrowser1.Document.parentWindow.execScript "map.panTo(new BMap.Point( " &
center_lng & "," & center_lat & "))", "javascript"
' WebBrowser1.Document.parentWindow.execScript "map.addOverlay(new
BMap.Marker(new BMap.Point( " & center_lng & "," & center_lat & ")))", "javascript"
Dim a(100) As String
Dim b(100) As String
'实时定位时用到距离计算
Dim lng1 As Double
Dim lat1 As Double
Dim lng2 As Double
Dim lat2 As Double
Dim lenght As Double
Dim i, p As Integer
i = 1
Open "C:\\Users\\Administrator\\Desktop\\test_complete_six\\test_map_data.txt" For
Input As #1
lng1 = center1_lng.Text
lat1 = center1_lat.Text
r = CDbl(Text3_R.Text)
On Error GoTo h
Do While Not EOF(1)
'读取一行数据到s中，现在s是一个字符串
Line Input #1, s
p = Len(s)
longitude = Mid(s, 1, 10)
'读取字符串前10个字符
a(i) = Mid(s, 1, 10)
lng2 = a(i)
'读取字符后八个字符
b(i) = Mid(s, 12, 20)
lat2 = b(i)
WebBrowser1.Document.getElementsByTagName("input")("longitude").Value = a(i)
WebBrowser1.Document.getElementsByTagName("input")("latitude").Value = b(i)
If a(i) <> "" Then
WebBrowser1.Document.parentWindow.execScript "map.addOverlay(new
BMap.Marker(new BMap.Point( " & a(i) & "," & b(i) & ")))" WebBrowser1.Document.parentWindow.execScript "map.panTo(new
BMap.Point( " & a(i) & "," & b(i) & "))", "javascript"
length = distance(lng1, lat1, CDbl(lng2), CDbl(lat2))
If length < r Then
Shape1.FillColor = vbGreen
Else
Shape1.FillColor = vbRed
End If
End If
'========================
i = i + 1
Loop
h:
Close #1
End Sub
'点击删除所有的标记点
Private Sub baidu_delete_Click()
Dim a(100) As String
Dim b(100) As String
Dim i, p As Integer
i = 1
Open "C:\\Users\\Administrator\\Desktop\\test_complete_six\\test_map_data.txt" For
Input As #1
On Error GoTo h
Do While Not EOF(1)
'读取一行数据到s中，现在s是一个字符串
Line Input #1, s
p = Len(s)
longitude = Mid(s, 1, 10)
'读取字符串前10个字符
a(i) = Mid(s, 1, 10)
'读取字符后八个字符
b(i) = Mid(s, 12, 20)
WebBrowser1.Document.getElementsByTagName("input")("longitude").Value = a(i)
WebBrowser1.Document.getElementsByTagName("input")("latitude").Value = b(i)
'====点击按钮============
Dim vTag, k '定义变量
For Each vTag In WebBrowser1.Document.All '用for each in查找所有元素 If UCase(vTag.tagName) = "INPUT" Then '锁定iput标签
If vTag.Type = "button" And vTag.Value = "删除" Then vTag.Click '找到标签下的按钮
End If
Next
'========================
i = i + 1
Loop
h:
Close #1
End Sub
'=====================计算两点间的距离==============================
Private Sub baidu_juli_jisuan_Click()
Dim lng1 As Double
Dim lat1 As Double
Dim lng2 As Double
Dim lat2 As Double
lng1 = start_jingdu.Text
lat1 = start_weidu.Text
lng2 = end_jingdu.Text
lat2 = END_WEIDU.Text
length = distance(lng1, lat1, lng2, lat2)
JULI.Text = length
WebBrowser1.Document.getElementsByTagName("input")("longitude1").Value = lng1
WebBrowser1.Document.getElementsByTagName("input")("latitude1").Value = lat1
WebBrowser1.Document.getElementsByTagName("input")("longitude1").Value = lng2
WebBrowser1.Document.getElementsByTagName("input")("latitude1").Value = lat2
Dim vTag, k '定义变量
For Each vTag In WebBrowser1.Document.All '用for each in查找所有元素
If UCase(vTag.tagName) = "INPUT" Then '锁定iput标签
If vTag.Type = "button" And vTag.Value = "计算" Then vTag.Click '找到标签下的按钮
End If
Next
End Sub
'===================================加载地图===================================
Private Sub Form_Load()
WebBrowser1.Navigate App.Path & "\BaiduMap.htm"
baidu_center_set.Enabled = False
shi_ding_wei.Enabled = False
baidu_trace.Enabled = False baidu_delete.Enabled = False
baidu_tishi.Enabled = False
baidu_juli_jisuan.Enabled = False
baidu_short_time.Enabled = False
baidu_zuiduan_lujing.Enabled = False
baidu_bikaisp.Enabled = False
End Sub
'==========================label提示信息========================================
Private Sub Label1_Click()
Dim oWindow
Set oWindow = WebBrowser1.Document.parentWindow
oWindow.confirm "范围设定请不要超过10万米"
End Sub
'==========================实时定位系统====================================
Private Sub shi_ding_wei_Click()
