frmcomm.frm

来自「Atmel Atmeag128 AVR弹片机 随书原码」· FRM 代码 · 共 173 行

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form frmComm 
   BackColor       =   &H0000FFFF&
   Caption         =   "Comm"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
   Visible         =   0   'False
   Begin VB.Timer tmrWatchdog 
      Enabled         =   0   'False
      Interval        =   300
      Left            =   480
      Top             =   1440
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   480
      Top             =   360
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   0   'False
      RThreshold      =   1
   End
End
Attribute VB_Name = "frmComm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public Function fncInitializeComPort _
    (BitRate As Long, _
    PortNumber As Integer) _
    As Boolean

    'xDebug.Print "FncInitComPort"
    Dim ComSettings$
    If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
    
    MSComm1.CommPort = PortNumber
    ComSettings = Str(BitRate) & ",N,8,1"
    MSComm1.Settings = ComSettings
    MSComm1.InputLen = 1
    MSComm1.InBufferSize = 100
    MSComm1.RThreshold = 1
    MSComm1.InputMode = comInputModeText
    MSComm1.ParityReplace = ""
    MSComm1.NullDiscard = False
    MSComm1.EOFEnable = False
    MSComm1.DTREnable = False
    MSComm1.OutBufferSize = 1024
    MSComm1.SThreshold = 1
    MSComm1.Handshaking = comNone
    MSComm1.RTSEnable = False
    'Open the port.
    If MSComm1.PortOpen = False Then
        MSComm1.PortOpen = True
    Else
        MSComm1.PortOpen = False
        MSComm1.PortOpen = True
    End If
    'Return success or failure
    fncInitializeComPort = MSComm1.PortOpen

End Function

Public Sub MSComm1_OnComm()
    'Handles all Comm events
    Dim ComEventMessage As String
    Select Case MSComm1.CommEvent
        ' Events
    '    Case comEvCD
    '        ComEventMessage = "Change in the CD line."
    '    Case comEvCTS
    '        ComEventMessage = "Change in the CTS line."
    '    Case comEvDSR
    '        ComEventMessage = "Change in the DSR line."
    '    Case comEvRing
    '        ComEventMessage = "Change in the RI line."
        Case comEvReceive
    '        ComEventMessage = "Receive buffer has RThreshold number of characters."
             CharReceived (MSComm1.Input)
        Case comEvSend
            'xDebug.Print "Xmt buff empty"
            'ComEventMessage = "Transmit buffer has SThreshold number of characters."
        Case comEvEOF
    '        ComEventMessage = "EOF character (1Ah) received."
        'Errors
    '    Case comEventBreak
    '        ComEventMessage = "A Break was received."
    '    Case comEventCDTO
    '        ComEventMessage = "CD (RLSD) Timeout."
    '    Case comEventCTSTO
    '        ComEventMessage = "CTS Timeout."
    '    Case comEventDSRTO
    '       ComEventMessage = "DSR Timeout."
    '    Case comEventFrame
    '        ComEventMessage = "Framing Error"
    '    Case comEventOverrun
    '        ComEventMessage = "Overrun; data Lost."
    '    Case comEventRxOver
    '        ComEventMessage = "Receive buffer overflow."
    '    Case comEventRxParity
    '        ComEventMessage = "Parity Error."
    '    Case comEventTxFull
    '        ComEventMessage = "Transmit buffer full."
    '    Case comEventDCB
    '        ComEventMessage = "Unexpected error retrieving DCB."
    End Select
End Sub

'2 Byte Header Receive Routine - 3 byte header routine is called from here
Public Sub CharReceived(RecdChar As String)
    'xDebug.Print "Char: ", MSComm1.RThreshold, MSComm1.DTREnable
    'xDebug.Print RecdChar
    If RecdChar = Chr(10) Then
        Call CharMessageDone
    Else
        PP = PP + 1
        RcvBuff = RcvBuff & RecdChar
    End If
    
End Sub

Private Sub CharMessageDone()
    Dim j As Integer
    frmScroll.Scroll_Rcvd (RcvBuff)
    
    Select Case Mode
        Case "Volt1"
            If left(RcvBuff, 1) = "T" Then
                Call frmScroll.Calc(RcvBuff)
                Call frmScroll.UpdateChartArray
                Call frmChartGiga.PEgraph
                Call frmScroll.AlarmCalc
                Call frmScroll.DisplayMinMax
                Call frmScroll.ReformatBuff(RcvBuff)
            End If
        Case "Logic"
            If left(RcvBuff, 1) = "L" Then
                Call frmScroll.CalcLogic(RcvBuff)
                LogicPtr = LogicPtr + 1
                Debug.Print "L", LogicPtr
            End If
            If left(RcvBuff, 1) = "l" Then
                Debug.Print "Logic Done"
                Call frmPElogic.PELogicGraph(LogicPtr)
                LogicPtr = 0
                Mode = "Volt1"
            End If
    End Select
    
    RcvBuff = ""
    PP = 0
End Sub

Private Sub tmrWatchdog_Timer()
    'xDebug.Print "Watchdog - Threshold", frmComm.MSComm1.RThreshold, MSComm1.InputLen, mRFEnabled
    Call ResetPointers
End Sub

Private Sub ResetPointers()
    Dim Dummy As String
End Sub