Elektroda.pl
Elektroda.pl
X
Please add exception to AdBlock for elektroda.pl.
If you watch the ads, you support portal and users.

DS1820 pod Visual Basic

koronen 02 May 2007 19:26 2830 3
  • #1
    koronen
    Level 10  
    Ma ktoś może jakiś kodzik w VB umożliwiający odczyt temeperatury z DS1820?

    Pozdrawiam
  • #2
    robert dudziak
    Level 12  
    Code:
    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


    Dodano po 3 [minuty]:

    http://smarthvac.com/ow.asp?ComReader

    Kliknik Pozdrawiam

    Kod proszę umieszczać w znacznikach code - krzychoocpp
  • #3
    yasiu13
    Level 12  
    Witam, czy to działa ? ja sobie nie mogę z tym poradzić tworzę forme dodaje kontrolke mscomm i timer czy jeszcze trzeba cos zrobic zeby program zadziałał?

    - w obecnej formie otrzymuje date godzine, ale brak odczytu temperatury mam adapter ds9097e. Bardzo prosze o pomoc
  • #4
    tzok
    Moderator of Cars
    Wejdź sobie na stronę podaną wyżej, masz tam napisane co ma się znaleźć w klasie clsComReader a co na formie.