modCOMM - Written by: David M. Hitchner (1 Viewer)

Option Compare Database
Option Explicit

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


Public Function ReadScale()

On Error GoTo PROC_ERR

    Dim intPortID As Integer ' Ex. 1, 2, 3, 4 for COM1 - COM4
    Dim lngStatus As Long
    Dim strError  As String
    Dim strData   As String
    Dim sngStart As Single
    Dim intPollComResult As Integer '0 Timed Out, 1 Success, 2 Error
    
    intPortID = 1
    
    ' Initialize Communications
    lngStatus = CommOpen(intPortID, "COM" & CStr(intPortID), _
        "baud=9600 parity=E data=7 stop=2")
    
    If lngStatus <> 0 Then
        ' Handle error.
        lngStatus = CommGetError(strError)
        MsgBox "COM Error: " & strError
    End If
    

    ' Set modem control lines.
    lngStatus = CommSetLine(intPortID, LINE_RTS, True)
    lngStatus = CommSetLine(intPortID, LINE_DTR, True)
    
    'Write to Com Port
    lngStatus = CommWrite(intPortID, "P")
    
    If lngStatus <> 1 Then
        lngStatus = CommGetError(strError)
        MsgBox "COM Error: " & strError
        GoTo PROC_EXIT
    End If

    
    '*** Poll the Com Port.
    
    sngStart = Timer
    
    ' Infinite Loop with Exit Do
    Do
        
        ' Read maximum of 64 bytes from serial port.
        lngStatus = CommRead(intPortID, strData, 64)
        
        Select Case lngStatus
        
        Case 0 'No data was returned
        
            'Keep Trying to Poll the Com port.
            
        Case Is > 0  'Data was returned
        
            'Success
            intPollComResult = 1
            Exit Do

        
        Case Is < 0 ' Error occured
        
            intPollComResult = 2
            Exit Do
            
        End Select
        
        
        If Format(Timer - sngStart, "Fixed") < 4 Then
                
                Call Sleep(25)
            
        Else
            
            'Timed Out
            intPollComResult = 0
            Exit Do
        End If
        
    Loop

    
    'Com Poll Result.
    Select Case intPollComResult
    
    Case 0 'Timed Out
    
        Call MsgBox("The operation timed out!", vbOKOnly + vbExclamation + _
                  vbDefaultButton1, "WMS")
                  
    Case 1 ' Process data.
        
        
        MsgBox strData
    
    Case 2 ' Handle error.
        
        
        lngStatus = CommGetError(strError)
        MsgBox "COM Error: " & strError
    
    End Select


PROC_EXIT:
    
     ' Reset modem control lines.
    lngStatus = CommSetLine(intPortID, LINE_RTS, False)
    lngStatus = CommSetLine(intPortID, LINE_DTR, False)

    ' Close communications.
    Call CommClose(intPortID)
    
    Exit Function

PROC_ERR:
    MsgBox Err.Number, Err.Description, "modScale.ReadScale"
    Resume PROC_EXIT
    Resume

End Function

      Private Sub Form_Load()
         With MSComm1
            .CommPort = 2
            .Handshaking = 2 - comRTS
            .RThreshold = 1
            .RTSEnable = True
            .Settings = "9600,n,8,1"
            .SThreshold = 1
            .PortOpen = True
            ' Leave all other settings as default values.
         End With
         Text1.Caption = ""
      End Sub
 
      Private Sub Form_Unload(Cancel As Integer)
         MSComm1.PortOpen = False
      End Sub
 
      Private Sub MSComm1_OnComm()
         Dim InBuff As String
         Select Case MSComm1.CommEvent
         ' Handle each event or error by placing
         ' code below each case statement.
         ' This template is found in the Example
         ' section of the OnComm event Help topic
         ' in VB Help.
         ' Errors
            Case comEventBreak   ' A Break was received.
            Case comEventCDTO    ' CD (RLSD) Timeout.
            Case comEventCTSTO   ' CTS Timeout.
            Case comEventDSRTO   ' DSR Timeout.
            Case comEventFrame   ' Framing Error.
            Case comEventOverrun ' Data Lost.
            Case comEventRxOver  ' Receive buffer overflow.
            Case comEventRxParity   ' Parity Error.
            Case comEventTxFull  ' Transmit buffer full.
            Case comEventDCB     ' Unexpected error retrieving DCB]
         ' Events
            Case comEvCD   ' Change in the CD line.
            Case comEvCTS  ' Change in the CTS line.
            Case comEvDSR  ' Change in the DSR line.
            Case comEvRing ' Change in the Ring Indicator.
            Case comEvReceive ' Received RThreshold # of chars.
               InBuff = MSComm1.Input
               Call HandleInput(InBuff)
            Case comEvSend ' There are SThreshold number of
                           ' characters in the transmit buffer.
            Case comEvEOF  ' An EOF character was found in the
                           ' input stream.
         End Select
      End Sub
 
      Sub HandleInput(InBuff As String)
         ' This is where you will process your input. This
         ' includes trapping characters, parsing strings,
         ' separating data fields, etc. For this case, you
         ' are simply going to display the data in the TextBox.
'         Text1.SelStart = Len(Text1.Text)
         Text1.Caption = Text1.Caption & InBuff
      End Sub

Option Compare Database
Option Explicit
Private Sub Form_Load()
   With MSComm1
     .CommPort = 2
'     .Handshaking = 2 - comRTS
'     .Handshaking = comXOnXoff
'     .Handshaking = comNone
'     .Handshaking = comRTSXOnXOff
     .Handshaking = comRTS
     .RThreshold = 1
     .RTSEnable = True
     .Settings = "9600,n,8,1"
     .SThreshold = 1
     .PortOpen = True
     .InputLen = 30000
     .InputMode = comInputModeText
  End With
  Text1.Caption = ""
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
  MSComm1.PortOpen = False
End Sub
 
Private Sub MSComm1_OnComm()
  Text1.Caption = Text1.Caption & MSComm1.Input
End Sub

Option Compare Database
Option Explicit
 
Private Sub Form_Load()
  MSComm1.PortOpen = True                           ' Open port
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
  MSComm1.PortOpen = False                          ' Close port
End Sub
 
Private Sub MSComm1_OnComm()
  lblLight.BackColor = 65280                        ' Turn ON Green indicator
  Text1.Caption = Text1.Caption & MSComm1.Input     ' Append input data
End Sub