专家坐堂-获取地点经纬度坐标Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

以文本方式查看主题

-  Foxtable(狐表)  (http://www.foxtable.com/bbs/index.asp)
--  专家坐堂  (http://www.foxtable.com/bbs/list.asp?boardid=2)
----  获取地点经纬度坐标  (http://www.foxtable.com/bbs/dispbbs.asp?boardid=2&id=183364)

--  作者：shanshuizhujian
--  发布时间：2022/11/3 10:56:00
--  获取地点经纬度坐标

做个记录，大家需要的可以直接拿走，粘贴修改后直接使用。

Case "getjwd.html"
Dim sb As New StringBuilder
sb.AppendLine("<!doctype html>")
sb.AppendLine("<html>")
sb.AppendLine("<head>")
sb.AppendLine("<meta charset=\'utf-8\'>")
sb.AppendLine("<meta http-equiv=\'X-UA-Compatible\' c>")
sb.AppendLine("<meta name=\'viewport\' c>")
sb.AppendLine("<title>鼠标拾取地图坐标</title>")
sb.AppendLine("<link rel=\'stylesheet\' href=\'https://a.amap.com/jsapi_demos/static/demo-center/css/demo-center.css\'/> ")
sb.AppendLine("<script type=\'text/javascript\' src = \'https://cache.amap.com/lbs/static/addToolbar.js\'></script>")
sb.AppendLine("</head>")
sb.AppendLine("<style type=\'text/css\'>")
sb.AppendLine("html,body{")
sb.AppendLine("width: 100%;")
sb.AppendLine("height: 100%;")
sb.AppendLine("margin: 0px;")
sb.AppendLine("}")
sb.AppendLine(".map{")
sb.AppendLine("height: 100%;")
sb.AppendLine("width: 100%;")
sb.AppendLine("float: left;")
sb.AppendLine("}")
sb.AppendLine("</style>")
sb.AppendLine("<body>")
sb.AppendLine("<div id=\'container\' class=\'map\'></div>")
sb.AppendLine("<div class=\'input-card\'>")
sb.AppendLine("<h4>左击获取经纬度：</h4>")
sb.AppendLine("<div class=\'input-item\'>")
sb.AppendLine("<input type=\'text\' read id=\'lnglat\'>")
sb.AppendLine("</div>")
sb.AppendLine("</div>")
sb.AppendLine("<script src=\'https://webapi.amap.com/maps?v=1.4.15&key=您申请的key值&plugin=AMap.Autocomplete\'></script> ")
sb.AppendLine("<script type = \'text/javascript\'> ")
sb.AppendLine("var map = new AMap.Map(\'container\', {")
sb.AppendLine("resizeEnable: true")
sb.AppendLine(" });")
sb.AppendLine("var xmlhttp;")
sb.AppendLine("if (window.XMLHttpRequest)")
sb.AppendLine("{")
\' / / IE7 + , Firefox, Chrome, Opera, Safari 浏览器执行代码
sb.AppendLine("xmlhttp = new XMLHttpRequest();")
sb.AppendLine("}")
sb.AppendLine("else")
sb.AppendLine("{")
\' / / IE6, IE5 浏览器执行代码
sb.AppendLine("xmlhttp = new ActiveXObject(\'Microsoft.XMLHTTP\');")
sb.AppendLine("}")
sb.AppendLine(" map.on(\'click\', function(e) {")
sb.AppendLine(" console.log(e.lnglat.getLng() + \',\' + e.lnglat.getLat())")
sb.AppendLine(" document.getElementById(\'lnglat\').value = e.lnglat.getLng() + \',\' + e.lnglat.getLat()")
sb.AppendLine("xmlhttp.onreadystatechange = Function()")
sb.AppendLine("{")
sb.AppendLine("if (xmlhttp.readyState == 4 && xmlhttp.status == 200)")
sb.AppendLine("{")
sb.AppendLine("alert(xmlhttp.responseText);")
sb.AppendLine(" }")
sb.AppendLine("}")
sb.AppendLine("xmlhttp.open(\'GET\', \'acceptjwd.htm?Lng = \' + e.lnglat.getLng() + \' & \' + \'Lat = \' + e.lnglat.getLat(), true);")
sb.AppendLine("xmlhttp.send();")
sb.AppendLine(" });")
sb.AppendLine(" </script>")
sb.AppendLine("</body>")
sb.AppendLine("</html>")
e.WriteString(sb.ToString)
Case "acceptjwd.htm"

\'MessageBox.Show(e.PlainText)
Dim sb As New StringBuilder
sb.AppendLine("接收到的数据有:")
For Each key As String In e.Values.Keys
sb.AppendLine(key & ":" & e.Values(key))
Next
MessageBox.Show(sb.ToString)
e.WriteString("数据获取成功！")

--  作者：洮沙
--  发布时间：2022/11/3 11:00:00
--
赞