monitor.frm

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

VERSION 5.00
Object = "{058ADF50-1120-11D0-80D0-0000F73D691E}#1.0#0"; "MAPENGIN.OCX"
Begin VB.Form MonitorForm 
   ClientHeight    =   3960
   ClientLeft      =   1410
   ClientTop       =   1005
   ClientWidth     =   4950
   ControlBox      =   0   'False
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   3960
   ScaleWidth      =   4950
   WindowState     =   2  'Maximized
   Begin MapEngineLib.CompoundMap oCompoundMap 
      Height          =   3255
      Left            =   240
      TabIndex        =   0
      Top             =   360
      Width           =   4455
      _Version        =   65536
      _ExtentX        =   7858
      _ExtentY        =   5741
      _StockProps     =   0
   End
End
Attribute VB_Name = "MonitorForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private m_nLockedID As Integer

Dim m_bCenterPoint As Boolean

Public Sub ReceiveData(ByVal oRecord As CRecord)
    Dim lIndex, lCount As Integer
    Dim oTarget As CTarget
    Dim dbs As Database
    Dim rst As Recordset
    Dim zhou As Integer
    If m_nLockedID = -1 Then
        m_nLockedID = oRecord.nID
    End If
    zhou = oRecord.nID
    
    lIndex = MDIMainForm.oTargetManager.GetIndexByID(oRecord.nID)
    Set oTarget = MDIMainForm.oTargetManager.GetTargetByIndex(lIndex)
    
    Set dbs = DBEngine.Workspaces(0).OpenDatabase(strPath + PATH_DBDATA)
    Set rst = dbs.OpenRecordset("target")
    'rst.Index = "name"
    'rst.Seek "=", zhou  'id
    'Tuili = Trim(rst.Fields("Legend"))
    'Guijituli = Trim(rst.Fields("TraceLegend"))
    
    ClearTarget oTarget
    
    If oTarget.IsShowTrack Then
       DrawTrack oTarget
    End If
    DrawTarget oTarget
    DrawTarget oTarget
End Sub

Public Function GetLockedID() As Long
    GetLockedID = m_nLockedID
End Function
Public Sub SetLockedID(ByVal nID As Integer)
    m_nLockedID = nID 'lock certain object
End Sub
Public Function IsLocked(ByVal nID As Integer) As Boolean
    If nID = m_nLockedID Then
        IsLocked = True
    Else
        IsLocked = False
    End If
End Function

Private Function IsInMap(ByVal fLongitude As Double, ByVal fLatitude As Double) As Boolean
    IsInMap = oCompoundMap.IsPointVisible(fLongitude, fLatitude)
End Function
Private Sub CenterTarget(ByVal oTarget As CTarget)
    fLongitude = oTarget.GetLongitude()
    fLatitude = oTarget.GetLatitude()
    m_bCenterPoint = True
    oCompoundMap.CenterPoint fLongitude, fLatitude
End Sub

Private Sub DrawTrack(ByVal oTarget As CTarget)
    If Not oTarget.IsEnabled Then Exit Sub
    
    Dim fLongitude, fLatitude As Double
    On Error GoTo errhandle
    
    fLongitude = oTarget.GetLongitude()
    fLatitude = oTarget.GetLatitude()
       
    If oTarget.IsShowTrack Then
        oCompoundMap.DrawNode fLongitude, fLatitude, g_oTargetTrackRes.legendOID, 0, True
    End If
errhandle:
    Exit Sub
End Sub

Private Sub ClearTarget(ByVal oTarget As CTarget)
    If Not oTarget.IsEnabled Then Exit Sub
    
    Dim fLongitude, fLatitude As Double
    Dim oRecord As New CRecord
    On Error GoTo errhandle
    Set oRecord = oTarget.GetOldRecord()
    fLongitude = oRecord.fLongitude
    fLatitude = oRecord.fLatitude
    Dim oShapePoint As New ShapePoint
    If IsInMap(fLongitude, fLatitude) Then
        Dim nXPos, nYPos As Double
        oShapePoint.X = fLongitude
        oShapePoint.Y = fLatitude
        oCompoundMap.MapToScreen oShapePoint
        nXPos = oShapePoint.X
        nYPos = oShapePoint.Y
        oCompoundMap.RefreshScreenByRect nXPos - 150, nYPos - 150, nXPos + 150, nYPos + 150
    End If
