mdimain.frm

一个功能比较完善的远程抄表软件

                    
                    '报警信号发送结束
                    If chkBit(PortB_2, bUser, 1, 1000) <> 0 Or chkBit(PortB_2, bDev, 1, 1000) <> 0 Then
                            If ReadCount <> curBit Then      '检查报警信号是否丢失读脉冲(5 或 4)
                                AlertStatus = 2
                                Exit Do
                            End If
                            
                            Set rcAlertRecord = dbCbb.OpenRecordset("AlertRecord", dbOpenDynaset)
                            Set rcAlertUserMap = dbCbb.OpenRecordset("UserMap", dbOpenSnapshot)
                            
                            curAlertName = getAlertName(ReadAlertType)
                            If Trim(curAlertName) = "" Then
                                AlertStatus = 3
                                Exit Do
                            End If
                            
'                            rcAlertUserMap.FindFirst "Address=" + Format(ReadAlertUserAddr)
'                            If rcAlertUserMap.NoMatch Then
'                                AlertStatus = 4
'                                Exit Do
'                            End If
                            
                            rcAlertRecord.AddNew
                            rcAlertRecord!AlertType = ReadAlertType
                            rcAlertRecord!AlertName = curAlertName
                            'rcAlertRecord!UserID = rcAlertUserMap!UserID
                            'rcAlertRecord!UserName = rcAlertUserMap!UserName
                            rcAlertRecord!Date = Date
                            rcAlertRecord!Time = Time
                            rcAlertRecord!UserAddress = ReadAlertUserAddr
                            rcAlertRecord.Update
                            
                            Select Case ReadAlertType
                                Case ALERT_WATER                  'water
                                    curAlert(1) = rcAlertUserMap!UserID
                                    curAlertDate(1) = Date
                                    curAlertTime(1) = Time
                                Case ALERT_GAS                  'gas
                                    curAlert(2) = rcAlertUserMap!UserID
                                    curAlertDate(2) = Date
                                    curAlertTime(2) = Time
                                Case ALERT_ROB                  'rob
                                    curAlert(3) = rcAlertUserMap!UserID
                                    curAlertDate(3) = Date
                                    curAlertTime(3) = Time
                                Case ALERT_LIFE                  'life
                                    curAlert(4) = rcAlertUserMap!UserID
                                    curAlertDate(4) = Date
                                    curAlertTime(4) = Time
                            End Select
                            
                            EchoAlert (ReadAlertType)           '在显示面板上显示报警
                            AlertStatus = 5
                            Exit Do
                    End If
                    DoEvents
                Loop
            End If
        
        Alerting = False                    '报警信息接收完毕
        DoEvents
    Loop
End Sub

Sub badGateRec(badGateID As Integer)
Dim fn As Integer
Dim fname As String

    badGateSum = badGateSum + 1
    ReDim badGates(badGateSum)
    badGates(badGateSum - 1) = badGateID
    
    fn = FreeFile
    fname = "errgate.dat"
    Open fname For Binary As #fn
    Seek #fn, FileLen(fname) + 1
    Put #fn, , badGateID
    Close #fn
End Sub


Private Sub clbMain_Resize()
    videoMain.Left = frmMain.Width - 375 - 300
End Sub



'Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    'Dim result
    'result = MsgBox("确定要退出系统吗?", 1, "退出")
    'If result = 1 Then
        'End
    'End If
'End Sub

Private Sub MDIForm_Resize()
'Dim hScale As Double
'
'hScale = pnlBase.Width / PnlBaseW
'
'With pnlLife
'    .Left = PnlLifeL * hScale
'    .Width = PnlLifeW * hScale
'End With
'With pnlRob
'    .Left = PnlRobL * hScale
'    .Width = PnlRobW * hScale
'End With
'With pnlGas
'    .Left = PnlGasL * hScale
'    .Width = PnlGasW * hScale
'End With
'With pnlWater
'    .Left = PnlWaterL * hScale
'    .Width = PnlWaterW * hScale
'End With
'With videoMain
'    .Left = Me.Width - .Width - 300
'    .Top = clbMain.Top + 100
'End With
''With cmdStartAlert
'    '.Left = cmdStarALertL * hScale
'    '.Width = cmdStarAlertW * hScale
''End With
''With cmdShutAlert
'    '.Left = cmdShutAlertL * hScale
'    '.Width = cmdShutAlertW * hScale
''End With
' If frmMain.WindowState <> 1 Then
'    If frmBackGround.Enabled Then
'        With frmBackGround
'            .Left = 0
'            .Top = 0
'            '.Height = Me.Height - Me.pnlBase.Height - Me.stbMain.Height
'            .Height = Me.Height
'            .Width = Me.Width
'        End With
'    End If
'End If
''If frmMain.WindowState <> 1 Then
'    'If frmMainInfo.Enabled Then
'        'With frmMainInfo
'            '.Left = 0
'            '.Top = 0
'            '.Height = Me.Height - Me.pnlBase.Height - Me.stbMain.Height
'            '.Width = Me.Width
'            ''.Height = IIf((Me.Height - Me.pnlBase.Height - 750 - Me.stbMain.Height) > 0, Me.Height - Me.pnlBase.Height - 750 - Me.stbMain.Height, 1)
'            ''.Width = IIf((Me.Width - 180) > 0, Me.Width - 180, 1)
'        'End With
'    'End If
'    'stbMain.Panels(1).Width = IIf((stbMain.Width - stbMain.Panels(2).Width - 270) > 0, stbMain.Width - stbMain.Panels(2).Width - 270, 1)
''End If
End Sub



