Jak uzyskać większą dokładność pomiaru temperatury z DS1820?

$regfile = "m32def.dat"

$crystal = 8000000


Config Lcdbus = 4
Config Lcd = 16 * 2
Config Lcdpin = Pin , Db4 = Pb.4 , Db5 = Pb.5 , Db6 = Pb.6 , Db7 = Pb.7 , E = Pb.3 , Rs = Pb.2

Config 1wire = Portb.0

Declare Sub Odcz_temp

Dim Temperatura(2) As Byte

Deflcdchar 0 , 7 , 5 , 7 , 32 , 32 , 32 , 32 , 32




Do




Cursor Off
Call Odcz_temp

Cls

If Temperatura(2) = 0 Then

Lcd "Temp: " ; Temperatura(1) ; Chr(0) ; "C"

Else

Lcd "Temp: -" ; Temperatura(1) ; Chr(0) ; "C"

End If



Loop

End

Sub Odcz_temp

1wreset
1wwrite &HCC
1wwrite &H44

Waitms 750

1wreset
1wwrite &HCC
1wwrite &HBE

Temperatura(1) = 1wread(2)

1wreset

If Err = 1 Then

Cls
Lcd "Brak ukladu"

Do

Loop

End If

If Temperatura(2) > 0 Then

Temperatura(1) = 256 - Temperatura(1)

End If

Temperatura(1) = Temperatura(1) / 2

End Sub

$regfile = "m8def.dat"
$crystal = 1000000
Config Lcd = 16 * 2
Config Lcdpin = Pin , Db4 = Portd.6 , Db5 = Portd.5 , Db6 = Portb.7 , Db7 = Portb.6 , E = Portd.7 , Rs = Portb.0
'Do wyżej wymienionych pinów dołącz LCD 2*16
Config 1wire = Portb.1                                      'Do tego pinu podłącz dane DS'a końcówkę tą podłącz też przez rezystor 3,3k do +5V

Dim X As Byte
Dim Trend As Byte
Dim Temp As Integer
Dim Temperatura As Single
Dim Wynik(9) As Byte
Dim T As Single
Dim Tp As Single
Dim Tp1 As Single
Dim Wynik1 As String * 5


Deflcdchar 0 , 6 , 9 , 9 , 6 , 32 , 32 , 32 , 32            ' Stopień
Deflcdchar 2 , 4 , 14 , 31 , 4 , 4 , 4 , 4 , 4              ' Rośnie
Deflcdchar 1 , 4 , 4 , 4 , 4 , 4 , 31 , 14 , 4              ' Maleje
Deflcdchar 3 , 32 , 32 , 31 , 32 , 31 , 32 , 32 , 32

Cursor Off

Gosub Wreset
If Err = 1 Then
   Lcd "   Brak DS-a"
   Wait 1
   Goto Poczatek

End If
Cls : Lcd ">>  TERMOMETR <<"
Locate 2 , 1
Lcd "*BY ......*"                                           'Tu wpisz swoje dane razem do 16 znaków będzie bajer
Wait 1

Poczatek:

Do
  Gosub Wlacz_konwersje
  Gosub Odczytaj_temperature
  Tp1 = Tp
  Temp = Makeint(wynik(1) , Wynik(2))
  '***********To dla 1820**************
  Temperatura = Temp / 2
  T = Wynik(8) - Wynik(7)
  T = T / Wynik(8)
  Temperatura = Temperatura - 0.25
  Tp = Temperatura + T
  ''***********To dla 18B20**************
  'Tp = Temp / 16

  Wynik1 = Fusing(tp , "###.#")

  Upperline
  Lcd " Temp. = " ; Wynik1 ; Chr(0) ; "C "
  If Tp > Tp1 Then Trend = 2
  If Tp < Tp1 Then Trend = 1
  If Tp = Tp1 Then Trend = 3

  Lowerline
  For X = 0 To 15
  Lcd Chr(trend)
  Next X

Loop

Wlacz_konwersje:
Gosub Wyslij_numer
1wwrite &H44
Gosub Wreset
Wait 1
Return

Odczytaj_temperature:
Gosub Wyslij_numer
1wwrite &HBE
Wynik(1) = 1wread(9)
Gosub Wreset
Return

Wyslij_numer:
Gosub Wreset
1wwrite &HCC
Return

Wreset:
1wreset
Return

$regfile = "m16def.dat"
$crystal = 8000000


Config Lcd = 16 * 2
Config Lcdpin = Pin , Db4 = Pb.4 , Db5 = Pb.5 , Db6 = Pb.6 , Db7 = Pb.7 , E = Pb.3 , Rs = Pb.2
Config 1wire = Portb.0

Config Portd = &B1110000
  Portd = &B011111
Declare Sub Odcz_temp(czujnik As Byte)
Declare Sub Zapisz_id


Dim Temperatura(2) As Byte
Dim Id(8) As Byte
Dim I As Byte
Dim J As Byte
Dim K As Byte
Dim Liczba_ukl As Byte
Deflcdchar 0 , 7 , 5 , 7 , 32 , 32 , 32 , 32 , 32
Dim A As Byte
Dim U As Byte
Cls
Liczba_ukl = 1wirecount()
If Pind.0 = 0 Then
Lcd "Liczba ukladow:" ; Liczba_ukl
If Liczba_ukl > 0 Then
Id(1) = 1wsearchfirst()
For I = 1 To 8
Writeeeprom Id(i) , I
Next I
End If
If Liczba_ukl > 1 Then
Id(1) = 1wsearchnext()
J = 0
For I = 9 To 16
Incr J
Writeeeprom Id(j) , I
Next I
End If
Lowerline
Lcd "Prog OK"
Do
Loop
End If



Cursor Off
Cls
Lcd "Termometr by"
Locate 2 , 1
Lcd "Killer"

For U = 1 To 15
Shiftlcd Right
Waitms 200
Next
For U = 1 To 14
Shiftlcd Left
Waitms 200
Next


  Cls






 Cls



Do





Locate 1 , 10
Lcd " W Domu"
Locate 2 , 10
Lcd "Na Polu"

Home
For K = 1 To Liczba_ukl
Call Odcz_temp(k)
If Temperatura(2) = 0 Then
Lcd Temperatura(1) ; Chr(0) ; "C"
Else
Lcd "-" ; Temperatura(1) ; Chr(0) ; "C"
End If
Lowerline
Next
Loop
End
Sub Odcz_temp(czujnik As Byte)
If Czujnik = 1 Then
For I = 1 To 8
Readeeprom Id(i) , I
Next I
End If
If Czujnik = 2 Then
J = 0
For I = 9 To 16
Incr J
Readeeprom Id(j) , I
Next I
End If
1wreset
Call Zapisz_id
1wwrite &H44
Waitms 750
1wreset
Call Zapisz_id
1wwrite &HBE
Temperatura(1) = 1wread(2)
1wreset
If Err = 1 Then
Cls
Lcd "Brak ukladu"
Do
Loop
End If
If Temperatura(2) > 0 Then
Temperatura(1) = 256 - Temperatura(1)
End If
Temperatura(1) = Temperatura(1) / 2
End Sub
Sub Zapisz_id
1wwrite &H55
For I = 1 To 8
1wwrite Id(i)
Next I
End Sub