errhandle:
    Exit Sub
End Sub

Private Sub DrawTarget(ByVal oTarget As CTarget)
    If Not oTarget.IsEnabled Then Exit Sub
    
    Dim fLongitude, fLatitude, fDirection As Double
    Static bFlash As Boolean
    On Error GoTo errhandle
    
    fLongitude = oTarget.GetLongitude()
    fLatitude = oTarget.GetLatitude()
    fDirection = oTarget.GetDirection()
         
    If Not IsInMap(fLongitude, fLatitude) Then
        If IsLocked(oTarget.GetID) Then
            CenterTarget oTarget
        End If
    Else
        oCompoundMap.DrawNode2 fLongitude, fLatitude, g_oTargetRes, 360 - fDirection, False
        'System 是字体名称，若图库中无该字体，无法显示车辆名称
        oCompoundMap.DrawText fLongitude, fLatitude, oTarget.GetName, g_lTargetNameColor, 0, "System", False
        If MDIMainForm.oWorkMode.GetMode = ALERT And oTarget.GetName = BjCl Then
            oCompoundMap.DrawNode2 fLongitude, fLatitude, g_oTargetLockedRes, 0, False
        End If
        If cfAlert = True Then
           oCompoundMap.DrawNode2 fLongitude, fLatitude, g_oTargetLockedRes, 0, False
           cfAlert = False
        End If
    End If
errhandle:
    Exit Sub
End Sub

Private Sub Form_Initialize()
    m_bCenterPoint = False
    m_nLockedID = -1
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 68 And Shift = 2 Then
        DataWindow.Show
    End If
    If KeyCode = 79 And Shift = 2 Then
       'If MDIMainForm.mnu_setting_comm.Visible = False Then
       '     MDIMainForm.mnu_setting_comm.Visible = True
       'Else
       '     MDIMainForm.mnu_setting_comm.Visible = False
       'End If
       Form7.Show
    End If
    'If KeyCode = 90 And Shift = 2 Then
       'If MDIMainForm.mnu_file_openspadb.Visible = False Then
       '     MDIMainForm.mnu_file_openspadb.Visible = True
       'Else
       '     MDIMainForm.mnu_file_openspadb.Visible = False
       'End If
    'End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = Asc("=") Or KeyAscii = Asc("+") Then
        MDIMainForm.mnu_setting_Increase_Click
    End If
    If KeyAscii = Asc("-") Or KeyAscii = Asc("_") Then
        MDIMainForm.mnu_setting_Decrease_Click
    End If
    If KeyAscii = 32 Then
      
      'If MDIMainForm.mnumode_pause.Caption = "暂停" Then
      '  MDIMainForm.mnumode_pause.Caption = "继续"
      '  MDIMainForm.oWorkMode.SetPause True
      'Else
      '  MDIMainForm.mnumode_pause.Caption = "暂停"
      '  MDIMainForm.oWorkMode.SetPause False
      'End If
      MDIMainForm.Init_chuan
    End If
End Sub

Private Sub Form_Load()
    If Not oCompoundMap.ConnectSpaDB(MDIMainForm.oSpaDB.GetHandle) Then
        MsgBox ("连接错误！")
        Unload Me
        Exit Sub
    End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim lCount As Integer
    If UnloadMode = 0 Then
        lCount = 0
        For i = 0 To Forms.Count - 1
            If Forms(i).Name = "MonitorForm" Then
                lCount = lCount + 1
            End If
        Next
        If lCount <= 1 Then
            Cancel = 1
        End If
    End If
End Sub

