rscom.bas

来自「1. Chromaticity Measurement Software (Ca」· BAS 代码 · 共 124 行

Attribute VB_Name = "RsCom"
Option Explicit

Public comFrm  As Object            'Object of MScomm

Type COMMSETTING
    intCommPort As Integer          'Port Number
    strSettings As String           'Setting
    intInputLen As Integer          'InputLen
End Type

Public usrCom As COMMSETTING        'COM Setting
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' Send Data
'
'Parameter丗
'       strSendString:Send Characters
'
'
'Return Value丗
'       Nothing
'
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Public Sub COM_Send(strSendString As String)
    
    comFrm.Output = strSendString & vbCr
    Do
    Loop Until (comFrm.OutBufferCount = 0)

End Sub

'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' Receive Data
'
'Parameter丗
'       tout:Time out (S)
'       strReceiveString:Receive Characters
'
'
'Return Value丗
'       0   Success
'       1   Time out (No character)
'       2   Time out (Halfway)
'
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Public Function COM_Receive(ByVal tout As Integer, strReceiveString As String) As Integer
    
    Dim strBuffer As String
    Dim blnFlag As Boolean
    Dim sngWStart As Single

    sngWStart = Timer
    strBuffer = ""
    Do
        If comFrm.InBufferCount = 0 Then
            If blnFlag Then
                If Timer - sngWStart > tout Then GoTo TimeOut 'Timeout(Seconds)
            Else
                blnFlag = True
                sngWStart = Timer
            End If
        Else
            strBuffer = strBuffer & comFrm.Input
            blnFlag = False
        End If
        
    Loop Until (Right(strBuffer, 1) = vbCr Or Right(strBuffer, 1) = vbLf Or Right(strBuffer, 1) = vbLf + vbCr)
    strReceiveString = strBuffer

    COM_Receive = 0
    Exit Function

TimeOut:
    If strBuffer = "" Then
        COM_Receive = 1
    Else
        COM_Receive = 2
        strReceiveString = strBuffer
    End If
    Exit Function

End Function

'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'Com port close
'
'Parameter丗
'       nothing
'
'Return Value丗
'       nothing
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Public Sub COM_Close()
    
    comFrm.PortOpen = False

End Sub

'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'Com port open
'
'Parameter丗
'       usrSetting:structure
'
'Return Value丗
'       nothing
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Public Sub COM_Open(usrSetting As COMMSETTING)
  
  With comFrm
    .RThreshold = 1
    .SThreshold = 1
    .CommPort = usrSetting.intCommPort
    .Settings = usrSetting.strSettings
    .InputLen = usrSetting.intInputLen
    .Handshaking = comRTS
    .DTREnable = True
    .RTSEnable = True
    .PortOpen = True
  End With

End Sub