target.cls

GPS车辆监控,vb代码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "CTarget"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private m_nID As Long '监控目标码
Private m_strName As String '监控目标名称
Private m_strCommID As String '通讯码

Private m_oRecord As New CRecord '当前记录
Private m_oOldRecord As New CRecord '前一次记录
Private m_oLine As New ShapeLine '轨迹线

'经过过滤处理的数据
Private m_oFilterRecord As New CRecord '当前记录
Private m_oFilterOldRecord As New CRecord '前一次记录
Private m_oFilterLine As New ShapeLine '轨迹线
'经过过滤处理的数据

Private m_nFilterMode As Integer
'是否采用数据过滤,0:不过滤；1：依据前后两点过滤掉出界的数据；2：根据历史记录计算方向；3：=1+2
'4：锁定到路网；5：=4+1；6：=4+2；7：=4+2+1；8：过滤掉出界的数据；16：
Private m_lMaxStepDistance As Long
Private m_lMinStepDistance As Long
Private m_fLlx As Double
Private m_fLly As Double
Private m_fUrx As Double
Private m_fUry As Double
Private m_strRoadLayer As String
Private m_lLockedLine As Long

Private m_bShowTrack As Boolean '是否显示轨迹
 
Private m_bEnabled As Boolean
Private m_tRecieveTime As Date

Public Sub SetEnabled(ByVal bEnabled As Boolean)
    m_bEnabled = bEnabled
End Sub
Public Function IsEnabled() As Boolean
    IsEnabled = m_bEnabled
End Function
Public Sub CheckEnable()
    '30秒超时
    If (Now - m_tRecieveTime) * 24 * 60 * 60 > 30 Then
        m_bEnabled = False
    End If
End Sub


Public Function SetFilterMode(ByVal nMode As Integer)
    If m_nFilterMode = nMode Then Exit Function
    m_nFilterMode = nMode
    
    RefreshFilterData
End Function
Public Function GetFilterMode() As Integer
    GetFilterMode = m_nFilterMode
End Function
Public Function GetMaxStepDistance() As Long
    GetMaxStepDistance = m_lMaxStepDistance
End Function
Public Function SetMaxStepDistance(ByVal lMaxStepDistance As Long)
    m_lMaxStepDistance = lMaxStepDistance
End Function
Public Function GetMinStepDistance() As Long
    GetMinStepDistance = m_lMinStepDistance
End Function
Public Function SetMinStepDistance(ByVal lMinStepDistance As Long)
    m_lMinStepDistance = lMinStepDistance
End Function
Public Function GetLlx() As Double
    GetLlx = m_fLlx
End Function
Public Function SetLlx(ByVal fLlx As Double)
    m_fLlx = fLlx
End Function
Public Function GetLly() As Double
    GetLly = m_fLly
End Function
Public Function SetLly(ByVal fLly As Double)
    m_fLly = fLly
End Function
Public Function GetUrx() As Double
    GetUrx = m_fUrx
End Function
Public Function SetUrx(ByVal fUrx As Double)
    m_fUrx = fUrx
End Function
Public Function GetUry() As Double
    GetUry = m_fUry
End Function
Public Function SetUry(ByVal fUry As Double)
    m_fUry = fUry
End Function
Public Function GetRoadLayer() As String
    GetRoadLayer = m_strRoadLayer
End Function
Public Function SetRoadLayer(ByVal strRoadLayer As String)
    m_strRoadLayer = strRoadLayer
End Function

Public Function GetRecord() As CRecord
    If m_nFilterMode = 0 Then
        Set GetRecord = m_oRecord
    Else
        Set GetRecord = m_oFilterRecord
    End If
End Function
Public Function GetOldRecord() As CRecord
    If m_nFilterMode = 0 Then
        Set GetOldRecord = m_oOldRecord
    Else
        Set GetOldRecord = m_oFilterOldRecord
    End If
End Function
Public Function GetLongitude() As Double
    If m_nFilterMode = 0 Then
        GetLongitude = m_oRecord.fLongitude
    Else
        GetLongitude = m_oFilterRecord.fLongitude
    End If
End Function
Public Function GetLatitude() As Double
    If m_nFilterMode = 0 Then
        GetLatitude = m_oRecord.fLatitude
    Else
        GetLatitude = m_oFilterRecord.fLatitude
    End If
End Function
Public Function GetSpeed() As Double
    If m_nFilterMode = 0 Then
        GetSpeed = m_oRecord.fSpeed
    Else
        GetSpeed = m_oFilterRecord.fSpeed
    End If
End Function
Public Function GetDirection() As Double
    If m_nFilterMode = 0 Then
        GetDirection = m_oRecord.fDirection
    Else
        GetDirection = m_oFilterRecord.fDirection
    End If
End Function

Public Function GetID() As Long
    GetID = m_nID
End Function
Public Sub SetID(nID As Long)
    m_nID = nID
End Sub
Public Function GetCommID() As String
    GetCommID = m_strCommID
End Function
Public Sub SetCommID(ByVal strCommID As String)
    m_strCommID = strCommID
End Sub
Public Function GetName() As String
    GetName = m_strName
End Function
Public Function SetName(ByVal strName As String)
   m_strName = strName
End Function

Public Function IsShowTrack() As Boolean
    IsShowTrack = m_bShowTrack
End Function
Public Sub SetShowTrack(ByVal bShowTrack As Boolean)
    m_bShowTrack = bShowTrack
End Sub

Public Function GetTrackLine() As ShapeLine
    If m_nFilterMode = 0 Then
        Set GetTrackLine = m_oLine
    Else
        Set GetTrackLine = m_oFilterLine
    End If
End Function
Public Sub SetTrackLine(oLine As ShapeLine)
    Set m_oLine = oLine