Private Sub Form_Resize()
    oCompoundMap.top = 0
    oCompoundMap.left = 0
    oCompoundMap.Width = Me.Width
    oCompoundMap.Height = Me.Height
    oCompoundMap.ResetBackground
    oCompoundMap.RefreshScreen
    oCompoundMap.Redraw
End Sub

Private Sub Form_Unload(Cancel As Integer)
    oCompoundMap.Save
End Sub

Private Sub oCompoundMap_AddEntity(ByVal entityOID As Long, ByVal lpszTableName As String, ByVal lpszOIDField As String)
Dim dbs As Database
    Dim rst As Recordset
    Dim num As String
    Dim oLayerConfig As LayerConfig
    Dim i As Integer
     
   On Error Resume Next
   Set oLayerConfig = oCompoundMap.LayerConfigs("宁波电话号码")
    If Not oLayerConfig.IsValid Then
       
       Exit Sub
   End If
     If Not oLayerConfig.Visible Then
         oLayerConfig.Visible = True
     End If
    num = InputBox("请输入用户号码", "提示", "    ")
    If num = "" Then
        Exit Sub
    End If
     Set dbs = DBEngine.Workspaces(0).OpenDatabase(strPath + "tel.mdb")
     Set rst = dbs.OpenRecordset("tel")
     rst.Index = "alerttel"
     rst.Seek "=", num
     If Not rst.NoMatch Then
         rst.Edit
         rst!oid = entityOID
         rst.Update
     Else
        'Editflag = 0
        'FindYH = num
        'map = entityOID
        'userinfo1.Show
        'MsgBox "库中无此用户", vbInformation, "提示"
        rst.AddNew
        rst!alerttel = num
        rst!oid = entityOID
        rst.Update
     End If
        
    
End Sub


Private Sub oCompoundMap_DelEntity(ByVal entityOID As Long, ByVal lpszTableName As String, ByVal lpszOIDField As String)
    Dim dbs As Database
    Dim rst As Recordset
        
    If lpszTableName = "" Or lpszOIDField = "" Then
        Exit Sub
    End If
    
    Set dbs = DBEngine.Workspaces(0).OpenDatabase(oSpaDB.DBSourceName)
    Set rst = dbs.OpenRecordset(lpszTableName, dbOpenDynaset)
    rst.FindFirst lpszOIDField & "=" & entityOID
    If Not rst.NoMatch Then
        rst.Delete
    End If
    
    rst.Close
    dbs.Close
End Sub

Private Sub oCompoundMap_LButtonDown(ByVal nFlag As Long, ByVal nXPos As Long, ByVal nYPos As Long)
    If g_Oper <> meDoSelect Then Exit Sub
    Dim oShapePoint As New ShapePoint
    oShapePoint.X = nXPos
    oShapePoint.Y = nYPos
    
    Dim lTargetID As Long
    lTargetID = MDIMainForm.oTargetManager.GetIDByPosition(oShapePoint)
    If lTargetID = 0 Then Exit Sub
    If Not frmTarget.FindByID(lTargetID) Then Exit Sub
    frmTarget.Show
End Sub

Private Sub oCompoundMap_RButtonUp(ByVal nFlag As Long, ByVal nXPos As Long, ByVal nYPos As Long)
''If Qcd = False Then
''    If m_Mode = 6 Then
''        MDIMainForm.PopupMenu MDIMainForm.cd
''    Else
''        MDIMainForm.PopupMenu MDIMainForm.dc
''    End If
''End If
End Sub

Private Sub oCompoundMap_RedrawScreen(ByVal left As Long, ByVal top As Long, ByVal right As Long, ByVal bottom As Long)
    Dim i, lCount As Integer
    Dim oTarget As New CTarget
    If m_bCenterPoint Then
        m_bCenterPoint = False
        Exit Sub
    End If
    lCount = MDIMainForm.oTargetManager.GetCount
    For i = 1 To lCount
        Set oTarget = MDIMainForm.oTargetManager.GetTargetByIndex(i)
        DrawTarget oTarget
    Next
