mgpslocation.bas

gps and supermap VB编程方法

Attribute VB_Name = "mGPSLocation"
'===================================================================
'  自定义模块:获取随机的x,y的坐标，在supermap.trackinglayer上定位
'
'      注 意: 修改Scl的值可以调整每两点之间的间距
'===================================================================

Private Const Scl As Integer = 3  ' 位移的间距

' 定位：x，x坐标； y，y坐标； SpMap， 定位对象
Public Sub Location(x As Double, y As Double, SpMap As SuperMap)
    SpMap.TrackingLayer.ClearEvents
    
    Dim objpnt As New soGeoPoint
    Dim objstyle As New soStyle
    
    objpnt.x = x
    objpnt.y = y
    
    '跟踪点的特性设置
    With objstyle
        .PenColor = 255
        .SymbolSize = 50
        .SymbolStyle = 1
    End With
    '调整点的位置，确保它在图层之内
    If objpnt.x < SpMap.ViewBounds.Left Then objpnt.x = SpMap.ViewBounds.Left       '出左边界
    If objpnt.x > SpMap.ViewBounds.Right Then objpnt.x = SpMap.ViewBounds.Right     '出右边届
    If objpnt.y > SpMap.ViewBounds.Top Then objpnt.y = SpMap.ViewBounds.Top         '出上边界
    If objpnt.y < SpMap.ViewBounds.Bottom Then objpnt.y = SpMap.ViewBounds.Bottom   '出下边界
    
    SpMap.TrackingLayer.AddEvent objpnt, objstyle, ""   '跟踪
    SpMap.TrackingLayer.Refresh       '刷新

    Set objpnt = Nothing
    Set objstyle = Nothing
End Sub

' 获取随机x坐标
Public Function CoordinateX(objdst As soDataset, SpMap As SuperMap) As Double
    Static midd1
    Dim dLeft As Double
    Dim dRight As Double
    Dim i As Integer
    
    i = 1 + Int(2 * Rnd)                                              ' x轴方向的随机数据获取

    dLeft = objdst.Bounds.Left
    dRight = objdst.Bounds.Right
    If i = 1 Then CoordinateX = midd1 + ((dRight - dLeft) / Scl) * Rnd  ' x轴方向加操作
    If i = 2 Then CoordinateX = midd1 - ((dRight - dLeft) / Scl) * Rnd  ' x轴方向减操作
    If CoordinateX > dRight Then CoordinateX = dRight
    If CoordinateX < dLeft Then CoordinateX = dLeft
    midd1 = CoordinateX
End Function

' 获取随机y坐标
Public Function CoordinateY(objdst As soDataset, SpMap As SuperMap) As Double
    Static midd
    Dim dTop As Double
    Dim dBottom As Double
    Dim i As Integer
    
    i = 1 + Int(2 * Rnd)                                            ' y轴方向的随机据获取
    dTop = objdst.Bounds.Top
    dBottom = objdst.Bounds.Bottom
    If i = 1 Then CoordinateY = midd + ((dBottom - dTop) / Scl) * Rnd  ' y轴方向加操作
    If i = 2 Then CoordinateY = midd - ((dBottom - dTop) / Scl) * Rnd  ' y轴方向减操作
    If CoordinateY > dTop Then CoordinateY = dTop
    If CoordinateY < dBottom Then CoordinateY = dBottom
    midd = CoordinateY
End Function