frmmain.frm

这是一本学习串口编程喝计算机监控的好书里面是用VB开发的源代码

      Top             =   5280
      Visible         =   0   'False
      Width           =   390
   End
   Begin VB.Image Image1 
      Height          =   3585
      Left            =   0
      Picture         =   "frmMain.frx":1D1E
      Top             =   2880
      Width           =   6360
   End
   Begin VB.Label Label15 
      Alignment       =   2  'Center
      Caption         =   "Power"
      Height          =   255
      Left            =   2640
      TabIndex        =   1
      Top             =   2400
      Width           =   615
   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

Private Sub DisplayCmd()
    If (MSComm1.PortOpen = False) Or (nWorkMode = MODE_AUTO) Then
        cmdLampOn.Enabled = False
        cmdLampOff.Enabled = False
        cmdRingOn.Enabled = False
        cmdRingOff.Enabled = False
        cmdInq.Enabled = False
    Else
        cmdLampOn.Enabled = True
        cmdLampOff.Enabled = True
        cmdRingOn.Enabled = True
        cmdRingOff.Enabled = True
        cmdInq.Enabled = True
    End If
End Sub

Public Sub SetComStatus()
    If MSComm1.PortOpen = False Then
        imgNotConnected.ZOrder
        timerIn.Enabled = False
    Else
        imgConnected.ZOrder
        If nWorkMode = MODE_AUTO Then timerIn.Enabled = True
    End If
    
    DisplayCmd
    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
    timerIn.Enabled = False
    Unload Me
End Sub

Private Sub DisplayStatus(bData As Byte)
    Dim I As Integer
    Dim bInput As Byte
    Dim bOut As Byte
    Dim bSend As Boolean
    Dim bControl As Byte
    
    bInput = bData And &HF
    bOut = bData And &H30
    
    For I = 0 To 3
        If (bData And (2 ^ I)) <> 0 Then
            imgCar(I).Visible = True
        Else
            imgCar(I).Visible = False
        End If
    Next I
    
    If (bData And (2 ^ 4)) <> 0 Then
        optRing(0).Value = True
    Else
        optRing(1).Value = True
    End If
    
    If (bData And (2 ^ 5)) <> 0 Then
        optLamp(0).Value = True
    Else
        optLamp(1).Value = True
    End If
    
    If nWorkMode = MODE_AUTO Then
        Select Case bInput
            Case 0
                If bOut <> 0 Then
                    bControl = 0
                    bSend = True
                End If
            Case 1, 2, 4
                If bOut <> &H20 Then
                    bControl = &H20
                    bSend = True
                End If
            Case 8
                If bOut <> &H30 Then
                    bControl = &H30
                    bSend = True
                End If
        End Select
        
        If bSend = True Then
            SendData MSComm1, EOT + strADDress + WD + ByteToTwoHexChars(bControl), _
                      nBlockParity, nEndMark
        End If
    End If
End Sub

Private Sub cmdInq_Click()
    Dim strTmp As String
    strTmp = EOT + strADDress + RD
    SendData MSComm1, strTmp, nBlockParity, nEndMark
End Sub

Private Sub cmdLampOff_Click()
    Dim bTmp As Byte
    
    bTmp = bStatus And &HDF
    SendData MSComm1, EOT + strADDress + WD + ByteToTwoHexChars(bTmp), _
             nBlockParity, nEndMark
    
    DelayTime 100
End Sub

Private Sub cmdLampOn_Click()
    Dim bTmp As Byte
    
    bTmp = bStatus Or &H20
    SendData MSComm1, EOT + strADDress + WD + ByteToTwoHexChars(bTmp), _
              nBlockParity, nEndMark
    
    DelayTime 100
End Sub

Private Sub cmdRingOff_Click()
    Dim bTmp As Byte
    
    bTmp = bStatus And &HEF
    SendData MSComm1, EOT + strADDress + WD + ByteToTwoHexChars(bTmp), _
             nBlockParity, nEndMark
    
    DelayTime 100
End Sub

Private Sub cmdRingOn_Click()
    Dim bTmp As Byte
    
    bTmp = bStatus Or &H10
    SendData MSComm1, EOT + strADDress + WD + ByteToTwoHexChars(bTmp), _
             nBlockParity, nEndMark
    
    DelayTime 100
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
      
    SetWindowPos frmMain.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
    
    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", ""))
    
    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
                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 optMode_Click(Index As Integer)
    If Index = 0 Then
        nWorkMode = MODE_AUTO
    Else
        nWorkMode = MODE_MANUAL
        timerIn.Enabled = False
    End If
    
    SetComStatus
End Sub

Private Sub timerComm_Timer()
    Dim strTmp As String
    On Error Resume Next
    
    timerComm.Enabled = False
    TimerCommStartMark = False
         
    If CheckPackage(strRecHex, nBlockParity, nEndMark) = False Then Exit Sub
    If Not (Mid(strRecHex, 1, 2) = STX And Mid(strRecHex, 3, 2) = strADDress) _
            Then Exit Sub
    If Len(strRecHex) / 2 <> nReplyLen Then Exit Sub
    
    strTmp = Mid(strRecHex, 5, 2)
    bStatus = TwoHexCharsToByte(strTmp)
    DisplayStatus bStatus
End Sub

Private Sub timerIn_Timer()
    Dim strTmp As String
    
    If MSComm1.PortOpen = False Then Exit Sub
    
    strTmp = EOT + strADDress + RD
    SendData MSComm1, strTmp, nBlockParity, nEndMark
End Sub