Code:
Dim Dsid1(8) As Byte 'Dallas ID 64 bits incl CRC
Dim Dsid2(8) As Byte
Dim Dsid3(8) As Byte
Dim Dsid4(8) As Byte
Dim Sc(9) As Byte 'Scratchpad 0-8 72 bits incl CRC, explanations for DS18b20
Cls
Setfont Font8x8
W = 1wirecount()
Dsid1(1) = 1wsearchfirst()
Dsid2(1) = 1wsearchnext()
Dsid3(1) = 1wsearchnext()
Dsid4(1) = 1wsearchnext()
If Dsid1(8) = Crc8(dsid1(1) , 7) Then ' Control that the received CRC match the calculated
Lcdat 1 , 1 , "CRC OK Sensor 1"
Wait 1
Lcdat 2 , 1 , Hex(dsid1(1))
For B = 2 To 8
Lcd Hex(dsid1(b))
Next
End If
If Dsid2(8) = Crc8(dsid2(1) , 7) Then
Lcdat 3 , 1 , "CRC OK Sensor 2"
Wait 1
Lcdat 4 , 1 , Hex(dsid2(1))
For B = 2 To 8
Lcd Hex(dsid2(b))
Next
End If
If Dsid3(8) = Crc8(dsid3(1) , 7) Then
Lcdat 5 , 1 , "CRC OK Sensor 3"
Wait 1
Lcdat 6 , 1 , Hex(dsid3(1))
For B = 2 To 8
Lcd Hex(dsid3(b))
Next
End If
If Dsid4(8) = Crc8(dsid4(1) , 7) Then
Lcdat 7 , 1 , "CRC OK Sensor 4"
Wait 1
Lcdat 8 , 1 , Hex(dsid4(1))
For B = 2 To 8
Lcd Hex(dsid4(b))
Next
End If
Wait 5
Cls
Call Init
' Main loop
Do
Call Convallt ' "Convert ALL T on the 1w-bus"
'Waitus 100 :
1wverify Dsid1(1) 'Issues the "Match ROM "
Locate 1 , 1
If Err = 1 Then
Lcdat 9 , 1 , "Err " , 0 'Err = 1 if something is wrong,
Elseif Err = 0 Then 'lcd " Sensor found"
1wwrite &HBE
Sc(1) = 1wread(9) 'read bytes into array
If Sc(9) = Crc8(sc(1) , 8) Then
Dg = Decigrades(sc(9))
If Min1 > Dg Then
Min1 = Dg
Emin1 = Min1
End If
If Max1 < Dg Then
Max1 = Dg
Emax1 = Max1
End If
Lcdat 1 , 1 , Dg , 0 : Lcd " " : Lcd Min1 : Lcd " " : Lcd Max1
Print Date$ ; "-" ; Time$ ; "-" ; "S1" ; Dg
End If
End If
1wverify Dsid2(1)
Locate 2 , 1
If Err = 1 Then
Lcd "DsId2 not on bus "
Elseif Err = 0 Then
1wwrite &HBE
Sc(1) = 1wread(9)
If Sc(9) = Crc8(sc(1) , 8) Then
Dg = Decigrades(sc(9))
Dg = Dg - 3
If Min2 > Dg Then
Min2 = Dg
Emin2 = Min2
End If
If Max2 < Dg Then
Max2 = Dg
Emax2 = Max2
End If
Lcdat 2 , 1 , Dg , 0 : Lcd " " : Lcd Min2 : Lcd " " : Lcd Max2
Print Date$ ; "-" ; Time$ ; "-" ; "S2" ; Dg
End If
End If
1wverify Dsid3(1)
Locate 3 , 1
If Err = 1 Then
Lcd "DsId3 not on bus "
Elseif Err = 0 Then
1wwrite &HBE
Sc(1) = 1wread(9)
If Sc(9) = Crc8(sc(1) , 8) Then
Dg = Decigrades(sc(9))
Dg = Dg - 2
If Min3 > Dg Then
Min3 = Dg
Emin3 = Min3
End If
If Max3 < Dg Then
Max3 = Dg
Emax3 = Max3
End If
Lcdat 3 , 1 , Dg , 0 : Lcd " " : Lcd Min3 : Lcd " " : Lcd Max3
Print Date$ ; "-" ; Time$ ; "-" ; "S3" ; Dg
End If
End If
1wverify Dsid4(1)
Locate 4 , 1
If Err = 1 Then
Lcd "DsId4 not on bus "
Elseif Err = 0 Then
1wwrite &HBE
Sc(1) = 1wread(9)
If Sc(9) = Crc8(sc(1) , 8) Then
Dg = Decigrades(sc(9))
If Min4 > Dg Then
Min4 = Dg
Emin4 = Min4
End If
If Max4 < Dg Then
Max4 = Dg
Emax4 = Max4
End If
Lcdat 4 , 1 , Dg , 0 : Lcd " " : Lcd Min4 : Lcd " " : Lcd Max4
Print Date$ ; "-" ; Time$ ; "-" ; "S4" ; Dg
End If
End If
For I = 1 To 10
Test = 11 - I
If Test < 10 Then
Lcdat 6 , 1 , "0" , 0
Lcd Test
Else
Lcdat 6 , 1 , Test , 0
End If
Wait 1
Next I
Loop
End
Sub Init
Cls
Min1 = Emin1 ' to get a real value from start
Min2 = Emin2
Max1 = Emax1
Max2 = Emax2
Min3 = Emin3 ' to get a real value from start
Min4 = Emin4
Max3 = Emax3
Max4 = Emax4
End Sub
Sub Convallt
1wreset ' reset the bus
1wwrite &HCC ' skip rom
1wwrite &H44
Set Portb.3
Waitms 800
Reset Portb.3 ' Convert T
End Sub
Function Decigrades(byval Sc(9) As Byte)
Dim Tmp As Byte , T As Integer , T1 As Integer
Tmp = Sc(1) And 1 ' 0.1C precision
If Tmp = 1 Then Decr Sc(1)
T = Makeint(sc(1) , Sc(2))
T = T * 50 'here we calculate the 1/10 precision like
T = T - 25 'DS18S20 data sheet
T1 = Sc(8) - Sc(7)
T1 = T1 * 100
T1 = T1 / Sc(8)
T = T + T1
Decigrades = T / 10
End Function
Zitieren
Lesezeichen