frmmain.frm

一个为公安系统接警中心控制软件,不错哦.

Dim ReceiveBuffer As String

Public Sub SetOkCheck()
    mnuCommSetting.Enabled = m_gbManufacturer
    
    mnuSetAlarmSign.Enabled = m_gbManufacturer ' Or m_gbSuperMan Or m_gbSystemMan
    tbToolBar.Buttons(1).Enabled = mnuSetAlarmSign.Enabled
    
    mnuOperator.Enabled = m_gbSuperMan
    tbToolBar.Buttons(2).Enabled = mnuOperator.Enabled
    
    mnuDefaultZone.Enabled = m_gbManufacturer ' Or m_gbSuperMan Or m_gbSystemMan
    tbToolBar.Buttons(3).Enabled = mnuDefaultZone.Enabled
    
    mnuSimulation.Enabled = m_gbManufacturer Or m_gbSuperMan
    
    mnuChangeManager.Enabled = m_gbSuperMan
    tbToolBar.Buttons(7).Enabled = mnuChangeManager.Enabled
    
    mnuExit.Enabled = m_gbManufacturer
    
    mnuUserEdit.Enabled = m_gbManufacturer Or m_gbSuperMan
    tbToolBar.Buttons(9).Enabled = mnuUserEdit.Enabled
    
    mnuUserBrowser.Enabled = m_gbManufacturer Or m_gbSuperMan
    tbToolBar.Buttons(10).Enabled = mnuUserBrowser.Enabled
    
    Dim i As Integer
    If m_gbManufacturer Then
        RestoreMenu Me
        For i = 0 To 2
            DeleteMenuItem Me, 0    '删除系统菜单中的恢复、移动、大小项
        Next
    Else
        For i = 0 To 6
            DeleteMenuItem Me, 0    '删除系统菜单
        Next
    End If
    '设置窗口最大化、最小化按钮属性
    Call PutWindowOnTop(Me, Not m_gbManufacturer)
End Sub

Private Function ProcessReceivedInfo(RecivedStr As String)
    Dim AccountCode As String, EventCode As String, ZoneCode As String
    Dim nPos As Integer
    
    nPos = InStr(1, RecivedStr, "@")
    If nPos > 0 Then Exit Function

    AccountCode = Mid(RecivedStr, 11, 4)
    EventCode = Mid(RecivedStr, 16, 1)
    ZoneCode = Mid(RecivedStr, 19, 2)
    ZoneCode = Format(ZoneCode, "00")
    
    FrmProcessEvent.AddNewAlarmEvent AccountCode, EventCode, ZoneCode
End Function

Private Sub MDIForm_Load()
    Me.Left = 0
    Me.Top = 0
    Me.Width = Screen.Width
    Me.Height = Screen.Height
    
    ComSetting
    FrmProcessEvent.Show
    SetOkCheck
End Sub

Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If m_gbManufacturer Then
        RegisterEnvironmentVar (False)
        DisableHostReset (False)
        End
    Else
        Cancel = True
    End If
End Sub

Private Sub MDIForm_Resize()
    On Error Resume Next
    
    
End Sub

Private Sub mnuAccountAlarmQuery_Click()
    frmAlarmQuery.Show
    frmAlarmQuery.SetFocus
End Sub

Private Sub mnuChangeManager_Click()
    FrmChangeManager.Show vbModal
End Sub

Private Sub mnuChangePassword_Click()
    FrmChangePassword.Show vbModal
End Sub

Private Sub mnuCommSetting_Click()
    frmProperties.Show
End Sub

Private Sub mnuDefaultZone_Click()
    frmdefaultzone.Show
End Sub

Private Sub mnuExit_Click()
    Unload Me
End Sub

Private Sub mnuOperator_Click()
    frmOperator.Show
    frmOperator.SetFocus
End Sub

Private Sub mnuOperatorLogin_Click()
    Dim frm As Form
    
    frmLogin.Show vbModal
    If frmLogin.OK Then
        RegisterEnvironmentVar (True)
        SetOkCheck
        
        '如果报警屏幕正在处理报警事件, 更改操作员后应相应改变该屏幕显示的值班员姓名
        Set frm = GetForm(FrmProcessEvent)
        If Not frm Is Nothing Then
            frm.DisplayWatchMan
        End If
    End If
    Unload frmLogin
End Sub

Private Sub mnuReceiverAlarmQuery_Click()
    frmRecAlarmQuery.Show
    frmRecAlarmQuery.SetFocus
End Sub

Private Sub mnuSetAlarmSign_Click()
    FrmSetAlarmSign.Show
    FrmSetAlarmSign.SetFocus
End Sub

Private Sub mnuSimulation_Click()
    frmSimulation.Show vbModal
End Sub

Private Sub mnuUserBrowser_Click()
    frmBrowseAccount.Show
End Sub

Private Sub mnuUserEdit_Click()
    Let frmAccountEdit.ShowType = 0
    frmAccountEdit.Show vbModal
End Sub

