物探论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

查看: 945|回复: 0

VB+MAPX+GPS常用模块的主要代码分析 (

[复制链接]
发表于 2013-3-13 20:43:42 | 显示全部楼层 |阅读模式
一:鹰眼图模块
Public Sub Nav_Map(mainMap As Map, navMap As Map)
      Dim ftr  As MapXLib.Feature
Dim ftrs             As MapXLib.Features
      Dim rctMap      As MapXLib.Rectangle
      Dim pnts           As New MapXLib.Points
      Dim pnt1           As New MapXLib.Point
      Dim pnt2           As New MapXLib.Point
      Dim pnt3           As New MapXLib.Point
      Dim pnt4           As New MapXLib.Point
      Dim styLine      As New MapXLib.Style

      If navMap.Geoset = "" Then Exit Sub        '鹰眼图层不存在则退出处理

      Set rctMap = mainMap.Bounds                  '获得主地图的视野范围

      '设置视野范围的是个点
      pnt1.Set rctMap.XMin, rctMap.YMax      
      pnt2.Set rctMap.XMax, rctMap.YMax
      pnt3.Set rctMap.XMax, rctMap.YMin
      pnt4.Set rctMap.XMin, rctMap.YMin

      '将视野范围的是个点添加到点集合
      pnts.Add pnt1
      pnts.Add pnt2
      pnts.Add pnt3
      pnts.Add pnt4
      pnts.Add pnt1

      styLine.LineColor = vbRed    '设置线的颜色
      styLine.LineWidth = 1            '线的粗细

      ' navMap.Layers.Item("鹰眼").BeginAccess miAccessReadWrite
      Set ftrs = navMap.Layers.Item("鹰眼").AllFeatures   '获得鹰眼图层的所有图元
      For Each ftr In ftrs
            navMap.Layers.Item("鹰眼").DeleteFeature ftr     '删除鹰眼图层中的图元
      Next

      Set ftr = navMap.FeatureFactory.CreateLine(pnts, styLine)   '创建线图元
      navMap.Layers.Item("鹰眼").AddFeature ftr                            '将创建的线图元添加到鹰眼图层中
      ' navMap.Layers.Item("鹰眼").EndAccess

End Sub

二、距离测量模块:
Public Function Ruler_Length(pnts As MapXLib.Points, uUnit As Integer) As Double
      Dim i  As Integer
Dim x1               As Double
      Dim y1               As Double
      Dim X2              As Double
      Dim Y2              As Double
      Dim Dis             As Double
      Dim DisSum     As Double

      frmMain.mapMain.MapUnit = miUnitKilometer  '将地图单位设为公里(当然别的单位也是可以的)

      '循环所有的点计算所有点的总距离
      For i = 1 To pnts.Count - 1
          x1 = pnts.Item(i).x
          y1 = pnts.Item(i).y
          X2 = pnts.Item(i + 1).x
          Y2 = pnts.Item(i + 1).y
          Dis = frmMain.mapMain.Distance(x1, y1, X2, Y2)   '计算两点之间的距离
          DisSum = DisSum + Dis
      Next

      frmMain.mapMain.MapUnit = uUnit   '恢复地图单位

      Ruler_Length = DisSum

End Function
三、GPS数据分析
GPS数据分析:(RMC)格式;其它格式类似:
Public Function CheckGPSData(ByVal str_Rev As String) As Boolean
Dim str1 As String
    Dim str2 As String
    Dim i As Integer
    Dim qian As Integer
    Dim hou As Integer
    Dim temp As Integer

    str1 = str_Rev  'GPS数据字符串
    i = InStr(1, str1, "*")  '查找"*"出现的位置
    If i <= 0 Then Exit Function

    str2 = Mid$(str1, 2, i - 2)  '截取要校验的数据字符串
    qian = Asc(Mid$(str2, 1, 1))  '读取第一个字符并转换位 ASCII 值

    '将数据字符串中的每个字符进行异或运算
    For i = 1 To Len(str2) - 1
        hou = Asc(Mid$(str2, i + 1, 1))
        temp = qian Xor hou
        qian = temp
    Next i

    str2 = Right(str1, 2)  '截取校数
    temp = Val("&H" & str2)

    '将异或后的值与校验值进行比较相等则数据正确
    If temp = qian Then  
        CheckGPSData = True
    Else
        CheckGPSData = False
    End If

End Function
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|Archiver|手机版|小黑屋|物探论坛 ( 鄂ICP备12002012号 微信号:iwutan )

GMT+8, 2024-5-13 10:05 , Processed in 0.123994 second(s), 15 queries .

Powered by Discuz! X3.4

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表