Kod w Visual Basic do odczytu temperatury z czujnika DS1820

Option Explicit

' clsComReader
'
' 1. instantiate
' 2. set timer & (optional) Interval
' 3. set comm (that will start the first measurement)
'
' 4. handle GotData or read Measurement & MeasurementTime
'
' does one measurement only when interval not set or set to 0
' you can force next measurement calling RequestMeasurement
' use GotData callback or wait for MeasurementTime <> "" to get the first value
'

Public Event GotData()

Private Const MEASUREMENT_DELAY = 1400

Private buffer As Variant
Private mTemperature As String
Private mMeasurementTime As Date
Private mInterval As Long ' milliseconds
Private mSendRequest As Boolean

Private WithEvents otimer As Timer
Private WithEvents oComm As MSComm


Public Property Set Timer(ByVal Value As Timer)
    Set otimer = Value
End Property


Public Property Set CommControl(ByVal Value As MSComm)
    
    Set oComm = Value
    ' 9600 baud, no parity, 8 data, and 1 stop bit.
    oComm.Settings = "9600,N,8,1"
    ' Tell the control to read entire buffer when Input is used.
    oComm.InputLen = 0
    oComm.DTREnable = False
    oComm.PortOpen = True
    RequestMeasurement

End Property


Public Property Let Interval(ByVal Value As Long)
    
    If Value > 0 Then
        mInterval = Value - MEASUREMENT_DELAY
        If mInterval < 0 Then
            mInterval = 10
        End If
    Else
        mInterval = 0
    End If

End Property


Public Property Get Interval() As Long
    
    If mInterval > 0 Then
        Interval = mInterval + MEASUREMENT_DELAY
    Else
        Interval = 0
    End If

End Property


Public Property Get Measurement() As String
    
    Measurement = mTemperature

End Property


Public Property Get MeasurementTime() As String
    
    MeasurementTime = mMeasurementTime

End Property


Public Sub RequestMeasurement()

    otimer.Interval = MEASUREMENT_DELAY
    oComm.Output = buffer
    mSendRequest = False

End Sub


Private Sub Class_Initialize()

    buffer = "D0" & vbCr
    mInterval = 0
    mSendRequest = False

End Sub


Private Sub oCom_OnComm()

End Sub

Private Sub oTimer_Timer()

    If mSendRequest Then
        RequestMeasurement
    Else
        otimer.Interval = mInterval
        mMeasurementTime = Now()
        mTemperature = oComm.Input
        mSendRequest = True
        RaiseEvent GotData
    End If

End Sub


Private Sub oComm_OnComm()
    
    Select Case oComm.CommEvent
   ' Handle each event or error by placing
   ' code below each case statement

   ' Errors
      Case comEventBreak   ' A Break was received.
'        Me.Label1.Caption = "br"
      Case comEventFrame   ' Framing Error
'        Me.Label1.Caption = "fr"
      Case comEventOverrun   ' Data Lost.
'        Me.Label1.Caption = "ov"
      Case comEventRxOver   ' Receive buffer overflow.
'        Me.Label1.Caption = "rx"
      Case comEventRxParity   ' Parity Error.
'        Me.Label1.Caption = "pa"
      Case comEventTxFull   ' Transmit buffer full.
'        Me.Label1.Caption = "full"
      Case comEventDCB   ' Unexpected error retrieving DCB]
'        Me.Label1.Caption = "dcb"

   ' Events
      Case comEvCD   ' Change in the CD line.
''        Me.Label1.Caption = "cd " & MSComm1.Input
      Case comEvCTS   ' Change in the CTS line.
''        Me.Label1.Caption = "cts " & MSComm1.Input
      Case comEvDSR   ' Change in the DSR line.
''        Me.Label1.Caption = "dts"
      Case comEvRing   ' Change in the Ring Indicator.
''        Me.Label1.Caption = "ring"
      Case comEvReceive   ' Received RThreshold # of
                        ' chars.
 '       Me.Label1.Caption = "R " & MSComm1.Input
      Case comEvSend   ' There are SThreshold number of
                     ' characters in the transmit
                     ' buffer.
 '       Me.Label1.Caption = "send"
      Case comEvEOF   ' An EOF charater was found in
                     ' the input stream
 '       Me.Label1.Caption = "E " & MSComm1.Input
   End Select

End Sub


Private Sub Class_Terminate()

    otimer.Interval = 0
    oComm.PortOpen = False
    Set otimer = Nothing
    Set oComm = Nothing

End Sub