mdimain.frm

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

'取得图例
    Set oLegend = oSpaDB.Legends(Ini_GetTargetLegend)
    Dim strErr As String
    If oLegend.IsValid Then
        g_oTargetRes.legendOID = oLegend.GetOID
        g_oTargetRes.bUseColor = True
        g_oTargetRes.Color = Ini_GetTargetLegendColor
    Else
        strErr = strErr + "车辆图例"
    End If
    
    g_lTargetNameColor = Ini_GetTargetNameColor
    
    Set oLegend = oSpaDB.Legends(Ini_GetTargetTrackLegend)
    If oLegend.IsValid Then
        g_oTargetTrackRes.legendOID = oLegend.GetOID
        g_oTargetTrackRes.bUseColor = False
        g_oTargetTrackRes.Color = Ini_GetTargetLegendColor
    Else
        If strErr <> "" Then
            strErr = strErr + "、"
        End If
        strErr = strErr + "轨迹图例"
    End If
    
    Set oLegend = oSpaDB.Legends(Ini_GetTargetLockedLegend)
    If oLegend.IsValid Then
        g_oTargetLockedRes.legendOID = oLegend.GetOID
        g_oTargetLockedRes.bUseColor = True
        g_oTargetLockedRes.Color = Ini_GetTargetLockedLegendColor
    Else
        If strErr <> "" Then
            strErr = strErr + "、"
        End If
        strErr = strErr + "锁定图例"
    End If
    
    If strErr <> "" Then
        MsgBox strErr + "设置无效" + Chr(13) + Chr(10) + "请手工设置。"
    End If

'关闭所有窗口
    Dim bUnload As Boolean
    Do
        bUnload = False
        For i = 0 To Forms.Count - 1
            If Forms(i).Name <> "MDIMainForm" Then
                bUnload = True
                Unload Forms(i)
                Exit For
            End If
        Next
    Loop Until Not bUnload
    
    Ini_SaveDefaultSpaDBFileName strFileName
    m_bNoneSpaDBOpen = False
    OpenSpaDB = True
    Set oLegend = Nothing
End Function

Public Function NewMonitorWindow(ByVal strCMPName As String) As Form
'strCMPName 复合图，if strCMPName="" then 选择打开；
    'Dim Newform As New MonitorForm
    Dim lReturnval As Integer
    
    If m_bNoneSpaDBOpen Then
        MsgBox "图库未打开"
        Exit Function
    End If
        
    lReturnval = MonitorForm.OpenCompoundmap(strCMPName)
    Select Case lReturnval
        Case OPENCMP_OPENCMPERROR
            MsgBox ("复合图打开失败！")
            Unload MonitorForm
            Set NewMonitorWindow = Nothing
            Exit Function
        Case OPENCMP_NONECMP
            MsgBox ("图库中无复合图！")
            Unload MonitorForm
            Set NewMonitorWindow = Nothing
            Exit Function
        Case OPENCMP_CANCEL
            Unload MonitorForm
            Set NewMonitorWindow = Nothing
            Exit Function
    End Select
    Set NewMonitorWindow = MonitorForm
    MonitorForm.Show
End Function

Public Sub ReceiveData(ByVal oRecord As CRecord)
    Dim i As Integer
    
    If MDIMainForm.mnuOption_TargetPosition.Checked Then
        MDIMainForm.StatusBar1.Panels(4).Text = "经度：" + Format(oRecord.fLongitude, "##.######") + "  纬度：" + Format(oRecord.fLatitude, "##.######")
    End If
    
    If IsLoaded("DataWindow") Then
        DataWindow.ReceiveData oRecord
    End If
        
    If oWorkMode.GetMode = REPLAY Then
       ReplayConfigForm.SetTime
    End If
    
    MonitorForm.ReceiveData oRecord
End Sub

Private Sub Addtel_Click()
Dim oLayerConfig As LayerConfig
  Set oLayerConfig = MDIMainForm.ActiveForm.oCompoundMap.LayerConfigs("宁波电话号码")
     If Not oLayerConfig.IsValid Then Exit Sub
         If Not oLayerConfig.Visible Then
         oLayerConfig.Visible = True
     End If
 MDIMainForm.ActiveForm.oCompoundMap.CurrentTool = meDoAdd
 Set oLayerConfig = Nothing
