mdimain.frm

GPS卫星定位系统相关源代码

      End
      Begin VB.Menu mnu_replay_reverse 
         Caption         =   "反向"
      End
      Begin VB.Menu mnu_replay_s1 
         Caption         =   "-"
      End
      Begin VB.Menu mnu_replay_openfile 
         Caption         =   "重放配置..."
      End
   End
   Begin VB.Menu tel 
      Caption         =   "&T电话号码"
      Visible         =   0   'False
      Begin VB.Menu Findtel 
         Caption         =   "查询"
      End
      Begin VB.Menu Addtel 
         Caption         =   "添加"
      End
      Begin VB.Menu Deltel 
         Caption         =   "删除"
      End
      Begin VB.Menu Hidetel 
         Caption         =   "屏蔽"
      End
   End
   Begin VB.Menu mnu_display 
      Caption         =   "&V显示"
      Begin VB.Menu mnu_display_Query 
         Caption         =   "查询"
         Shortcut        =   {F3}
      End
      Begin VB.Menu mnu_display_s3 
         Caption         =   "-"
      End
      Begin VB.Menu mnu_display_zoomin 
         Caption         =   "放大"
      End
      Begin VB.Menu mnu_display_zoomout 
         Caption         =   "缩小"
      End
      Begin VB.Menu mnu_display_pane 
         Caption         =   "漫游"
      End
      Begin VB.Menu mnu_display_redraw 
         Caption         =   "重画"
      End
      Begin VB.Menu mnu_display_wholemap 
         Caption         =   "全图"
      End
      Begin VB.Menu mnu_display_s1 
         Caption         =   "-"
      End
      Begin VB.Menu mnu_display_layerconfig 
         Caption         =   "图层配置..."
      End
      Begin VB.Menu mnu_display_s2 
         Caption         =   "-"
      End
      Begin VB.Menu mnu_display_trackclear 
         Caption         =   "清除轨迹"
      End
      Begin VB.Menu mnu_display_target 
         Caption         =   "车辆显示设置..."
         Shortcut        =   {F8}
      End
      Begin VB.Menu mnu_display_s6 
         Caption         =   "-"
      End
      Begin VB.Menu Long 
         Caption         =   "求长度"
      End
   End
   Begin VB.Menu mnu_setting 
      Caption         =   "&S设置"
      Begin VB.Menu systeminformation 
         Caption         =   "设置系统参数..."
         Shortcut        =   ^{F1}
      End
      Begin VB.Menu mnu_setting_comm 
         Caption         =   "串口设置..."
         Visible         =   0   'False
      End
      Begin VB.Menu mnu_setting_targetdb 
         Caption         =   "车辆数据..."
      End
      Begin VB.Menu mnu_setting_AlertLayer 
         Caption         =   "设置报警图层..."
         Visible         =   0   'False
      End
      Begin VB.Menu mnu_setting_s1 
         Caption         =   "-"
      End
      Begin VB.Menu mnu_setting_Increase 
         Caption         =   "增加间隔       +"
      End
      Begin VB.Menu mnu_setting_Decrease 
         Caption         =   "减小间隔       -"
      End
   End
   Begin VB.Menu mnuOption 
      Caption         =   "&O选项"
      Begin VB.Menu mnuOption_TargetPosition 
         Caption         =   "显示车辆坐标"
         Checked         =   -1  'True
      End
      Begin VB.Menu mnuOption_MousePosition 
         Caption         =   "显示鼠标坐标"
         Checked         =   -1  'True
      End
      Begin VB.Menu mnuOption_s1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuOption_SaveTrack 
         Caption         =   "记录运行数据"
         Checked         =   -1  'True
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "&H帮助"
      Begin VB.Menu mnuHelp_Index 
         Caption         =   "使用说明"
      End
      Begin VB.Menu mnuHelp_About 
         Caption         =   "关于..."
      End
   End
   Begin VB.Menu cd 
      Caption         =   "cd"
      Visible         =   0   'False
      Begin VB.Menu rr 
         Caption         =   "循环"
      End
      Begin VB.Menu Op 
         Caption         =   "-"
      End
      Begin VB.Menu ff 
         Caption         =   "反向"
      End
      Begin VB.Menu po 
         Caption         =   "-"
      End
      Begin VB.Menu tt 
         Caption         =   "暂停"
      End
   End
   Begin VB.Menu dc 
      Caption         =   "dc"
      Visible         =   0   'False
      Begin VB.Menu lx 
         Caption         =   "轮询"
      End
      Begin VB.Menu dh 
         Caption         =   "单呼"
      End
      Begin VB.Menu tinghzhi 
         Caption         =   "停止"
      End
      Begin VB.Menu ty 
         Caption         =   "-"
      End
      Begin VB.Menu ccf 
         Caption         =   "重放"
      End
      Begin VB.Menu fg 
         Caption         =   "-"
      End
      Begin VB.Menu zt 
         Caption         =   "暂停"
      End
      Begin VB.Menu tz 
         Caption         =   "停止工作"
      End
   End
