mdimain.frm

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

             End If
             NewMonitorWindow strCMPName
             UI_NoneMonitorWindowOpen
         Else
             UI_NoneSpaDBOpen
         End If
        
         OpenSpecAlt
         oWorkMode.SetModeComm
         '打开串口
         
         If g_bOpenComm Then '打开串口
            oWorkMode.OndutyInit True
         End If
         '打开特殊报警串口
         'OpenSpecAlt
         mnu_display_Query_Click
     End If
 End Sub

Private Sub OpenSpecAlt()
    'Dim Port As Integer
    'Dim Baud As String
    'Dim parity As String
    'Dim DataBit As String
    'Dim StopBit As String
    'Dim strSetting As String
    
    'Dim AlertLayer As String
   ' AlertLayer = Ini_GetAlertLayerName
    'If AlertLayer = "" Then
        'MsgBox "无专线报警图层！"
        'Exit Sub
    'End If
    
    'On Error GoTo errhandle
    'Ini_GetComm2Setting Port, Baud, parity, DataBit, StopBit

   ' If oComm2.PortOpen = True Then
        'oComm2.PortOpen = False
    'End If
    
    'oComm2.CommPort = Port
    'o'Comm2.InputLen = 0
    'strSetting = Baud + "," + parity + "," + DataBit + "," + StopBit
    'oComm2.Settings = strSetting
    'oComm2.PortOpen = True
   ' Exit Sub

'errhandle:
    'MsgBox "专线报警串口设置失败！", , "设置串口"
    'Exit Sub
End Sub

Private Sub MDIForm_Initialize()
    If App.PrevInstance Then
        End
    End If
    GetGpsPath
    Link_IP = Ini_IP
    Howlong = Ini_Lock
    Road = Ini_Road
    If Ini_LockFlag = 1 Then
       Temp_Lock_Flag = True
    Else
       Temp_Lock_Flag = False
    End If
    alertend = False
    oTargetManager.Rebuild
    Change1_2 = False
    Change2_1 = False
    Series2 = False      '默认用串口1呼车
    LoopTimes = 3
    oWorkMode.SetInterval 3000
    Temp_HjTime = 3000
    Call_Interval = 3
    MDIMainForm.StatusBar1.Panels(3) = "3秒"
    Command1.Visible = False
End Sub

Private Sub MDIForm_Load()
    Send_Command = False
    m_bOnLoaded = True
    g_bOpenComm = False
    'Winsock1.RemoteHost = Link_IP
    'Winsock1.RemotePort = 1001
    'Winsock1.Connect
    
End Sub

Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim msg, title As String
    Dim style, response As Long
    Dim i, lCount As Integer
    If UnloadMode = 0 Or UnloadMode = 1 Then
        msg = "退出系统？"
        style = vbYesNo + vbQuestion + vbDefaultButton2 ' Define buttons.
        title = "提示"
        
        
    frmLogin1.Show 1
    If Temp_Login = True Then
        response = MsgBox(msg, style, title)
        If response <> vbYes Then
            Cancel = 1
        End If
    Else
        Cancel = 1
    End If
    End If
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)
    oWorkMode.SetModeNone
    Set oWorkMode = Nothing
    Set oTargetManager = Nothing
    If oSpaDB.IsModified Then
        oSpaDB.Save
    End If
    oSpaDB.Close
    Winsock1.Close
    'dd.RestoreDisplayMode
    'dd.SetCooperativeLevel 0, DDSCL_NORMAL
    'Set dd = Nothing
    End
End Sub


Private Sub MMControl1_Done(NotifyCode As Integer)
       If NotifyCode = 1 And AlertFlag = True Then
       MMControl1.Command = "close"
       MMControl1.filename = "C:\Gps\WAV\车警.WAV"
       MMControl1.Command = "open"
       MMControl1.Command = "play"
End If
End Sub

Private Sub mnu_display_layerconfig_Click()
    MonitorForm.oCompoundMap.ShowLayerConfigView
End Sub

Private Sub mnu_display_pane_Click()
    g_Oper = meDoPane
    MonitorForm.oCompoundMap.CurrentTool = meDoPane
End Sub

Private Sub mnu_display_Query_Click()
    g_Oper = meDoSelect
    MonitorForm.oCompoundMap.CurrentTool = meDoSelect
