阅读:11278回复:34
VB+MapX 实现地图上GPS数据显示(GPS+GIS)
<P>在帖子:<B>VB读取、显示、保存、回放GPS数据的源程序</B></P>
<P><a href="http://www.gisempire.com/bbs/dispbbs.asp?boardID=13;ID=18641;page=1" target="_blank" >http://www.gisempire.com/bbs/dispbbs.asp?boardID=13;ID=18641;page=1</A></P> <P>的基础上,对其进行简单的处理就可实现地图上的GPS数据显示。</P> <P>只需对显示模块modTransFun中的进行修改即可,具体实现部分自己看吧:</P> <P>Public Sub playNMEA(sArray As Variant) '读取存有GPS信息的回放文件 Dim rmc As GPRMC Dim Utils As New CParseUtils Dim Sentence As Integer</P> <P>Dim mapDest As MapXLib.Map Dim mobileObj As New MapXLib.Feature Dim mobileFtr As New MapXLib.Feature Dim lnFeat As New MapXLib.Feature Dim FeatFact As MapXLib.FeatureFactory</P> <P>Dim GPSPoints As New MapXLib.Points, aPoint As New MapXLib.Point Dim NewStyle As New Style</P> <P>Dim GPSLayerID As Integer Dim intReg As Integer Dim DD_X As Double, DD_Y As Double </P> <P>Dim yy As String, mm1 As String, dd As String '年、月、日 Dim hh As String, mm2 As String, ss As String '时、分、秒</P> <P>intReg = 0.00012</P> <P>Set mapDest = <FONT color=#ff0000>frmMain.mapMain </FONT><FONT color=#000000>'这里是用于显示地图的表单及控件名</FONT></P> <P>GPSLayerID = 1 'mapDest.Layers.Count Set mapDest.Layers.AnimationLayer = mapDest.Layers(GPSLayerID)</P> <P>mobileFtr.Attach mapDest mobileFtr.Type = miFeatureTypeSymbol 'mobileFtr.Style = mapDest.DefaultStyle</P> <P>With NewStyle .SymbolFont.Name = "Mapinfo symbols" .SymbolCharacter = 50 ';H40 '塔符号0X40,圆形符号0X2F .SymbolFont.Size = 4 ' set the size of the symbol to be 18... .SymbolFontRotation = 0 .SymbolFontShadow = False .SymbolFontHalo = False ' turn Halo effect on... .SymbolFontColor = vbRed ' 红... .SymbolFontBackColor = miColorWhite ' change the Halo color to White End With mobileFtr.Style = NewStyle</P> <P>For Sentence = 0 To sCnt - 1 If Utils.Parse(sArray(Sentence), 1) = "$GPRMC" Then Set rmc = New GPRMC DoEvents With rmc .Sentence = sArray(Sentence) If Not Val(.Longitude) = 0 Then DD_X = DM2DD(.Longitude) DD_Y = DM2DD(.Latitude) frmGPS_Disp.lblX.Caption = "X: " ; Format(DD_X, "000.0000") ; " " ; .LonHemis frmGPS_Disp.lblY.Caption = "Y: " ; Format(DD_Y, " 00.0000") ; " " ; .LatHemis If mapDest.MapUnit = miUnitDegree Then Else End If mobileFtr.Point.Set DD_X, DD_Y Set mobileObj = mapDest.Layers(GPSLayerID).AddFeature(mobileFtr) mapDest.Layers(GPSLayerID).Refresh If mobileFtr.Point.X > mapDest.Bounds.XMAX - intReg Or _ mobileFtr.Point.X < mapDest.Bounds.XMin + intReg Or _ mobileFtr.Point.Y > mapDest.Bounds.YMAX - intReg Or _ mobileFtr.Point.Y < mapDest.Bounds.YMin + intReg Then mapDest.CenterX = mobileFtr.Point.X mapDest.CenterY = mobileFtr.Point.Y End If '去除速度前的0 frmGPS_Disp.lblSpeed.Caption = "速度: " ; Val(.Speed) ; " Km/h" '日期的格式转换: 250503 -> 03/05/25 dd = Mid$(.UTDate, 1, 2) mm1 = Mid$(.UTDate, 3, 2) yy = Mid$(.UTDate, 5, 2) frmGPS_Disp.lblDate.Caption = "日期: " ; Format(yy + mm1 + dd, "00/00/00") 'UTC时间转换为北京时间 hh = Mid$(.UTC, 1, 2) + 8 mm2 = Mid$(.UTC, 3, 2) ss = Mid$(.UTC, 5, 2) frmGPS_Disp.lblUTC.Caption = "时间: " ; Format(hh + mm2 + ss, "00:00:00") Else MsgBox "接收卫星太少,不能定位!" frmGPS_Disp.lblX.Caption = "X: " frmGPS_Disp.lblY.Caption = "Y: " frmGPS_Disp.lblSpeed.Caption = "速度: " frmGPS_Disp.lblDate.Caption = "日期: " frmGPS_Disp.lblUTC.Caption = "时间: " Exit Sub End If End With End If Next Sentence End Sub</P> [此贴子已经被作者于2004-9-5 21:58:23编辑过]
|
|
|
1楼#
发布于:2004-09-05 21:55
<P>当然还需要建立一个用于显示地图的表单 frmMain,其地图控件为 mapMain</P>
<P>上述代码中注释少了点,如有不明白的地方,我再解释</P> [此贴子已经被作者于2004-9-5 22:08:15编辑过]
|
|
|
2楼#
发布于:2004-11-08 17:16
<P>根据地图的坐标系(WGS84 or BJ54)来,显示GPS坐标的改进。(就是第1帖中空的那个判断语句)</P>
<P> If mapDest.NumericCoordSys.Units = miUnitDegree Then '度 mobileFtr.Point.Set DD_X, DD_Y Else '米 BJ54坐标系 '经纬度BL换算到高斯平面直角坐标XY(高斯投影正算) Deg2XY DD_X, DD_Y, CC_X, CC_Y mobileFtr.Point.Set CC_X, CC_Y End If </P> [此贴子已经被作者于2004-11-8 17:34:18编辑过]
|
|
|
3楼#
发布于:2004-11-21 12:09
<P>我手头没有VC的,</P><P>如果谁有请上传一段代码,</P><P>让同仁们共同进步</P><img src="images/post/smile/dvbbs/em04.gif" />
|
|
|
4楼#
发布于:2004-12-24 13:13
<P>Set mapDest = frmMain.mapMain 一句:</P><P> mapDest是定义的变量,这个不用重新写</P><P> frmMain是你自己的显示地图的那个表单名,mapMain是地图控件名</P>
|
|
|
5楼#
发布于:2005-06-03 14:20
<P>'经纬度BL换算到高斯平面直角坐标XY(高斯投影正算)<BR>Private Function Deg2XY(ByRef F2 As Double, ByRef E2 As Double, _<BR> ByRef s2 As Double, ByRef t2 As Double) As Boolean<BR> 'A2 输入中央子午线,以度.分秒形式输入,如115度30分则输入115.30; 起算数据L0<BR> 'F2 以度小数形式输入经度值, L<BR> 'E2 以度小数形式输入纬度值,B<BR> 'S2 计算结果,横坐标Y,,请特别注意,这里生成的是高斯坐标<BR> 'T2 计算结果,纵坐标X<BR> '投影带号计算 n=[L/6]+1 如:兰州测得经度103.XXXX,故n=[103.X/6]+1=17+1=18<BR> '中央经线经度 L0 = n*6-3 = [L/6]*6+3<BR> <BR> 'ByRef A2 As Double,<BR> Dim A2 As Double<BR> Dim B2 As Double<BR> 'Dim G2 As Double<BR> Dim H2 As Double<BR> Dim i2 As Double<BR> Dim J2 As Double<BR> Dim K2 As Double<BR> Dim l2 As Double<BR> Dim M2 As Double<BR> Dim n2 As Double<BR> Dim O2 As Double<BR> Dim P2 As Double<BR> Dim Q2 As Double<BR> Dim R2 As Double<BR> Dim NN As Integer '投影代号<BR>' A2 = CInt(F2 / 6) * 6 - 3<BR> <BR>' B2 = Int(A2) + (Int(A2 * 100) - Int(A2) * 100) / 60 + (A2 * 10000 - Int(A2 * 100) * 100) / 3600<BR> '把L0化成度(A2)<BR> NN = CInt(F2 / 6) + 1 '投影代号n=[L/6]+1 '<BR> B2 = NN * 6 - 3 '中央经线<BR> 'G2 = F2 - B2 ' L -L0<BR> 'H2 = G2 / 57.2957795130823 '化作弧度<BR> H2 = (F2 - B2) / 57.2957795130823 '将经差的单位化为弧度<BR> i2 = Tan(E2 / 57.2957795130823) 'Tan (B)<BR> J2 = Cos(E2 / 57.2957795130823) ' Cos (B)<BR> K2 = 0.006738525415 * J2 * J2<BR> l2 = i2 * i2<BR> M2 = 1 + K2<BR> n2 = 6399698.9018 / Sqr(M2)<BR> O2 = H2 * H2 * J2 * J2<BR> P2 = i2 * J2<BR> Q2 = P2 * P2<BR> R2 = (32005.78006 + Q2 * (133.92133 + Q2 * 0.7031))<BR> s2 = ((((l2 - 18) * l2 - (58 * l2 - 14) * K2 + 5) * O2 / 20 + M2 - l2) * O2 / 6 + 1) * n2 * (H2 * J2)<BR> <BR> '计算结果,横坐标Y,这里生成的是高斯坐标<BR> s2 = s2 + NN * 1000000 + 500000 '18500000 '在计算的基础上加上了“带号”(18)和“东移”(500KM)<BR> '计算结果,纵坐标X<BR> t2 = 6367558.49686 * E2 / 57.29577951308 - P2 * J2 * R2 + ((((l2 - 58) * l2 + 61) * _<BR> O2 / 30 + (4 * K2 + 5) * M2 - l2) * O2 / 12 + 1) * n2 * i2 * O2 / 2<BR> <BR> Deg2XY = True<BR>End Function</P>
|
|
|
6楼#
发布于:2005-06-16 19:23
<DIV class=quote><B>以下是引用<I>gyhcly</I>在2005-6-15 23:31:59的发言:</B><BR>
<P>版主,菜菜的问一下,为什么回放的时候所有的点都显示在TEMPLATE层上?</P> <P>怎么实现只显示一个点的移动呢?而且回放结束以后,所有的点信息仍然保存在TEMPLATE层上,怎么清空呢?</P></DIV> <P>可以修改playNMEA函数,删除前面的图元 <P>Public Sub playNMEA(sArray As Variant)<BR> '读取存有GPS信息的回放文件<BR> Dim rmc As GPRMC<BR> Dim Utils As New CParseUtils<BR> Dim Sentence As Integer<BR> <BR> Dim mapDest As MapXLib.Map<BR> Dim mobileObj As New MapXLib.Feature<BR> Dim mobileFtr As New MapXLib.Feature<BR> Dim lnFeat As New MapXLib.Feature<BR> Dim FeatFact As MapXLib.FeatureFactory<BR> <BR> Dim GPSPoints As New MapXLib.Points, aPoint As New MapXLib.Point<BR> Dim NewStyle As New Style<BR> <BR> Dim GPSLayerID As Integer<BR> Dim intReg As Integer<BR> Dim DD_X As Double, DD_Y As Double<BR> Dim BJ_X As Double, BJ_Y As Double<BR> <BR> Dim yy As String, mm1 As String, dd As String '年、月、日<BR> Dim hh As String, mm2 As String, ss As String '时、分、秒<BR> <BR> <FONT color=#ff3300>Dim ftrID As Long<BR></FONT> <BR> intReg = 0.00012<BR> <BR> Set mapDest = frmGPS_Disp.mapMain '这里是用于显示地图的表单及控件名<BR> <BR> GPSLayerID = 1 'mapDest.Layers.Count<BR> ftrID = 1 <P> If mapDest.Layers.Count > 1 Then<BR> Set mapDest.Layers.AnimationLayer = mapDest.Layers(GPSLayerID)<BR> Else<BR> MsgBox "没有地图,请先打开地图!"<BR> Exit Sub<BR> End If<BR> <BR> mobileFtr.Attach mapDest<BR> mobileFtr.Type = miFeatureTypeSymbol<BR> <BR> With NewStyle<BR> .SymbolFont.Name = "Mapinfo symbols"<BR> .SymbolCharacter = 50 ';H40 '塔符号0X40,圆形符号0X2F<BR> .SymbolFont.Size = 10 ' 设置符号大小<BR> .SymbolFontRotation = 0<BR> .SymbolFontShadow = False<BR> .SymbolFontHalo = False<BR> .SymbolFontColor = 255 ' 定义为红色...<BR> .SymbolFontBackColor = miColorWhite<BR> End With<BR> mobileFtr.Style = NewStyle<BR> <BR> mobileFtr.Point.Set 0, 0<BR> Set mobileObj = mapDest.Layers(GPSLayerID).AddFeature(mobileFtr)<BR> <BR> For Sentence = 0 To sCnt - 1<BR> If Utils.Parse(sArray(Sentence), 1) = "$GPRMC" Then<BR> Set rmc = New GPRMC<BR> DoEvents<BR> With rmc<BR> .Sentence = sArray(Sentence)<BR> If Not Val(.Longitude) = 0 Then<BR> DD_X = DM2DD(.Longitude)<BR> DD_Y = DM2DD(.Latitude)<BR> frmGPS_Disp.lblX.Caption = "X: " ; Format(DM2DD(.Longitude), "000.0000") ; " " ; .LonHemis<BR> frmGPS_Disp.lblY.Caption = "Y: " ; Format(DM2DD(.Latitude), " 00.0000") ; " " ; .LatHemis<BR> <BR> If bDispType = 1 Then 'bDispType为显示类型,1--单点显示<BR> <FONT color=#ff0000>mapDest.Layers.Item("GPSLayer").DeleteFeature ftrID '清除以前的图元<BR></FONT> End If<BR> <BR> If mapDest.NumericCoordSys.Units = miUnitDegree Then '度<BR> mobileFtr.Point.Set DD_X, DD_Y<BR> Else '米 BJ54坐标系<BR> '经纬度BL换算到高斯平面直角坐标XY(高斯投影正算)<BR> Deg2XY DD_X, DD_Y, BJ_X, BJ_Y<BR> mobileFtr.Point.Set BJ_X, BJ_Y<BR> End If<BR> <BR> Set mobileObj = mapDest.Layers(GPSLayerID).AddFeature(mobileFtr)<BR> ftrID = mobileObj.FeatureID<BR> <BR> 'mapDest.Layers(GPSLayerID).Refresh<BR> <BR> If mobileFtr.Point.X > mapDest.Bounds.XMax - intReg Or _<BR> mobileFtr.Point.X < mapDest.Bounds.XMin + intReg Or _<BR> mobileFtr.Point.Y > mapDest.Bounds.YMax - intReg Or _<BR> mobileFtr.Point.Y < mapDest.Bounds.YMin + intReg Then<BR> <BR> mapDest.CenterX = mobileFtr.Point.X<BR> mapDest.CenterY = mobileFtr.Point.Y<BR> End If<BR> frmGPS_Disp.lblSpeed.Caption = "速度: " ; Val(.Speed) ; " Km/h"<BR> '日期的格式转换: 250503 -> 03/05/25<BR> dd = Mid$(.UTDate, 1, 2)<BR> mm1 = Mid$(.UTDate, 3, 2)<BR> yy = Mid$(.UTDate, 5, 2)<BR> frmGPS_Disp.lblDate.Caption = "日期: " ; Format(yy + mm1 + dd, "00/00/00")<BR> 'UTC时间转换为北京时间<BR> hh = Mid$(.UTC, 1, 2) + 8<BR> mm2 = Mid$(.UTC, 3, 2)<BR> ss = Mid$(.UTC, 5, 2)<BR> frmGPS_Disp.lblUTC.Caption = "时间: " ; Format(hh + mm2 + ss, "00:00:00")<BR> Else<BR> MsgBox "接收卫星太少,不能定位!"<BR> <BR> frmGPS_Disp.lblX.Caption = "X: "<BR> frmGPS_Disp.lblY.Caption = "Y: "<BR> frmGPS_Disp.lblSpeed.Caption = "速度: "<BR> frmGPS_Disp.lblDate.Caption = "日期: "<BR> frmGPS_Disp.lblUTC.Caption = "时间: "<BR> <BR> Exit Sub<BR> End If<BR> End With<BR> End If<BR> Next Sentence<BR> <BR> Set mapDest = Nothing<BR> Set mobileObj = Nothing<BR> Set mobileFtr = Nothing<BR> Set lnFeat = Nothing<BR> Set FeatFact = Nothing<BR> Set GPSPoints = Nothing<BR> Set NewStyle = Nothing<BR>End Sub <P>本程序中,指定了一个名为“<FONT color=#ff0000>GPSLayer</FONT>”临时图层,用于显示GPS点</P> |
|
|
7楼#
发布于:2005-08-14 17:31
<DIV class=quote><B>以下是引用<I>zhgj1728</I>在2005-7-27 9:29:37的发言:</B><BR>老大能不能上传一份测试的图阿,谢谢!</DIV>
<P><a href="attachment/2005-8/200581417301923624.rar">2005-8/200581417301923624.rar</a> <<<<<<上传了测试数据。 </P> <P><a href="http://www.gisempire.com/bbs/dispbbs.asp?boardID=13;ID=42720;page=1" target="_blank" >http://www.gisempire.com/bbs/dispbbs.asp?boardID=13;ID=42720;page=1</A> <P>帖子上有更精减的示例代码和测试数据<BR></P> |
|
|