Private Sub MDIForm_Unload(Cancel As Integer)
    Dim i As Integer
    dbCbb.Close
    On Error Resume Next
    mnuShutAlert_Click      'add by zx, 20050314
    DoEvents
    FileCopy App.Path & "\DATA\CBB.MDB", App.Path & "\DATA\CBB_BK.MDB"
    SaveINI
    
    On Error GoTo 0
    frmMain.videoMain.Disconnect
    ok = Stopped
    'For i = 0 To Forms.Count - 1
        'Unload Forms(i)
    'Next
    
    closeCard
    
    
    'End
End Sub
Private Sub mnuAbout_Click()
    frmAbout.Show 1
End Sub

Private Sub mnuAddrTribute_Click()
    frmAddr.Show
End Sub

Private Sub mnuAuto_Click()
'status
    AppendStatusInfo "切换为自动采集模式", icoBLUE
    SaveLog "切换为自动采集模式", 0
    Auto_Manual = True
    mnuAuto.Checked = True
    mnuManual.Checked = False
End Sub

Private Sub mnuAutoWaste_Click()
    frmAutoWaste.Show
End Sub

Private Sub mnuBaseSet_Click()
    frmBaseAddr.Show
End Sub

Private Sub mnuBrow_Clear_Click()
    mnuHot1_Clear_Click
End Sub


Private Sub mnuBrow_curData_Click()
    frmViewCurData.Show
End Sub

Private Sub mnuBrow_Noticed_Click()
    mnuHot2_Noticed_Click
End Sub

Private Sub mnuBrow_Open_Click()
    frmMainInfo.Show
    BrowInfo = True
End Sub

Private Sub mnuBrowAlert_Click()
    frmBrowAlert.Show
End Sub


Private Sub mnuBuildSet_Click()
    frmBuildSet.Show
End Sub

Private Sub mnuCardData_Click()
    frmRWCard.Show
End Sub

Private Sub mnuCardSet_Click()
    frmICSet.Show
End Sub

Private Sub mnuChkAll_Click()
    frmCheckNet.Show
End Sub

Private Sub mnuChkBBus_Click()
    frmChkBBus.Show
End Sub



Private Sub mnuChkGate_Click()
    frmChkGate.Show
End Sub

Private Sub mnuClear_Click()
    frmDelData.Show
End Sub


Private Sub mnuCollect_Handup_Click()
    frmHandUp.Show
End Sub

Private Sub mnuCollectAll_Click()
    frmGetAll.Show
End Sub


Private Sub mnuCollectSome_Click()
    If f_frmUserMap_Visible Then
        MsgBox "请先退出'用户设置'界面!", 64, "指定用户采集"
        Exit Sub
    End If
    frmGetSome.Show
End Sub

Private Sub mnuExit_Click()
    Dim result
    result = MsgBox("确定要退出系统吗?", 1 + 32, "退出")
    If result = 1 Then
        Unload Me
    End If
End Sub

Private Sub mnuGateProcess_Click()
    frmGateProcess.Show

End Sub


Private Sub mnuGateSet_Click()
    frmGateSet.Show
End Sub

Private Sub mnuGetIn_Click()
    OPThen = 4
    frmAskWho.Show 1
End Sub

Sub mnuHot1_Clear_Click()
    If frmMainInfo.Enabled Then
'status
        AppendStatusInfo "清除状态信息窗口", icoBLUE
        SaveLog "清除状态信息窗口", 0
        frmMainInfo.lstStatus.ListItems.Clear
    End If
End Sub

Sub mnuHot2_Noticed_Click()
Dim curUserID As Integer
Dim rcUserMap As Recordset

        With frmMainInfo.grdUserFee
            If .Row > 0 Then
                curUserID = Val(.TextMatrix(.Row, 4))
                Set rcUserMap = dbCbb.OpenRecordset("UserMap", dbOpenDynaset)
                rcUserMap.FindFirst "UserID=" & curUserID
                If Not rcUserMap.NoMatch Then
                    rcUserMap.Edit
                    rcUserMap!CtrlStatus = 2
                    rcUserMap.Update
                End If
            End If
        End With
    FreshUserStatus
'status
    AppendStatusInfo "标注当前警告用户为'已通知'状态", icoBLUE
    SaveLog "标注当前警告用户为'已通知'状态", 0
End Sub

Private Sub mnuManual_Click()
'status
    AppendStatusInfo "切换为手工采集方式", icoBLUE
    SaveLog "切换为手工采集方式", 0
    Auto_Manual = False
    mnuAuto.Checked = False
    mnuManual.Checked = True
End Sub

Private Sub mnuManualWaste_Click()
    frmManualWaste.Show
End Sub

Private Sub mnuNetError_Click()
    frmNetError.Show
End Sub

Private Sub mnuOpenAlert_Click()
    mnuOpenAlert.Enabled = False
    tlbMain.Buttons.Item(10).Value = tbrPressed
    mnuShutAlert.Enabled = True
    
    initAlertPanel
    Load frmCurAlert
    frmCurAlert.Visible = False
    monAlert   'zx, for laptop test
End Sub


Private Sub mnuOPSetup_Click()
    OPThen = 1
    frmAskWho.Show 1
    
End Sub


Private Sub mnuPrice_Click()
    frmDevSet.Show
End Sub


Private Sub mnuQuery_Click()
    frmQuery.Show
End Sub

Private Sub mnuSafeWallProcess_Click()
    frmBuildProc.Show
End Sub


Private Sub mnuSet_AutoOpenLamp_Click()
    mnuSet_AutoOpenLamp.Checked = Not mnuSet_AutoOpenLamp.Checked
    gCurAutoOpenLamp = IIf(mnuSet_AutoOpenLamp.Checked, 1, 0)
End Sub

Private Sub mnuSet_AutoShut_Click()
    mnuSet_AutoShut.Checked = Not mnuSet_AutoShut.Checked