End
Attribute VB_Name = "MDIMainForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'修改内容:1.时间间隔;2.串口3,4没有;3.模拟报警4.五个?????以上为修改数据格式地方(INIT,ccommstream.sendcom)

'本Form上有5个Timer，作用如下
'TimerCall，工作时钟，
'TimerReplay，重播轨迹文件
'TimerRefresh，刷新Statusbar上的时间
'TimerCheck，呼叫一定时间（1秒）后检查是否有应答
'TimerCheckEnable，一定时间（1分）后检查车辆数据是否有效


Option Explicit

Public oWorkMode As New CWorkMode
Public oTargetManager As New CTargetManager
Public m_bOnLoaded As Boolean
Public m_bNoneSpaDBOpen As Boolean
Public Ctryout As New TryOut
Public Sub Init_chuan()
Dim temp_info As String
'temp_info = temp_info + INIT(1)
'temp_info = temp_info + INIT(2)
'temp_info = temp_info + INIT(3)
'temp_info = temp_info + INIT(4)
'MDIMainForm.StatusBar1.Panels(2).Text = temp_info
End Sub

Public Function INIT(ByVal Chuan As Integer) As String
'Dim ddd As String
'Dim DDD1 As String
'Dim DDD2 As String
'Dim ddd3 As String
'On Error Resume Next
'ddd = "AT+CSMS=1" + Chr(13)
'DDD1 = "AT+CNMI=1,2" + Chr(13)
Select Case Chuan
       Case 1
            ''oComm1.InBufferCount = 0
            If oComm1.PortOpen = False Then
               oComm1.PortOpen = True
            End If
            'oComm1.Output = ddd
            'Sleep (300)
            'oComm1.Output = DDD1
            'Sleep (300)
            'DDD2 = oComm1.Input
       'Case 2
            ''oComm2.InBufferCount = 0
            'If oComm2.PortOpen = False Then
               'oComm2.PortOpen = True
            'End If
            'oComm2.Output = ddd
            'Sleep (300)
            'oComm2.Output = DDD1
            'Sleep (300)
            'DDD2 = oComm2.Input
       
            'oComm8.Output = ddd
            'Sleep (300)
            'oComm8.Output = DDD1
            'Sleep (300)
            'DDD2 = oComm8.Input
End Select
   
   'If Trim(DDD2) = "" Then
      'INIT = CStr(Chuan) + "失败"  ', vbInformation, App.title
      'INIT = "初始化" + CStr(Chuan) + "串口" + "失败  手机未连接"
      'MDIMainForm.StatusBar1.Panels(2).Text = INIT
      Exit Function
   'End If
   'DDD2 = Mid(DDD2, Len(DDD2) - 3, 2)
   ''oComm2.OutBufferCount = 0
   'If DDD2 = "OK" Then
      'INIT = "初始化" + CStr(Chuan) + "串口" + "成功"
   'Else
      'INIT = "初始化" + CStr(Chuan) + "串口" + "失败"
   'End If
'MDIMainForm.StatusBar1.Panels(2).Text = INIT
''Select Case Chuan
''       Case 1
''            oComm1.InBufferCount = 0
''       Case 2
''            oComm2.InBufferCount = 0
''       Case 3
''            oComm3.InBufferCount = 0
''       Case 4
''            oComm4.InBufferCount = 0
''End Select
'MDIMainForm.StatusBar1.Panels(2).Text = INIT
End Function

Public Sub Findtelnum(ByVal tel As String)

Dim dbs As Database
Dim rst As Recordset
Dim wang As String
Dim oLayerConfig As LayerConfig
Set oLayerConfig = MDIMainForm.ActiveForm.oCompoundMap.LayerConfigs("宁波电话号码")

         If Not oLayerConfig.Visible Then
         oLayerConfig.Visible = True
         End If