End Sub

Private Sub oCompoundmap_RedrawScreenBuffer(ByVal llx As Double, ByVal lly As Double, ByVal urx As Double, ByVal ury As Double)
    Dim lCount, i As Integer
    Dim oTarget As New CTarget
    lCount = MDIMainForm.oTargetManager.GetCount
    For i = 1 To lCount
        Set oTarget = MDIMainForm.oTargetManager.GetTargetByIndex(i)
        If oTarget.IsShowTrack Then
            If oTarget.IsEnabled Then
                oCompoundMap.DrawLineNode oTarget.GetTrackLine, g_oTargetTrackRes.legendOID, True
            End If
        End If
    Next
End Sub

Private Sub oCompoundmap_MouseMove(ByVal nFlag As Long, ByVal nXPos As Long, ByVal nYPos As Long)
    If Not MDIMainForm.mnuOption_MousePosition.Checked Then Exit Sub
    Dim oShapePoint As New ShapePoint
    oShapePoint.X = nXPos
    oShapePoint.Y = nYPos
    oCompoundMap.ScreenToMap oShapePoint
    
    MDIMainForm.StatusBar1.Panels(4).Text = "经度：" + Format(oShapePoint.X, "##.######") + "  纬度：" + Format(oShapePoint.Y, "##.######")
    Set oShapePoint = Nothing
End Sub

Public Function OpenCompoundmap(ByVal strCMPName As String) As Integer
'strCMPName 期望打开的复合图名称
'if strCMPName="" then 选择打开；
' bCanCancel：是否可以取消打开操作，strCMPName=""时起作用
    Dim oEmCmpName As StringArray
    Dim i As Integer
    Dim oLegend As Legend
    Dim lLayerIndex As Long
    Dim strSelCMPName As String
    
    If strCMPName = "" Then
        Set oEmCmpName = MDIMainForm.oSpaDB.CompoundMaps.Names
        Select Case oEmCmpName.Count
            Case 0
                OpenCompoundmap = OPENCMP_NONECMP
                Ini_SaveDefaultCMPName ""
                Exit Function
            Case 1
                strSelCMPName = oEmCmpName(0)
            Case Else
                Load SelCompoundMap
                For i = 0 To oEmCmpName.Count - 1
                    SelCompoundMap.lstCMPName.AddItem oEmCmpName(i)
                Next
                SelCompoundMap.Show
                If glb_strSelCMPName = "" Then
                    OpenCompoundmap = OPENCMP_CANCEL
                    Exit Function
                End If
                strSelCMPName = glb_strSelCMPName
        End Select
    Else
        strSelCMPName = strCMPName
    End If
    If oCompoundMap.IsModified Then
        oCompoundMap.Save
    End If
    If Not oCompoundMap.Open(strSelCMPName) Then
        OpenCompoundmap = OPENCMP_OPENCMPERROR
        Ini_SaveDefaultCMPName ""
        Exit Function
    End If
    oCompoundMap.LoadAllImage
    oCompoundMap.Redraw

'----------保存最近打开的复合图名-----
    Ini_SaveDefaultCMPName strSelCMPName
    
'----------当前点实体图例-------
    
    OpenCompoundmap = OPENCMP_SUCCESS
End Function

Private Sub oCompoundMap_SelEntity(ByVal entityOID As Long, ByVal lpszTableName As String, ByVal lpszOIDField As String)
    If lpszTableName = "" Or lpszOIDField = "" Then
        Exit Sub
    End If
    
    If IsLoaded("frmPropertyWindow") Then
        'frmPropertyWindow.Show
    End If
    'frmPropertyWindow.ShowCurrentEntity entityOID, lpszTableName, lpszOIDField
End Sub

Public Function SetFocusEntity(ByVal lEntityOID As Long)
    Dim oFocus As New OIDArray
    oFocus.Add lEntityOID
    Set oCompoundMap.Focus = oFocus
    oCompoundMap.CenterEntity (lEntityOID)
End Function