mgpslocation.bas

都是基于VB所做的程序集合,值得大家作为实践的参考资料.

Attribute VB_Name = "mGPSLocation"
'=======================================================================================================
'  自定义模块：获取随机的x,y的坐标，在supermap.trackinglayer上定位
'  接口说明:
'            1、属性dst,用来接受数据集对象，通过dst获取数据集的Bounds,然后控制点实例的运动范围；
'            2、方法CoordinateX()得到每一个点实例要移动到的位置X随机坐标；
'            3、方法CoordinateY()得到每一个点实例要移动到的位置Y随机坐标；
'            4、方法Location(soPoints,SuperMap)通过调用CoordinateX()和CoordinateY()重新定位每一个点实例。
'
'  注意:  修改Scl的值可以调整每点移动的幅度
'=======================================================================================================

Private Const Scl As Integer = 20   ' 位移的间距
Private objCurPoint As soPoint
Private i As Integer
Public objDataset As soDataset

' 定位：x，x坐标； y，y坐标； SpMap， 定位对象
Public Sub Location(CurPoints As soPoints, SpMap As SuperMap)
    Dim objCurPoint As soPoint
    Dim objstyle As New soStyle

    i = 1
    objstyle.PenColor = vbBlue
    objstyle.SymbolSize = 50
    objstyle.SymbolStyle = 2
    For Each objCurPoint In CurPoints
        objCurPoint.x = x
        objCurPoint.y = y

        '调整点的位置，确保它在图层之内
        If objCurPoint.x < SpMap.ViewBounds.Left Then SpMap.Pan2 objCurPoint.x - SpMap.ViewBounds.CenterPoint.x, 0       '出左边界
        If objCurPoint.x > SpMap.ViewBounds.Right Then SpMap.Pan2 objCurPoint.x - SpMap.ViewBounds.CenterPoint.x, 0      '出右边届
        If objCurPoint.y > SpMap.ViewBounds.Top Then SpMap.Pan2 0, objCurPoint.y - SpMap.ViewBounds.CenterPoint.y        '出上边界
        If objCurPoint.y < SpMap.ViewBounds.Bottom Then SpMap.Pan2 0, objCurPoint.y - SpMap.ViewBounds.CenterPoint.y     '出下边界
        '通过moveto()方法重新定位每一个点实例
        SpMap.TrackingLayer.Event(i).MoveTo CoordinateX(), CoordinateY()
        i = i + 1
    Next objCurPoint
    SpMap.TrackingLayer.Refresh
End Sub

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

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

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