End Sub


Private Sub AlermApply_Click()
AlermAnswer = True
CarInput.Show
End Sub

Private Sub callby1s_Click()
  Series2 = False
End Sub

Private Sub callby2s_Click()
  Series2 = True
End Sub

Private Sub ccf_Click()
bht = False
CbCf1.Show
w = 0
End Sub

Private Sub cf_Click()
bht = False
CbCf1.Show
w = 0
End Sub

Private Sub clear_Click()
Dim oClearPhone As New ClearPhone
oClearPhone.ScanPhone
End Sub

Private Sub ChangeChanels_Click()
Dim s As String
dhh = 100
CarInput.Show
Change1_2 = True
End Sub

'Private Sub Command_Click()
'oComm2.Settings = "9600,n,8,1"
'End Sub

Private Sub Command2_Click()
frmFilterSet.Show
End Sub

Private Sub ChangeChanels2_Click()
Dim s As String
dhh = 100
CarInput.Show
Change2_1 = False
End Sub

Private Sub Command1_Click()
CarNum = "001"
AlertFlag = True
Series2 = True
End Sub

Private Sub dd_Click()
oWorkMode.OndutyInit True
bht = False
dhh = 4
CarInput.Show
End Sub

Private Sub Deltel_Click()
Dim msg, title As String
 Dim style, response As Long
 Dim oLayerConfig As LayerConfig
 Dim chen As Long
 Dim rst As Recordset
 Dim dbs As Database
 On Error Resume Next
  Set oLayerConfig = MDIMainForm.ActiveForm.oCompoundMap.LayerConfigs("宁波电话号码")
    If Not oLayerConfig.IsValid Then Exit Sub
    If Not oLayerConfig.Visible Then
        oLayerConfig.Visible = True
    End If
        msg = "确认删除用户位置与资料？"
        title = "提示"
    chen = MsgBox(msg, vbYesNo + vbQuestion, title)
 If chen = vbYes Then
    MDIMainForm.ActiveForm.oCompoundMap.RemoveAll
    'DelCkUser
    'Unload userinfo1
 End If
  'If Trim(Ftel) <> "" Then
  '  Set dbs = DBEngine.Workspaces(0).OpenDatabase(strPath + "tel.mdb")
  '  Set rst = dbs.OpenRecordset("tel")
  '  rst.Index = "alerttel"
  '  rst.Seek "=", Ftel
  '  If Not rst.NoMatch Then
  '      rst.Delete
  '  End If
 'End If
 Set oLayerConfig = Nothing
End Sub

Private Sub dh_Click()
'If DHFLAG = 2 Or DHFLAG = 3 Or DHFLAG = 4 Or DHFLAG = 5 Then
'   m_Mode = StopCall
'   oWorkMode.SendCommand
'End If
bht = True
dhh = 1

CarInput.Show
End Sub

Private Sub DuiLie_Click()
Call_Queue.Show
End Sub

Private Sub ff_Click()
    oWorkMode.oReplayStream.SetReverse (Not oWorkMode.oReplayStream.GetReverse)
    MDIMainForm.mnu_replay_reverse.Checked = oWorkMode.oReplayStream.GetReverse
    MDIMainForm.ff.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 Findtel_Click()
Form3.Show
End Sub

Private Sub Hidetel_Click()
Dim i As Integer
    Dim oLayerConfig As LayerConfig
     On Error Resume Next
    Set oLayerConfig = MDIMainForm.ActiveForm.oCompoundMap.LayerConfigs("宁波电话号码")
    If Not oLayerConfig.IsValid Then Exit Sub
     If oLayerConfig.Visible Then
         oLayerConfig.Visible = False
     End If
            MDIMainForm.ActiveForm.oCompoundMap.CurrentTool = meDoSelect
            MDIMainForm.ActiveForm.oCompoundMap.Redraw
    Set oLayerConfig = Nothing