End Sub

Private Sub mnu_display_redraw_Click()
    MonitorForm.oCompoundMap.Redraw
End Sub

Private Sub mnu_display_wholemap_Click()
    MonitorForm.oCompoundMap.WholeMap
End Sub

Private Sub mnu_display_zoomin_Click()
    g_Oper = meDoZoomIn
    MonitorForm.oCompoundMap.CurrentTool = meDoZoomIn
End Sub

Private Sub mnu_display_zoomout_Click()
    g_Oper = meDoZoomOut
    MonitorForm.oCompoundMap.CurrentTool = meDoZoomOut
End Sub


Private Sub mnu_file_opencmp_Click()
    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
        NewMonitorWindow ""
        UI_NoneMonitorWindowOpen
    Else
        MonitorForm.OpenCompoundmap ""
    End If
End Sub

Private Sub mnu_file_openspadb_Click()
    Dim strFileName As String
    
    strFileName = GetFileName("*.XDB", "*.XDB", True)
    If strFileName = "" Then
        Exit Sub
    End If
    If UCase(Mid(strFileName, Len(strFileName) - 2, 3)) <> "XDB" Then
       Exit Sub
    End If
    If OpenSpaDB(strFileName) Then
        UI_NoneSpaDBOpen
        NewMonitorWindow ""
        UI_NoneMonitorWindowOpen
    Else
        UI_NoneSpaDBOpen
    End If
End Sub

Private Sub mnu_file_quit_Click()
    Unload Me
End Sub

Private Sub mnu_replay_continuous_Click()
    oWorkMode.oReplayStream.SetContinuous (Not oWorkMode.oReplayStream.GetContinuous)
    MDIMainForm.mnu_replay_continuous.Checked = oWorkMode.oReplayStream.GetContinuous
    If ReplayConfigForm.chkContinuous.Value = 0 Then
       ReplayConfigForm.chkContinuous.Value = 1
    Else
       ReplayConfigForm.chkContinuous.Value = 0
    End If
End Sub

Private Sub mnu_replay_openfile_Click()
    ReplayConfigForm.Show
End Sub

Private Sub mnu_replay_pause_Click()
    oWorkMode.oReplayStream.SetPause (Not oWorkMode.oReplayStream.GetPause) 'it is a logic value in clause
    ' m_bPause = bPause ,this is done in OWorkMode.setPause
    MDIMainForm.mnu_replay_pause.Checked = oWorkMode.oReplayStream.GetPause 'just a booler value
    If ReplayConfigForm.chkPause.Value = 0 Then
       ReplayConfigForm.chkPause.Value = 1
    Else
       ReplayConfigForm.chkPause.Value = 0
    End If
    
End Sub

Private Sub mnu_replay_reverse_Click()
    oWorkMode.oReplayStream.SetReverse (Not oWorkMode.oReplayStream.GetReverse)
    MDIMainForm.mnu_replay_reverse.Checked = oWorkMode.oReplayStream.GetReverse
    If ReplayConfigForm.chkReverse.Value = 0 Then
       ReplayConfigForm.chkReverse.Value = 1
    Else
       ReplayConfigForm.chkReverse.Value = 0
    End If

End Sub

Private Sub mnu_replay_step_Click()
    TimerReplay_Timer
End Sub

Private Sub mnu_display_filter_Click()
    frmFilterSet.Show
End Sub

Private Sub mnu_display_target_Click()
    TargetDrawSetting.Show
End Sub

Private Sub mnu_setting_AlertLayer_Click()
    frmAlertLayer.Show
End Sub

Public Sub mnu_setting_Decrease_Click()
    oWorkMode.SetInterval oWorkMode.GetInterval - 1000
    StatusBar1.Panels(3).Text = oWorkMode.GetInterval / 1000 & "秒"
End Sub

Public Sub mnu_setting_Increase_Click()
    oWorkMode.SetInterval oWorkMode.GetInterval + 1000
    StatusBar1.Panels(3).Text = oWorkMode.GetInterval / 1000 & "秒"
End Sub

Private Sub mnu_setting_targetdb_Click()
    On Error Resume Next
    frmAddCar.Show
End Sub

