frmmain.frm

监控类的开发

   End
   Begin VB.Image Image4 
      Height          =   90
      Left            =   3900
      Picture         =   "frmMain.frx":3F7D
      Top             =   420
      Width           =   90
   End
   Begin VB.Image Image13 
      Height          =   90
      Left            =   3345
      Picture         =   "frmMain.frx":4037
      Top             =   420
      Width           =   90
   End
   Begin VB.Image Image14 
      Height          =   90
      Left            =   2835
      Picture         =   "frmMain.frx":40F1
      Top             =   420
      Width           =   90
   End
   Begin VB.Image Image16 
      Height          =   90
      Left            =   2505
      Picture         =   "frmMain.frx":41AB
      Top             =   5955
      Width           =   90
   End
   Begin VB.Image Image18 
      Height          =   90
      Left            =   2085
      Picture         =   "frmMain.frx":4265
      Top             =   5955
      Width           =   90
   End
   Begin VB.Image Image19 
      Height          =   90
      Left            =   2355
      Picture         =   "frmMain.frx":431F
      Top             =   5595
      Width           =   90
   End
   Begin VB.Image Image20 
      Height          =   90
      Left            =   2805
      Picture         =   "frmMain.frx":43D9
      Top             =   5595
      Width           =   90
   End
   Begin VB.Line LineSwitch 
      BorderColor     =   &H000000FF&
      BorderWidth     =   3
      Index           =   0
      X1              =   2895
      X2              =   3395
      Y1              =   4800
      Y2              =   4800
   End
   Begin VB.Line LineSwitch 
      BorderColor     =   &H000000FF&
      BorderWidth     =   3
      Index           =   1
      X1              =   2625
      X2              =   3123
      Y1              =   5160
      Y2              =   5160
   End
   Begin VB.Line LineSwitch 
      BorderColor     =   &H000000FF&
      BorderWidth     =   3
      Index           =   2
      X1              =   2355
      X2              =   2853
      Y1              =   5520
      Y2              =   5520
   End
   Begin VB.Line LineSwitch 
      BorderColor     =   &H000000FF&
      BorderWidth     =   3
      Index           =   3
      X1              =   2085
      X2              =   2590
      Y1              =   5880
      Y2              =   5880
   End
   Begin VB.Image Image27 
      Height          =   435
      Left            =   540
      Picture         =   "frmMain.frx":4493
      Top             =   840
      Width           =   435
   End
   Begin VB.Image Image28 
      Height          =   435
      Left            =   1590
      Picture         =   "frmMain.frx":4ECD
      Top             =   840
      Width           =   435
   End
   Begin VB.Image Image12 
      Height          =   1080
      Left            =   2595
      Picture         =   "frmMain.frx":5907
      Top             =   1440
      Width           =   1650
   End
   Begin VB.Image Image3 
      Height          =   1080
      Left            =   480
      Picture         =   "frmMain.frx":B6A9
      Top             =   1440
      Width           =   2145
   End
   Begin VB.Image Image29 
      Height          =   1080
      Left            =   2595
      Picture         =   "frmMain.frx":1306B
      Top             =   3120
      Width           =   1650
   End
   Begin VB.Image Image2 
      Height          =   1080
      Left            =   480
      Picture         =   "frmMain.frx":18E0D
      Top             =   3120
      Width           =   2145
   End
   Begin VB.Shape Shape1 
      BackStyle       =   1  'Opaque
      Height          =   6015
      Left            =   240
      Top             =   240
      Width           =   4215
   End
   Begin VB.Shape Shape2 
      BackStyle       =   1  'Opaque
      Height          =   2775
      Left            =   4680
      Top             =   840
      Width           =   5295
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public Sub initialPRJ()
    strRecHex = ""
    TimerCommStartMark = False
    timerComm.Enabled = False
End Sub

Public Sub SetComStatus()
    If MSComm1.PortOpen = False Then
        imgNotConnected.ZOrder
        timerIn.Enabled = False
    Else
        imgConnected.ZOrder
        timerIn.Enabled = True
    End If
    
    StatusBar1.Panels("ComStatus").Text = "Status: " + GetComStatus(MSComm1)
    StatusBar1.Panels("Address").Text = "ADD: " + strADDress
    StatusBar1.Panels("tInterval").Text = "Interval: " + Trim(Str(timerIn.Interval) _
                                          \ 1000) + "S"
