taman.cls

gps 源码 vb+access 其他地方很难找到 很详细的说明

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CTargetManager"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private m_oTargets() As New CTarget 'base 1
Private m_lCount As Integer

'增加新车
Public Sub AddTarget(ByVal oTarget As CTarget)
    m_lCount = m_lCount + 1
    ReDim Preserve m_oTargets(m_lCount) As New CTarget
    With m_oTargets(m_lCount)
        .SetID oTarget.GetID
        .SetCommID oTarget.GetCommID
        .SetName oTarget.GetName
        .SetShowTrack oTarget.IsShowTrack
        .SetTrackLine oTarget.GetTrackLine
    End With
    
End Sub
'得到车辆的数目
Public Function GetCount() As Integer
    GetCount = m_lCount
End Function

'通过车辆的索引号得到车辆实体
Public Function GetTargetByIndex(ByVal lIndex As Integer) As CTarget
    Set GetTargetByIndex = m_oTargets(lIndex)
End Function

'如果GetIndexBy=0,则表示车辆号无效
Public Function GetIndexByID(ByVal nID As Long) As Integer
    Dim i As Integer
    GetIndexByID = 0
    For i = 1 To m_lCount
        If m_oTargets(i).GetID = nID Then
            GetIndexByID = i
            Exit For
        End If
    Next
End Function
Public Function GetIndexByCommID(ByVal strCommID As String) As Integer
    Dim i As Integer
    GetIndexByCommID = 0
    For i = 1 To m_lCount
        If m_oTargets(i).GetCommID = strCommID Then
            GetIndexByCommID = i
            Exit For
        End If
    Next
End Function

Public Function GetIndexByName(ByVal strName As String) As Integer
    Dim i As Integer
    If Len(strName) = 1 Then strName = "00" & strName
    If Len(strName) = 2 Then strName = "0" & strName
    NumberCar = strName
    GetIndexByName = 0
    For i = 1 To m_lCount
        If m_oTargets(i).GetName = strName Then
            GetIndexByName = i
            Exit For
        End If
    Next
End Function

Public Sub ReceiveData(ByVal oRecord As CRecord)
    Dim i As Integer
    For i = 1 To m_lCount
        If m_oTargets(i).GetID = oRecord.nID Then
            m_oTargets(i).ReceiveData oRecord
            If Not m_oTargets(i).IsEnabled Then
                m_oTargets(i).SetEnabled True
            End If
            Exit For
        End If
    Next
End Sub

Public Sub ClearTrack()
    Dim i As Integer
    For i = 1 To m_lCount
        m_oTargets(i).ClearTrack
    Next
End Sub

Public Function GetIDByPosition(ByVal oShapePoint As ShapePoint) As Long
    Dim i As Integer
    For i = 1 To m_lCount
        If m_oTargets(i).HotTest(oShapePoint) Then
            GetIDByPosition = m_oTargets(i).GetID
            Exit Function
        End If
    Next
End Function

Public Sub Refresh()
    
    Dim dbs As Database
    Dim rst As Recordset
    Dim oTarget As CTarget
    Dim oShapeLine As ShapeLine
    
    Dim lIndex As Long
    Set dbs = DBEngine.Workspaces(0).OpenDatabase(strPath + PATH_DBDATA)
    Set rst = dbs.OpenRecordset("Target", dbOpenDynaset)
    If Not rst.EOF() Then
        rst.MoveFirst
        Do While Not rst.EOF()
            If Not (IsNull(rst!ID) Or IsNull(rst!CommID) Or IsNull(rst!Name)) Then
                lIndex = GetIndexByID(rst!ID)
                Set oTarget = GetTargetByIndex(lIndex)
                oTarget.SetID (rst!ID)
                oTarget.SetCommID (rst!CommID)
                oTarget.SetName (rst!Name)
                If Not IsNull(rst!Track) Then
                    oTarget.SetShowTrack (rst!Track)
                End If
            End If
            rst.MoveNext
        Loop
    End If
    
    rst.Close
    dbs.Close

End Sub

Public Sub Rebuild()
    
    Dim dbs As Database
    Dim rst As Recordset
    Dim oTarget As New CTarget
    Dim oShapeLine As ShapeLine
    
    m_lCount = 0
    ReDim m_oTargets(m_lCount) As New CTarget
    
    Set dbs = DBEngine.Workspaces(0).OpenDatabase(strPath + PATH_DBDATA)
    Set rst = dbs.OpenRecordset("Target", dbOpenDynaset)
    If Not rst.EOF() Then
        rst.MoveFirst
        Do While Not rst.EOF()
            If Not (IsNull(rst!ID) Or IsNull(rst!CommID) Or IsNull(rst!Name)) Then
                oTarget.SetID (rst!ID)
                oTarget.SetCommID (rst!CommID)
                oTarget.SetName (rst!Name)
                If Not IsNull(rst!Track) Then
                    oTarget.SetShowTrack (rst!Track)
                End If
                Set oShapeLine = New ShapeLine
                oTarget.SetTrackLine oShapeLine
                AddTarget oTarget
            End If
            rst.MoveNext
        Loop
    End If
    
    rst.Close
    dbs.Close

End Sub

Private Sub Class_Initialize()
    m_lCount = 0
End Sub

Private Sub Class_Terminate()
    Dim i As Integer
    For i = 1 To m_lCount
        Set m_oTargets(i) = Nothing
    Next
End Sub