Private Sub mnu_setting_comm_Click()
    Dim Port As Integer
    Dim Baud As String
    Dim parity As String
    Dim DataBit As String
    Dim StopBit As String
    Dim i As Integer
    Dim response As Integer
    
    Ini_GetCommSetting "comm1", Port, Baud, parity, DataBit, StopBit
    CommSet.SendCommSetting 1, Port, Baud, parity, DataBit, StopBit
    'Ini_GetComm2Setting Port, Baud, parity, DataBit, StopBit
    'CommSet.SendCommSetting 2, Port, Baud, parity, DataBit, StopBit
    'Ini_GetComm3Setting Port, Baud, parity, DataBit, StopBit
    'CommSet.SendCommSetting 3, Port, Baud, parity, DataBit, StopBit
    'Ini_GetComm4Setting Port, Baud, parity, DataBit, StopBit
    'CommSet.SendCommSetting 4, Port, Baud, parity, DataBit, StopBit
  
    CommSet.Show
    If CommSet.IsOk Then
        If oWorkMode.GetMode <> REPLAY And oWorkMode.GetMode <> NONEWORK Then
            oWorkMode.SetModeComm
        End If
        'OpenSpecAlt
    End If
End Sub

Private Sub mnu_display_trackclear_Click()
    Dim style, response As Long
    
    style = vbYesNo + vbQuestion + vbDefaultButton2
    response = MsgBox("清除轨迹吗？", style, "提示")
    If response = vbYes Then
        oTargetManager.ClearTrack
        MonitorForm.oCompoundMap.Redraw
    End If
End Sub

Private Sub mnuMode_LockCar_Click()
   If bj = True Then
   oWorkMode.LockCarInit
   End If
End Sub

Private Sub mnuHelp_Index_Click()
oCommonDialog.HelpFile = strPath + "gps.hlp"
oCommonDialog.HelpCommand = cdlHelpContents
oCommonDialog.ShowHelp
End Sub

Private Sub mnuMode_None_Click()
    bj = False
    oWorkMode.SetModeNone
    w = 0
    DHFLAG = 1
End Sub

Private Sub mnuMode_OnDuty_Click()
    oWorkMode.OndutyInit False
End Sub

Public Sub mnumode_pause_Click()
    bj = False
    If mnumode_pause.Caption = "暂停" Then
        mnumode_pause.Caption = "继续"
        oWorkMode.SetPause True
    Else
        mnumode_pause.Caption = "暂停"
        oWorkMode.SetPause False
    End If
End Sub


Private Sub mnuMode_PollQuery_Click()
'Dim dbs As Database
'Dim rst As Recordset
'On Error Resume Next
'Set dbs = DBEngine.Workspaces(0).OpenDatabase("c:\gps\gps.mdb")
'Set rst = dbs.OpenRecordset("target")
'Do While Not rst.EOF
'       If Trim(str(rst.Fields)) <> "" Then
'          MDIMainForm.ActiveForm.oCompoundMap.DrawNode2 rst.Fields("jd"), rst.Fields("wd"), g_oTargetRes, 0, False
'          MDIMainForm.ActiveForm.oCompoundMap.DrawText rst.Fields("jd"), rst.Fields("wd"), rst.Fields("Name"), g_lTargetNameColor, 0, "System", False
'       End If
'       rst.MoveNext
'Loop
'DHFLAG = 8
'oWorkMode.QueryInit
Form5.Show
End Sub


Private Sub mnuMode_UnLockCar_Click()
    oWorkMode.UnLockCarInit
End Sub

Private Sub mnuMode_Singlecall_Click(Index As Integer)
'If DHFLAG = 2 Or DHFLAG = 3 Or DHFLAG = 4 Or DHFLAG = 5 Then
'   m_Mode = StopCall
'   oWorkMode.SendCommand
'End If
oWorkMode.OndutyInit True
Select Case Index
       Case 1
               bht = True
               dhh = 1
               DHFLAG = 1
       Case 2
               bht = True
               dhh = 1
               DHFLAG = 3
       Case 3
               bht = True
               dhh = 1
               DHFLAG = 2
       Case 4
               bht = False
               dhh = 1
               DHFLAG = 4
       Case 5
               bht = False
               dhh = 1
               DHFLAG = 5
End Select
CarInput.Show
End Sub

Private Sub mnuOption_MousePosition_Click()
    mnuOption_MousePosition.Checked = Not mnuOption_MousePosition.Checked
    St