End Sub

Private Sub Hist_Click()
bht = False
dhh = 1
DHFLAG = 9
CarInput.Show
End Sub

Private Sub inittel_Click()
Init_chuan
End Sub

Private Sub jt_Click()
oWorkMode.OndutyInit True
bht = False
dhh = 5
CarInput.Show
End Sub

Private Sub Link_Click()
Winsock1.Close
If Winsock1.LocalPort = 0 Then
   Winsock1.LocalPort = 1
Else
   Winsock1.LocalPort = 0
End If
Winsock1.Connect
End Sub

Private Sub lock_Click()
oWorkMode.OndutyInit True
bht = False
dhh = 3
CarInput.Show
End Sub

Private Sub Lock_D_Click()
bht = False
dhh = 1
DHFLAG = 6
CarInput.Show
End Sub

Private Sub LoginSever_Click()
Login
End Sub

Private Sub Long_Click()
Dim i As Integer
    Dim oShapeLine As ShapeLine
    Dim oLegend As Legend
    Dim lLegendOID As Long
    Qcd = True
    Set oLegend = MDIMainForm.oSpaDB.Legends("")
    oLegend.LoadByName ("LengthLineLegend")
    lLegendOID = oLegend.GetOID
    With MDIMainForm.ActiveForm
        Set oShapeLine = .oCompoundMap.DoTrack(meShapeLine)
        .oCompoundMap.DrawLine oShapeLine, lLegendOID, True
        .oCompoundMap.RefreshScreen
        MsgBox "总长度 = " + Format(oShapeLine.length / 1000, "###0.00 公里"), , "结果"
        Qcd = False
    End With
    Set oLegend = Nothing
End Sub

Private Sub lookcar_Click()
Form1.Show
End Sub

Private Sub LTimer_Timer()
'Dim dbs As Database
'Dim rst As Recordset
'Dim dd As String
'Dim filename As String
'Dim filenum As Integer
'If Hour(Time) = 12 Then
'    filenum = FreeFile
'    filename = "c:\gps\" + str(Date) + ".rz"
'    Set dbs = DBEngine.Workspaces(0).OpenDatabase(strPath + PATH_DBDATA)
'    Set rst = dbs.OpenRecordset("target")
'    Do While Not rst.EOF
'    If rst.Fields("Ltime") <> "" Then
'        If Day(rst.Fields("Ltime")) - Day(Date) >= 2 Or Day(Date) - Day(rst.Fields("Ltime")) >= 2 Then
'            'MsgBox rst.Fields("Name") + "号车已大于四十八小时未开机请检查", vbCritical, App.title
'            dd = rst.Fields("Name") + "号车已大于四十八小时未开机请检查"
'            Open filename For Append As #filenum
'                 Print #filenum, dd, Time, Date
'            Close #filenum
'            Form2.Label1.Caption = dd
'            Form2.Show
'        End If
'    End If
'    rst.MoveNext
'    Loop
'End If
Dim oClear As New ClearPhone
If oClear.ScanPhone = True Then
   MDIMainForm.Init_chuan
End If
Sleep (300)
Set oClear = Nothing
End Sub

Private Sub lx_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
End Sub

Private Sub MDIForm_Activate()

   Dim strFileName As String
    Dim strCMPName As String
     Dim lWindowCount, lWindowIndex, lCount, lIndex As Integer
     Dim lID As Long
     Dim strCMP As String
     Dim oForm As Form
    
     If m_bOnLoaded Then
         m_bOnLoaded = False
        
         strFileName = Ini_GetDefaultSpaDBFileName
        
         If strFileName = "" Then
            '缺省打开图库文件，系统第一次运行时使用
             strFileName = "c:\jin\gps\data\demo.xdb"
         End If
         If OpenSpaDB(strFileName) Then
             UI_NoneSpaDBOpen
             strCMPName = Ini_GetDefaultCMPName
             If strCMPName = "" Then
                 '缺省打开地图，系统第一次运行时使用
                 strCMPName = "Gps"