End Sub

Private Sub cmdClose_Click()
    If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
    timerComm.Enabled = False
    timerSignal.Enabled = False
    timerIn.Enabled = False
    Unload Me
End Sub

Private Sub DisplayStatus(bData As Byte)
    Dim I As Integer
    For I = 0 To 3
        If (bData And (2 ^ I)) <> 0 Then
            LineSwitch(I).Y1 = LineIN(I).Y1
            LineSwitch(I).Y2 = LineIN(I).Y1
        Else
            LineSwitch(I).Y1 = LineIN(I).Y1 - 120
            LineSwitch(I).Y2 = LineIN(I).Y1 - 120
        End If
    Next I
    
    If (bData And (2 ^ 4)) <> 0 And strSoundOut1 <> "" Then
        LineOUT1.Visible = True
        timerRing.Enabled = True
    Else
        LineOUT1.Visible = False
        timerRing.Enabled = False
    End If
    
    If (bData And (2 ^ 5)) <> 0 Then
        imgLamp.Visible = True
        LineOUT2.Visible = True
    Else
        imgLamp.Visible = False
        LineOUT2.Visible = False
    End If
End Sub

Private Sub cmdSetup_Click()
    frmSetup.Show vbModal
End Sub

Private Sub Form_Load()
    Dim CommPort As String
    Dim Handshaking As String
    Dim Settings As String
    Dim strTmp As String
    On Error Resume Next
      
    strTmp = App.Path + "\ding.wav"
    If CheckFile(strTmp) Then
        strSoundPath = strTmp
    Else
        strTmp = GetMyWinDir + "\Media\ding.wav"
        If CheckFile(strTmp) Then strSoundPath = strTmp
    End If
    
    strTmp = App.Path + "\ringin.wav"
    If CheckFile(strTmp) Then
        strSoundOut1 = strTmp
    Else
        strTmp = GetMyWinDir + "\Media\ringin.wav"
        If CheckFile(strTmp) Then strSoundOut1 = strTmp
    End If
    
    Call initialPRJ
      
    nMaxChars = 20
    
    Settings = GetSetting(App.Title, "Properties", "Settings", "")
    If Settings <> "" Then
        MSComm1.Settings = Settings
        If Err Then
            MsgBox Error$, vbExclamation + vbOKOnly
            Exit Sub
        End If
    End If
      
    CommPort = GetSetting(App.Title, "Properties", "CommPort", "")
    If CommPort <> "" Then MSComm1.CommPort = CommPort
     
    Handshaking = GetSetting(App.Title, "Properties", "Handshaking", "")
    If Handshaking <> "" Then
        MSComm1.Handshaking = Handshaking
        If Err Then
            MsgBox Error$, vbExclamation + vbOKOnly
            Exit Sub
        End If
    End If
    
    nEndMark = Val(GetSetting(App.Title, "Properties", "EndMark", ""))
    nBlockParity = Val(GetSetting(App.Title, "Properties", "BlockParity", ""))
    
    SoundMark = IIf(Val(GetSetting(App.Title, "Properties", "Sound", "")) _
                    = 1, True, False)
    If strSoundPath = "" Then SoundMark = False
    
    timerIn.Interval = Val(GetSetting(App.Title, "Properties", "lInterval", "")) * 1000
    strADDress = GetSetting(App.Title, "Properties", "ADDress", "")
    
    SetComStatus
End Sub

Private Sub imgConnected_Click()
    CloseMsComm MSComm1, 50
    SetComStatus
    bStatus = 0
    DisplayStatus bStatus
End Sub

Private Sub imgNotConnected_Click()
    If bSwitch = False Then
        MsgBox "Please setup at first!", vbCritical + vbOKOnly
        Exit Sub
    End If
  
    OpenAndAdjustPort MSComm1
    If Err.Number <> 0 Then
        MsgBox Error$, vbCritical + vbOKOnly
        GoTo END_MARK
    End If
    
    bStatus = 0  'reset status
  
END_MARK:
    SetComStatus
End Sub

