$regfile = "m8def.DAT"
$crystal = 1000000

Config Lcdpin = Pin , Db4 = Portb.0 , Db5 = Portb.1 , Db6 = Portb.2 , Db7 = Portb.3 , E = Portb.4 , Rs = Portb.5
Config Lcd = 16 * 2
Initlcd
Cursor Off
Cls

'1WIRE _________________________________________________________________________
Config 1wire = Portd.5
Declare Function Decigrades(byval Sc(9) As Byte , Byval Family As Byte) As Integer
Dim Temp1 As Integer
Dim Temp2 As Integer
Dim Temp3 As Integer
Dim Temp4 As Integer
Dim Sc(9) As Byte
Dim Dsid1(8) As Byte
Dim Dsid2(8) As Byte
Dim Dsid3(8) As Byte
Dim Dsid4(8) As Byte
Dim I As Byte
Dim W As Word
W = 1wirecount()

Select Case W

Case 0
Do
W = 1wirecount()
Cls
Lcd "Nincs szenzor!"
Wait 1
Loop

Case 1
Dsid1(1) = 1wsearchfirst()
Dsid2(1) = 00
Dsid3(1) = 00
Dsid4(1) = 00

Case 2
Dsid1(1) = 1wsearchfirst()
Dsid2(1) = 1wsearchnext()
Dsid3(1) = 00
Dsid4(1) = 00

Case 3
Dsid1(1) = 1wsearchfirst()
Dsid2(1) = 1wsearchnext()
Dsid3(1) = 1wsearchnext()
Dsid4(1) = 00

Case 4
Dsid1(1) = 1wsearchfirst()
Dsid2(1) = 1wsearchnext()
Dsid3(1) = 1wsearchnext()
Dsid4(1) = 1wsearchnext()

End Select

Locate 1 , 1
Lcd "ID1:"
Locate 2 , 1
Lcd "ID2:"
Locate 1 , 5
 For I = 1 To 6
 Lcd Hex(dsid1(i))
 Next
Locate 2 , 5
 For I = 1 To 6
 Lcd Hex(dsid2(i))
 Next
Wait 5
Cls
Locate 1 , 1
Lcd "ID3:"
Locate 2 , 1
Lcd "ID4:"
Locate 1 , 5
 For I = 1 To 8
 Lcd Hex(dsid3(i))
 Next
Locate 2 , 5
 For I = 1 To 8
 Lcd Hex(dsid4(i))
 Next
Wait 5
Cls

Do

1wreset
1wwrite &HCC
1wwrite &H44
Waitms 200
'---------------------------------
1wreset
1wverify Dsid1(1)
1wwrite , &HBE
Sc(1) = 1wread(9)
Temp1 = 255
  If Err = 0 Then
     If Sc(9) = Crc8(sc(1) , 8) Then
         Temp1 = Decigrades(sc(9) , Dsid1(1))
     End If
End If
'---------------------------------
1wreset
1wverify Dsid2(1)
1wwrite , &HBE
Sc(1) = 1wread(9)
Temp2 = 255
  If Err = 0 Then
     If Sc(9) = Crc8(sc(1) , 8) Then
         Temp2 = Decigrades(sc(9) , Dsid2(1))
     End If
End If
'---------------------------------
1wreset
1wverify Dsid3(1)
1wwrite , &HBE
Sc(1) = 1wread(9)
Temp3 = 255
  If Err = 0 Then
     If Sc(9) = Crc8(sc(1) , 8) Then
         Temp3 = Decigrades(sc(9) , Dsid3(1))
     End If
End If
'---------------------------------
1wreset
1wverify Dsid4(1)
1wwrite , &HBE
Sc(1) = 1wread(9)
Temp4 = 255
  If Err = 0 Then
     If Sc(9) = Crc8(sc(1) , 8) Then
         Temp4 = Decigrades(sc(9) , Dsid4(1))
     End If
End If
'---------------------------------

Cls
Locate 1 , 1
 Lcd "T1: " ; Temp1
Locate 1 , 9
 Lcd "T2: " ; Temp2
Locate 2 , 1
 Lcd "T3: " ; Temp3
Locate 2 , 9
 Lcd "T4: " ; Temp4
Wait 5
Cls
Loop

'1WIRE_DECIGRADES_______________________________________________________________
Function Decigrades(byval Sc(9) As Byte , Byval Family As Byte)
Dim Tmp As Byte , Td As Integer , T1 As Integer
   If Family = &H28 Then                                    '18B20
      Decigrades = 0
      Decigrades = Makeint(sc(1) , Sc(2))
      Decigrades = Decigrades * 10
      Decigrades = Decigrades / 16
      If Sc(9) = 0 Then
         Decigrades = 0 - Decigrades
      End If
  Decigrades = Decigrades / 10
  'ho = Decigrades / 10
 ' Hok = Fusing(ho , "+00.0")
  End If
   If Family = &H10 Then                                    'iit még lehet bug nem tesztelt                                  '1820/1820S
      Tmp = Sc(1) And 1
      If Tmp = 1 Then Decr Sc(1)
         Td = Makeint(sc(1) , Sc(2))
         Td = Td * 50
         Td = Td - 25
         T1 = Sc(8) - Sc(7)
         T1 = T1 * 100
         T1 = T1 / Sc(8)
         Td = Td + T1
         Decigrades = Td / 10
         If Sc(9) = 0 Then
         Decigrades = 0 - Decigrades
      End If
  Decigrades = Decigrades / 10
 ' ho = Decigrades / 10
 ' Hok = Fusing(ho , "+00.0")
  End If
End Function