Set dbs = DBEngine.Workspaces(0).OpenDatabase(strPath + "tel.mdb")
Set rst = dbs.OpenRecordset("tel")
rst.Index = "alerttel"
rst.Seek "=", tel
If Not rst.NoMatch Then
    'Label2.Caption = tel
    'Label4.Caption = rst!hz
    'Label6.Caption = rst!Addre
        If Not oLayerConfig.IsValid Then Exit Sub
        
        If IsNull(rst!oid) Or IsEmpty(rst!oid) Then
               
        Else
               MDIMainForm.ActiveForm.oCompoundMap.CenterEntity (rst!oid)
               MDIMainForm.ActiveForm.SetFocusEntity (rst.Fields("OID"))
               Label2.Caption = tel
               Label4.Caption = "不详" '"郑州光电子技术研究所"
               Label6.Caption = "不详" '"郑州市中原路广安大厦7层B座"
               'Ftel = tel
        End If
Else
   'MsgBox "无此号码！", vbQuestion, "提示"
   Label2.Caption = tel
   Label4.Caption = "不详"
   Label6.Caption = "不详"
End If
Set oLayerConfig = Nothing
Set rst = Nothing
Set dbs = Nothing
End Sub


Public Function GetFileName(ByVal strFilter As String, ByVal strFileName As String, ByVal bCancelError As Boolean) As String
    On Error GoTo err
    oCommonDialog.Filter = strFilter
    oCommonDialog.filename = strFileName
    oCommonDialog.CancelError = bCancelError
    oCommonDialog.ShowOpen
    GetFileName = oCommonDialog.filename
    Exit Function
err:
    GetFileName = ""
End Function

Private Sub GetGpsPath()
    Dim dbs As Database
    
    On Error GoTo errorhandle
    strPath = Ini_GetPath
    If strPath = "" Then
        strPath = App.Path + "\..\Data\"
    End If
    Set dbs = DBEngine.Workspaces(0).OpenDatabase(strPath + PATH_DBDATA)
    dbs.Close
    Ini_SavePath strPath
    Exit Sub
errorhandle:
    strPath = GetFileName("Gps.mdb", "Gps.mdb", True)
    If strPath = "" Or right(strPath, 7) <> "Gps.mdb" Then
        MsgBox "无法找到Gps.mdb数据库！"
        End
    Else
        strPath = left(strPath, Len(strPath) - 7)
        Resume
    End If
    Set dbs = Nothing
End Sub

Public Sub UI_NoneSpaDBOpen()
    mnu_setting.Enabled = False
    mnu_mode.Enabled = False
    mnu_replay.Enabled = False
    mnuOption.Enabled = False
    mnu_display.Enabled = False
    mnu_file_opencmp.Enabled = False
    tlbMain.Enabled = False
    If Not m_bNoneSpaDBOpen Then
        mnu_file_opencmp.Enabled = True
    End If
    StatusBar1.Panels(4).Text = ""
End Sub

Public Sub UI_NoneMonitorWindowOpen()
    Dim i, lCount As Integer
    lCount = 0
    For i = 0 To Forms.Count - 1
        If Forms(i).Name = "MonitorForm" Then
            lCount = lCount + 1
        End If
    Next
    If lCount = 0 Then
        mnu_replay.Enabled = False
        mnu_display.Enabled = False
        mnu_setting.Enabled = False
        mnu_mode.Enabled = False
        mnuOption.Enabled = False
        tlbMain.Enabled = False
    Else
        mnu_replay.Enabled = True
        mnu_display.Enabled = True
        mnu_setting.Enabled = True
        mnu_mode.Enabled = True
        mnuOption.Enabled = True
        tlbMain.Enabled = True
    End If
End Sub

Private Function OpenSpaDB(ByVal strFileName As String) As Boolean
'strFileName 图库文件

    Dim oLegend As Legend
    Dim i As Integer
    Dim oTarget As CTarget
        
    If oSpaDB.IsModified Then
        oSpaDB.Save
    End If
        
    If Not oSpaDB.Open(strFileName) Then
        MsgBox "图库打开失败！"
        OpenSpaDB = False
        m_bNoneSpaDBOpen = True
        Ini_SaveDefaultSpaDBFileName ""
        Exit Function
    End If