Private Sub MSComm1_OnComm()
    Dim vInBuffer As Variant
    On Error Resume Next
      
    Select Case MSComm1.CommEvent
        'Events
        Case comEvReceive
            If TimerCommStartMark = False Then
                imgTxRed.ZOrder
                imgRxGreen.ZOrder
                timerSignal.Enabled = True
                Call initialPRJ  'This is the first package
                TimerCommStartMark = True
            End If
            
            vInBuffer = MSComm1.Input
            strRecHex = strRecHex + VariantToHexChars(vInBuffer)
                      
            'There is another package, so reset the commTimer.
            If TimerCommStartMark = True Then
                timerComm.Enabled = False
                timerComm.Enabled = True
            End If
                
        Case comEvSend
                
        Case comEvCTS
          'ResultString = ResultString + GetTimeStamp(0) + ":Change in the CTS line."
        Case comEvDSR
          'ResultString = ResultString + GetTimeStamp(0) + ":Change in the DSR line."
        Case comEvCD
          'ResultString = ResultString + GetTimeStamp(0) + ":Change in the CD line."
        Case comEvRing
          'ResultString = ResultString + GetTimeStamp(0) + ":Change in the Ring Indicator."
                
        ' Errors
        Case comEventBreak
          'ResultString = ResultString + GetTimeStamp(0) + ":A Break was received."
        Case comEventCDTO
          'ResultString = ResultString + GetTimeStamp(0) + ":CD (RLSD) Timeout."
        Case comEventCTSTO
          'ResultString = ResultString + GetTimeStamp(0) + ":CTS Timeout."
        Case comEventDSRTO
          'ResultString = ResultString + GetTimeStamp(0) + ":DSR Timeout."
        Case comEventFrame
          'ResultString = ResultString + GetTimeStamp(0) + ":Framing Error."
        Case comEventOverrun
          'ResultString = ResultString + GetTimeStamp(0) + ":Data Lost."
        Case comEventRxOver
          'ResultString = ResultString + GetTimeStamp(0) + ":Receive buffer overflow."
        Case comEventRxParity
          'ResultString = ResultString + GetTimeStamp(0) + ":Parity Error."
        Case comEventTxFull
          'ResultString = ResultString + GetTimeStamp(0) + ":Transmit buffer full."
        Case comEventDCB
          'ResultString = ResultString + GetTimeStamp(0) + ":Unexpected error retrieving DCB."
    End Select
End Sub

Private Sub timerComm_Timer()
    Dim strTmp As String
    Dim bTmp As Byte
    On Error Resume Next
    
    timerComm.Enabled = False
    TimerCommStartMark = False
    txtReceive.Text = strRecHex
    txtSend.Text = ""
    If SoundMark = True Then PlaySound strSoundPath, 0, SND_ASYNC
         
    If CheckPackage(strRecHex, nBlockParity, nEndMark) = False Then Exit Sub
    If Not (Mid(strRecHex, 1, 2) = EOT And Mid(strRecHex, 3, 2) = strADDress) Then Exit Sub
    
    If Mid(strRecHex, 5, 2) = "52" Then 'Read
        If Len(strRecHex) / 2 <> nReadLen Then Exit Sub
        If MSComm1.PortOpen = False Then Exit Sub
        strTmp = STX + strADDress + ByteToTwoHexChars(bStatus)
        imgRxRed.ZOrder
        imgTxGreen.ZOrder
        timerSignal.Enabled = True
        strTmp = SendData(MSComm1, strTmp, nBlockParity, nEndMark)
        txtSend.Text = strTmp
    End If
    
    If Mid(strRecHex, 5, 2) = "57" Then 'Write
        If Len(strRecHex) / 2 <> nWriteLen Then Exit Sub
        strTmp = Mid(strRecHex, 7, 2)
        bTmp = TwoHexCharsToByte(strTmp) And &H30
        bStatus = (bStatus And &HF) + bTmp
        DisplayStatus bStatus
    End If
End Sub

Private Sub timerIn_Timer()
    Dim bTmp As Byte
    bTmp = GetRandomByte(0, 4)
    bStatus = (bStatus And &HF0)
    If bTmp > 0 Then bStatus = bStatus + (2 ^ (bTmp - 1))
    DisplayStatus bStatus
End Sub

Private Sub timerRing_Timer()
    If (bStatus And (2 ^ 4)) <> 0 And strSoundOut1 <> "" Then
        PlaySound strSoundOut1, 0, SND_ASYNC
    End If
End Sub

Private Sub timerSignal_Timer()
    timerSignal.Enabled = False
    imgRxRed.ZOrder
    imgTxRed.ZOrder
End Sub