Private Static Sub MSComm1_OnComm()
    Dim EVMsg$
    Dim ERMsg$
    
    ' 依据 CommEvent 属性进行分支
    Select Case MSComm1.CommEvent
        ' 事件信息
        Case comEvReceive
            Dim Buffer As Variant, nPos As Integer
            Dim ReceiveStr As String, sTemp As String
            
            Buffer = MSComm1.Input
            ReceiveStr = StrConv(Buffer, vbUnicode)
            ReceiveBuffer = ReceiveBuffer & ReceiveStr
            
            nPos = InStr(1, ReceiveBuffer, Chr(20))
            Do While nPos > 0
                ReceiveStr = Left(ReceiveBuffer, nPos)
                ReceiveBuffer = Mid(ReceiveBuffer, nPos + 1)
                
                sTemp = "接收信息长度 " & Len(ReceiveStr) & "内容 " & ReceiveStr & "时间" & Format(Date, "YYYY年MM月DD日") & Format(Time, "Long Time")
                WriteFile (sTemp)
                Me.sbStatusBar.Panels(1).Text = sTemp
                
                If nPos = 21 Then
                    ProcessReceivedInfo (ReceiveStr)
                End If
                nPos = InStr(1, ReceiveBuffer, Chr(20))
            Loop
            MSComm1.Output = Chr(6)     '回发ACK(ASCII 0x06)响应信号
        Case comEvSend
        Case comEvCTS
            EVMsg$ = "被检测的 CTS 改变"
        Case comEvDSR
            EVMsg$ = "被检测的 DSR 改变"
        Case comEvCD
            EVMsg$ = "被检测的 CD 改变"
        Case comEvRing
            EVMsg$ = "电话铃响起"
        Case comEvEOF
            EVMsg$ = "被检测的文件结尾"

        ' Error messages.
        Case comBreak
            ERMsg$ = "收到中断"
        Case comCDTO
            ERMsg$ = "运输检测超时"
        Case comCTSTO
            ERMsg$ = "CTS 超时"
        Case comDCB
            ERMsg$ = "检索 DCB 错误"
        Case comDSRTO
            ERMsg$ = "DSR 超时"
        Case comFrame
            ERMsg$ = "帧错误"
        Case comOverrun
            ERMsg$ = "超限错误"
        Case comRxOver
            ERMsg$ = "接收缓冲区溢出"
        Case comRxParity
            ERMsg$ = "奇偶校验错"
        Case comTxFull
            ERMsg$ = "传送缓冲区满"
        Case Else
            ERMsg$ = "未知的错误或事件"
    End Select
End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As MSComctlLib.Button)
    On Error Resume Next
    Select Case UCase(Button.Key)
        Case UCase("SetSign")
            mnuSetAlarmSign_Click
        Case UCase("Operator")
            mnuOperator_Click
        Case UCase("DefaultZone")
            mnuDefaultZone_Click
        Case UCase("Login")
            mnuOperatorLogin_Click
        Case UCase("ChangePass")
            mnuChangePassword_Click
        Case UCase("ChangeManager")
            mnuChangeManager_Click
        Case UCase("AccountEdit")
            mnuUserEdit_Click
        Case UCase("AccountView")
            mnuUserBrowser_Click
        Case UCase("AccountAlarmQuery")
            mnuAccountAlarmQuery_Click
        Case UCase("ReceiverAlarmQuery")
            mnuReceiverAlarmQuery_Click
        Case UCase("About")
            mnuHelpAbout_Click
    End Select
End Sub

Private Sub mnuHelpAbout_Click()
    frmAbout.Show vbModal, Me
End Sub

Private Sub mnuHelpSearchForHelpOn_Click()
    Dim nRet As Integer


    '如果这个工程没有帮助文件，显示消息给用户
    '可以在“工程属性”对话框中为应用程序设置帮助文件
    If Len(App.HelpFile) = 0 Then
        MsgBox "无法显示帮助目录，该工程没有相关联的帮助。", vbInformation, Me.Caption
    Else

    On Error Resume Next
        nRet = OSWinHelp(Me.hwnd, App.HelpFile, 261, 0)
        If Err Then
            MsgBox Err.Description
        End If
    End If

End Sub

Private Sub mnuHelpContents_Click()
    Dim nRet As Integer


    '如果这个工程没有帮助文件，显示消息给用户
    '可以在“工程属性”对话框中为应用程序设置帮助文件
    If Len(App.HelpFile) = 0 Then
        MsgBox "无法显示帮助目录，该工程没有相关联的帮助。", vbInformation, Me.Caption
    Else
        On Error Resume Next
        nRet = OSWinHelp(Me.hwnd, App.HelpFile, 3, 0)
        If Err Then
            MsgBox Err.Description
        End If
    End If

End Sub

Private Sub mnuWindowTileVertical_Click()
    Me.Arrange vbTileVertical
End Sub

Private Sub mnuWindowTileHorizontal_Click()
    Me.Arrange vbTileHorizontal
End Sub

Private Sub mnuWindowCascade_Click()
    Me.Arrange vbCascade
End Sub