End Sub
Public Sub ClearTrack()
    m_oLine.RemoveAll
    m_oFilterLine.RemoveAll
End Sub
Private Sub AddTrackNode(ByVal oRecord As CRecord)
    m_oLine.Add oRecord.fLongitude, oRecord.fLatitude
End Sub
Private Sub AddFilterTrackNode(ByVal oRecord As CRecord)
    m_oFilterLine.Add oRecord.fLongitude, oRecord.fLatitude
End Sub

Public Function HotTest(ByVal oShapePoint As ShapePoint) As Boolean
    Dim oThisShapePoint As New ShapePoint

    If IsEnabled Then
        oThisShapePoint.X = m_oRecord.fLongitude
        oThisShapePoint.Y = m_oRecord.fLatitude
        MonitorForm.oCompoundMap.MapToScreen oThisShapePoint
        
        If Abs(oShapePoint.X - oThisShapePoint.X) < 10 And Abs(oShapePoint.Y - oThisShapePoint.Y) < 10 Then
            HotTest = True
        End If
    End If
End Function

Public Sub ReceiveData(ByVal oRecord As CRecord)
    m_tRecieveTime = Now
    m_oOldRecord.CopyRecord m_oRecord
    m_oRecord.CopyRecord oRecord
    AddTrackNode oRecord
    
    Dim oFilterRecord As New CRecord
    If m_nFilterMode <> 0 Then
        If GetFilterRecord(oRecord, m_oLine, oFilterRecord) Then
            m_oFilterOldRecord.CopyRecord m_oFilterRecord
            m_oFilterRecord.CopyRecord oFilterRecord
            AddFilterTrackNode oFilterRecord
        End If
    End If
End Sub

Private Function GetFilterRecord(ByVal oRecord As CRecord, _
                                ByVal oLine As ShapeLine, _
                                ByRef oResultRecord As CRecord) As Boolean
    Dim oFilterRecord As New CRecord
    
    oFilterRecord.CopyRecord oRecord
    
    '依据前后两点过滤掉出界的数据；
    Dim fDistance As Double
    If m_nFilterMode Mod 2 = 1 Then
        If oLine.Count > 1 Then
            fDistance = Distance(oLine.X(oLine.Count - 2), oLine.Y(oLine.Count - 2), oRecord.fLongitude, oRecord.fLatitude)
            If fDistance <= m_lMinStepDistance Or fDistance >= m_lMaxStepDistance Or fDistance = -1 Then
                Set oResultRecord = Nothing
                Exit Function
            End If
        End If
    End If
    
    '根据历史记录计算方向；
    Dim fAngle As Double
    If m_nFilterMode Mod 4 >= 2 Then
        If Angle(oLine.X(oLine.Count - 2), oLine.Y(oLine.Count - 2), oRecord.fLongitude, oRecord.fLatitude, fAngle) Then
            oFilterRecord.fDirection = -fAngle + 90
        Else
            oFilterRecord.fDirection = m_oFilterOldRecord.fDirection
        End If
    End If
    
    '锁定到路网
    If m_nFilterMode Mod 8 >= 4 Then
        Dim oMapLayer As MapLayer
        Dim oShapePoint As New ShapePoint
        Dim oShapeLine As New ShapeLine
        oShapePoint.X = oRecord.fLongitude
        oShapePoint.Y = oRecord.fLatitude
        Dim oEntity As Entity
        Set oMapLayer = MDIMainForm.oSpaDB.MapLayers(m_strRoadLayer)
        Set oEntity = MDIMainForm.oSpaDB.Entities(0)
        If oMapLayer.IsValid Then
            If oEntity.Load(m_lLockedLine) Then
                If oEntity.DistanceToShape(oShapePoint) > 100 Then
                    Set oEntity = oMapLayer.SelectNearest(oShapePoint, meShapeLine)
                End If
            Else
                Set oEntity = oMapLayer.SelectNearest(oShapePoint, meShapeLine)
            End If
            If oEntity.IsValid Then
                m_lLockedLine = oEntity.GetOID
                Set oShapeLine = oEntity.Shape
                Set oShapePoint = oShapeLine.ClosestPoint(oShapePoint.X, oShapePoint.Y)
                oFilterRecord.fLongitude = oShapePoint.X
                oFilterRecord.fLatitude = oShapePoint.Y
            End If
        End If
    End If
    
    '过滤掉出界的数据
    If m_nFilterMode Mod 16 >= 8 Then
        If oRecord.fLongitude < m_fLlx Or oRecord.fLongitude > m_fUrx Or oRecord.fLatitude < m_fLly Or oRecord.fLatitude > m_fUry Then
            Set oResultRecord = Nothing
            Exit Function
        End If
    End If
    Set oResultRecord = oFilterRecord
    GetFilterRecord = True
End Function

Private Function RefreshFilterData()
    Dim oRecord As New CRecord
    Dim oResultRecord As New CRecord
    Dim oLine As New ShapeLine
    m_oFilterLine.RemoveAll
    Dim i As Long
    For i = 0 To m_oLine.Count - 1
        oRecord.fLongitude = m_oLine.X(i)
        oRecord.fLatitude = m_oLine.Y(i)
        If GetFilterRecord(oRecord, oLine, oResultRecord) Then
            m_oFilterLine.Add oResultRecord.fLongitude, oResultRecord.fLatitude
        End If
        oLine.Add m_oLine.X(i), m_oLine.Y(i)
    Next
End Function

Private Sub Class_Initialize()
    m_nFilterMode = 0
    m_lMaxStepDistance = 1000
End Sub
Private Sub Class_Terminate()
    Set m_oRecord = Nothing
    Set m_oOldRecord = Nothing

    Set m_oFilterRecord = Nothing
    Set m_oFilterOldRecord = Nothing
End Sub