DS 1820 hőmérő élesztés
DS 1820 hőmérő élesztés
Hali mindenkinek!
Egy kicsit elakadtam a dallas 1820-asával. A mintához képest kissé át kellett alakítanom, mert kvarcról megy a próbapanelem, így a 1 wire =Porta.0 helyett a Port d.6-ot használtam, valamint a ledet a port b.0-ra raktam.
A progi ezek után:
' DS1820 Control by AVR
Const Read_rom = &H33 ' DS1820 Commands
Const Skip_rom = &HCC
Const Convertt = &H44
Const Read_ram = &HBE
Const Write_ram = &H4E
Const Copy_ram = &H48
Const Recall_ee = &HB8
Const Read_power = &HB4
Const Slow = 255
Const Fast = 50
Dim I As Byte ' Index
Dim Rate As Byte ' Blink rate
Dim Crc As Byte ' DS1820 CRC
' Serial Number of DS1820 Device
Dim Serial_number(6) As Byte
Dim Family_code As Byte ' DS1820 Family Code = &H10
Config 1wire = Portd.6
Config Portb = Output ' Config PortD.6 as 1wire pin
1wreset ' 1wire Reset
If Err = 1 Then ' On Error blink fast
Rate = Fast
Print "Reset hiba"
Goto Blink
End If
1wwrite Read_rom ' Read ROM command
Family_code = 1wread() ' Read 8 Bytes ROM contents
For I = 1 To 6
Serial_number(i) = 1wread()
Next
Crc = 1wread()
1wreset ' 1wire Reset
If Err = 1 Then ' On Error blink fast
Rate = Fast
Print "Kodkiolvasasi hiba"
Goto Blink
End If
' Display Family Code
Print "family Code : " ; Hex(family_code)
' Display 6-Byte Serial Number
Print "serial Number : ";
For I = 1 To 6
Print Hex(serial_number(i)) ; " ";
Next
Print "crc : " ; Hex(crc) ' Display CRC
Rate = Slow : Goto Blink ' On End blink slow
End
Blink:
Print "Rate: " ; Rate ' Portb.0 blinks on error
Do
Portb.0 = 1
Waitms Rate
Portb.0 = 0
Waitms Rate
Loop
Azaz ez a családazonosítót, az egyedi kódokat, meg a CRC-t kellene hogy kiírja. Ehhez képest mindent rendben talál (lassú villogással jelzi), majd mindenre 0-t ír ki (family code, serial number, crc).
Gyanítom a 1wire vonalat nem olvassa rendesen. Lehet hogy a d.6 PIN nem tetszik neki? Pedig a Chip configban is beállítottam a 1wire ablakban.
Ha viszont leveszem az érzékelőt, akkor hibát jelez, azaz gyorsan villog. SZóval nem értem mi a bibi! Mert ez szerint mégis érzi az érzékelőt.
Guapo
Egy kicsit elakadtam a dallas 1820-asával. A mintához képest kissé át kellett alakítanom, mert kvarcról megy a próbapanelem, így a 1 wire =Porta.0 helyett a Port d.6-ot használtam, valamint a ledet a port b.0-ra raktam.
A progi ezek után:
' DS1820 Control by AVR
Const Read_rom = &H33 ' DS1820 Commands
Const Skip_rom = &HCC
Const Convertt = &H44
Const Read_ram = &HBE
Const Write_ram = &H4E
Const Copy_ram = &H48
Const Recall_ee = &HB8
Const Read_power = &HB4
Const Slow = 255
Const Fast = 50
Dim I As Byte ' Index
Dim Rate As Byte ' Blink rate
Dim Crc As Byte ' DS1820 CRC
' Serial Number of DS1820 Device
Dim Serial_number(6) As Byte
Dim Family_code As Byte ' DS1820 Family Code = &H10
Config 1wire = Portd.6
Config Portb = Output ' Config PortD.6 as 1wire pin
1wreset ' 1wire Reset
If Err = 1 Then ' On Error blink fast
Rate = Fast
Print "Reset hiba"
Goto Blink
End If
1wwrite Read_rom ' Read ROM command
Family_code = 1wread() ' Read 8 Bytes ROM contents
For I = 1 To 6
Serial_number(i) = 1wread()
Next
Crc = 1wread()
1wreset ' 1wire Reset
If Err = 1 Then ' On Error blink fast
Rate = Fast
Print "Kodkiolvasasi hiba"
Goto Blink
End If
' Display Family Code
Print "family Code : " ; Hex(family_code)
' Display 6-Byte Serial Number
Print "serial Number : ";
For I = 1 To 6
Print Hex(serial_number(i)) ; " ";
Next
Print "crc : " ; Hex(crc) ' Display CRC
Rate = Slow : Goto Blink ' On End blink slow
End
Blink:
Print "Rate: " ; Rate ' Portb.0 blinks on error
Do
Portb.0 = 1
Waitms Rate
Portb.0 = 0
Waitms Rate
Loop
Azaz ez a családazonosítót, az egyedi kódokat, meg a CRC-t kellene hogy kiírja. Ehhez képest mindent rendben talál (lassú villogással jelzi), majd mindenre 0-t ír ki (family code, serial number, crc).
Gyanítom a 1wire vonalat nem olvassa rendesen. Lehet hogy a d.6 PIN nem tetszik neki? Pedig a Chip configban is beállítottam a 1wire ablakban.
Ha viszont leveszem az érzékelőt, akkor hibát jelez, azaz gyorsan villog. SZóval nem értem mi a bibi! Mert ez szerint mégis érzi az érzékelőt.
Guapo
Az adatvonalat +5V-ra felhúztad 4k7 ellenállással?
A DS1820 chip jól van bekötve (+5V/parazita?), adat és GND?
Nálam progi, ami a chip alapadatokat kiírja (family+azonosító+CRC):
A chipek a +5V, Data és GND lábakon is be vannak kötve.
De megy akkor is ha parazitatápként kezelem, de ekkor a kiolvasás előtt legyen ~1 sec bekapcsolási várakozás, hogy a táp meglétekor a 4k7 ellenálláson át a belső kondi fel tudjon töltődni!
A DS1820 chip jól van bekötve (+5V/parazita?), adat és GND?
Nálam progi, ami a chip alapadatokat kiírja (family+azonosító+CRC):
Kód: Egész kijelölése
'1Wire
Config 1wire = Porta.0 'use this pin
Dim Ar(8) As Byte
Dim I as Byte 'ez kimaradt
Print "1-wire"
Print
1wreset 'reset the device
Print "Err:" ; Err 'print error 1 if error
1wwrite &H33 'read ROM command
For I = 1 To 8
Ar(i) = 1wread() 'place into array
Next
'You could also read 8 bytes a time by unremarking the next line
'and by deleting the for next above
'Ar(1) = 1wread(8) 'read 8 bytes
For I = 1 To 8
Print I ; ": " ; Hex(ar(i)) 'print output
Next
Print 'linefeed
Wait 5
De megy akkor is ha parazitatápként kezelem, de ekkor a kiolvasás előtt legyen ~1 sec bekapcsolási várakozás, hogy a táp meglétekor a 4k7 ellenálláson át a belső kondi fel tudjon töltődni!
A hozzászólást 1 alkalommal szerkesztették, utoljára Robert 2007. december 27. csütörtök, 21:45-kor.
Szia Robert!
Köszi a gyors választ! Minden a helyén, parazita és direkt táp kötéseket is kipróbáltam, a d.6 felhúzva 4,7 kval, ennek ellenére változatlan a helyzet.
A te progit is csak azt adja amit az előző minta adott azaz szintiszta nullát. A DQ vonalon van átvitel, az műszerrel látszik. Már az érzékelőt is csereberéltem, semmi változás
A progid átírva port d.6-ra így néz ki. Még egy I deklarációt kellett beletenni, de mást semmit nem módosítottam. Lehet hogy a portot nem bírja? Nem akarom a kristályt levenni a fuse-okat visszaállítani...
'1Wire
Config 1wire = Portd.6 'use this pin
Dim Ar(8) As Byte
Dim I As Byte
Print "1-wire"
Print
1wreset 'reset the device
Print "Err:" ; Err 'print error 1 if error
1wwrite &H33 'read ROM command
For I = 1 To 8
Ar(i) = 1wread() 'place into array
Next
'You could also read 8 bytes a time by unremarking the next line
'and by deleting the for next above
'Ar(1) = 1wread(8) 'read 8 bytes
For I = 1 To 8
Print I ; ": " ; Hex(ar(i)) 'print output
Next
Print 'linefeed
Wait 5
Van még további ötleted? Amúgy túlélted a karácsonyt, és készülsz a BUÉK-ra?
Guapo
János[/code]
Köszi a gyors választ! Minden a helyén, parazita és direkt táp kötéseket is kipróbáltam, a d.6 felhúzva 4,7 kval, ennek ellenére változatlan a helyzet.
A te progit is csak azt adja amit az előző minta adott azaz szintiszta nullát. A DQ vonalon van átvitel, az műszerrel látszik. Már az érzékelőt is csereberéltem, semmi változás
A progid átírva port d.6-ra így néz ki. Még egy I deklarációt kellett beletenni, de mást semmit nem módosítottam. Lehet hogy a portot nem bírja? Nem akarom a kristályt levenni a fuse-okat visszaállítani...
'1Wire
Config 1wire = Portd.6 'use this pin
Dim Ar(8) As Byte
Dim I As Byte
Print "1-wire"
1wreset 'reset the device
Print "Err:" ; Err 'print error 1 if error
1wwrite &H33 'read ROM command
For I = 1 To 8
Ar(i) = 1wread() 'place into array
Next
'You could also read 8 bytes a time by unremarking the next line
'and by deleting the for next above
'Ar(1) = 1wread(8) 'read 8 bytes
For I = 1 To 8
Print I ; ": " ; Hex(ar(i)) 'print output
Next
Print 'linefeed
Wait 5
Van még további ötleted? Amúgy túlélted a karácsonyt, és készülsz a BUÉK-ra?
Guapo
János[/code]
Kérdés: melyik AVR?
T2323 / M16 D6 az ICP lenne. De ez a láb amúgy jó szokott lenni. Lábfüggetlen az 1Wire, mert az időszeleteket a Q értékből számolja.
Tényleg tipp:
A crystal jól van beállítva?
Én a rogram elejére odabiggyeszteném még, hogy:
T2323 / M16 D6 az ICP lenne. De ez a láb amúgy jó szokott lenni. Lábfüggetlen az 1Wire, mert az időszeleteket a Q értékből számolja.
Tényleg tipp:
A crystal jól van beállítva?
Én a rogram elejére odabiggyeszteném még, hogy:
Kód: Egész kijelölése
$crystal = 7372800 'Sebesseg
$regfile = "M8def.dat" 'Chip
$baud = 9600
$hwstack = 64
$swstack = 64
$framesize = 40
Hi Robert!
Még mindig a tiny2313-nál tartok. A további kiegészítések sem változtattak semmit, de miért is tették volna. Hiszen a soros port terminálja végülis működött előtte is, azaz a freki és az időzítés rendben van, volt. A Dallas lapját is megnéztem a bekötés végett, de ott sem látok semmi hibát. (1. GND, 2. DQ, 3. Vdd).
Ha leveszem az érzékelőt, akkor viszont hibára fut, azaz nem döglött teljesen, szóval nem tudom, mégis mi van.
Guapo
Még mindig a tiny2313-nál tartok. A további kiegészítések sem változtattak semmit, de miért is tették volna. Hiszen a soros port terminálja végülis működött előtte is, azaz a freki és az időzítés rendben van, volt. A Dallas lapját is megnéztem a bekötés végett, de ott sem látok semmi hibát. (1. GND, 2. DQ, 3. Vdd).
Ha leveszem az érzékelőt, akkor viszont hibára fut, azaz nem döglött teljesen, szóval nem tudom, mégis mi van.
Guapo
Szia Robert!
Nos, a hiba megvan. A szokásos szívás, a felhúzó ellenállás szakadt volt. Most már értelmes értékeket ad vissza. A hőmérő lekérdezés is megy, de mivel terminálra iratom ki az érték olyan mintha fél fokonként menne. 20 foknál 40 körül van, ha lehellem felmegy 50 fölé. Miként lehet ebből normál hőfokopt csiholni, Persze nem néztem még meg az ide vonatkozó adatlapot.
Guapo
Nos, a hiba megvan. A szokásos szívás, a felhúzó ellenállás szakadt volt. Most már értelmes értékeket ad vissza. A hőmérő lekérdezés is megy, de mivel terminálra iratom ki az érték olyan mintha fél fokonként menne. 20 foknál 40 körül van, ha lehellem felmegy 50 fölé. Miként lehet ebből normál hőfokopt csiholni, Persze nem néztem még meg az ide vonatkozó adatlapot.
Guapo
Hát tényleg ciki!
Most hogy látszólag minden OK most ráraktam még egy érzékelőt, de hogyan tovább? A search rom dolgait elolvastam, de nem igazán lettem okosabb. Úgy gondolja, hogy az egész folyamatábrát le kell programozni, hogy felderítse a rárakott kütyüket? Hát az elsőre kicsit munkás. Kezdek rájönni, hogy egyenként lekérdezem, aztán a match romot használom, akkor egyszerübb lesz. Te hogyan csinálod?
Guapo
Most hogy látszólag minden OK most ráraktam még egy érzékelőt, de hogyan tovább? A search rom dolgait elolvastam, de nem igazán lettem okosabb. Úgy gondolja, hogy az egész folyamatábrát le kell programozni, hogy felderítse a rárakott kütyüket? Hát az elsőre kicsit munkás. Kezdek rájönni, hogy egyenként lekérdezem, aztán a match romot használom, akkor egyszerübb lesz. Te hogyan csinálod?
Guapo
Hi Robert!
Megnéztem a Match Rom lekérdezési szekvenciát, de nem megy. gyanítom, hogy valami úttörő baromság miatt nem megy. Állandóan 255-öt ad vissza. A ROM code megadására tippelek, hogy ott van valami bibi. Az érdemi részt ide másolom. A Skip rom csont nélkül megy, de nekem több eszközt kellene használnom egy buson.
Config 1wire = Portb.1 ' Config Portb.1 as 1wire pin
Do ' 1wire Reset
1wreset ' 1wire Reset
Do
Busy = 1wread()
Loop Until Busy = &HFF ' Wait for end of conversion
1wwrite Match_rom
1wwrite &H1053B423010800F9 'Device Code 10 53B423010800 F9
'1wwrite &H53
'1wwrite &HB4
'1wwrite &H23
'1wwrite &H01
'1wwrite &H08
'1wwrite &H00
'1wwrite &HF9 ' Match ROM command
'1wwrite Convertt ' Measure Temperature
Do
Busy = 1wread()
Loop Until Busy = &HFF ' Wait for end of conversion
1wreset
Do
Busy = 1wread()
Loop Until Busy = &HFF ' Wait for end of conversion
1wwrite Match_rom
1wwrite &H1053B423010800F9
'1wwrite &H53
'1wwrite &HB4
'1wwrite &H23
'1wwrite &H01
'1wwrite &H08
'1wwrite &H00
'1wwrite &HF9 ' Match ROM command
1wwrite Read_ram
Do
Busy = 1wread()
Loop Until Busy = &HFF ' Wait for end of conversion
' Read Scratch command
For I = 1 To 9 ' Read 9 Bytes Scratch contents
Scratch(i) = 1wread()
Print I ; " " ; Scratch(i)
Next
' Display Temperature LSB
'Print "LSB: " ; Scratch(1)
' Display Temperature MSB
'Print "MSB: " ; Scratch(2)
Wait 5
Loop
Látható, hogy két módon is próbáltam a Device kódot megadni, eredmény nélkül. Van valami ötleted hozzá?
Guapo
Ps.: A code megadás az hogyan megy (ahogy azt te is használod, hogy nem olvad bele a szöveg egyéb részébe).
Megnéztem a Match Rom lekérdezési szekvenciát, de nem megy. gyanítom, hogy valami úttörő baromság miatt nem megy. Állandóan 255-öt ad vissza. A ROM code megadására tippelek, hogy ott van valami bibi. Az érdemi részt ide másolom. A Skip rom csont nélkül megy, de nekem több eszközt kellene használnom egy buson.
Config 1wire = Portb.1 ' Config Portb.1 as 1wire pin
Do ' 1wire Reset
1wreset ' 1wire Reset
Do
Busy = 1wread()
Loop Until Busy = &HFF ' Wait for end of conversion
1wwrite Match_rom
1wwrite &H1053B423010800F9 'Device Code 10 53B423010800 F9
'1wwrite &H53
'1wwrite &HB4
'1wwrite &H23
'1wwrite &H01
'1wwrite &H08
'1wwrite &H00
'1wwrite &HF9 ' Match ROM command
'1wwrite Convertt ' Measure Temperature
Do
Busy = 1wread()
Loop Until Busy = &HFF ' Wait for end of conversion
1wreset
Do
Busy = 1wread()
Loop Until Busy = &HFF ' Wait for end of conversion
1wwrite Match_rom
1wwrite &H1053B423010800F9
'1wwrite &H53
'1wwrite &HB4
'1wwrite &H23
'1wwrite &H01
'1wwrite &H08
'1wwrite &H00
'1wwrite &HF9 ' Match ROM command
1wwrite Read_ram
Do
Busy = 1wread()
Loop Until Busy = &HFF ' Wait for end of conversion
' Read Scratch command
For I = 1 To 9 ' Read 9 Bytes Scratch contents
Scratch(i) = 1wread()
Print I ; " " ; Scratch(i)
Next
' Display Temperature LSB
'Print "LSB: " ; Scratch(1)
' Display Temperature MSB
'Print "MSB: " ; Scratch(2)
Wait 5
Loop
Látható, hogy két módon is próbáltam a Device kódot megadni, eredmény nélkül. Van valami ötleted hozzá?
Guapo
Ps.: A code megadás az hogyan megy (ahogy azt te is használod, hogy nem olvad bele a szöveg egyéb részébe).
Most nincs előttem a mintaprogi....
Megvan:) :
http://www.mcselec.com/index.php?option ... &Itemid=57
Ps: A programokódot a "Code" gombbal kezdem és azzal is zárom be. Akkor olyan szép kiemelt lesz:).
Megvan:) :
http://www.mcselec.com/index.php?option ... &Itemid=57
Kód: Egész kijelölése
' DS18B20_two_thermo.bas for Atmel AVR with BASCOM - AVR and Dallas semiconductors DS18B20 temperature sensors - NO extra hardware
' Program "DUAL DS Thermo"
' Messures and displays temperature in 1/10 celcius on two DS sensors,
' stores and displays minimum and maximum readings.
' This program will NOT work on BASCOM earlier than 1.11.6.2, cause of the CRC-function
' and (maybe ?) its not possible to declare functions in earlier environment.
' But the 1w-functions work from 1.11.4 , I think.
' The program code (BIN) will be ~3Kb so its NOT possible to run in DEMO-environment anyway
' Platform(s) : Atmel devkit ~1996, used "AVR ISP programmer"-setting
' Dev - uC : Atmel AT90s8515 (AVR) @ 4 Mhz
' BASCOM-AVR IDE Version : 1.11.6.2 Compiler: Version 1.11.6.2 (released)
' This is a TWO-sensor DS18b20 thermometer displayed on 2*16 LCD
' The sensors are on the same 1-w bus :-) which is the intresting part
' The bus used is of 2-wire type, that means : Port-PIN to DQ, +5V to VDD and Gnd.
' See also HTML-help-file in BASCOM regarding "Using the 1 WIRE protocol"
' Main goal is to show basics of using two DS-sensors on the same uC-pin.
' The code is written for easy understanding as goal, not optimized for anything else
' If you use it or test it, please report to the author. (Not when only browsing )
' mailto: gote@sys-op.com
' subject : DS18B20_two_thermo.bas test-report
' message : type of uC, Mhz, type of sensors used, type of cable and length
' platform (devkit / PCB ?), BASCOM-version, compiled code size, (BIN file size)
' That will be enough pay-back for non-commercial use.
' Changes in the code will be allowed, if copy of changed program is sent to author,
' with comments in English ( or German, Swedish ).
' For commercial use, contact author.
' (c) 2001 Göte Haluza, gote@sys-op.com, gote@hotmail.com (Sweden)
' version :1 , revision 2, Startdate : 18 apr 2001 Last update : 27 Apr 2001
$regfile = "8515def.dat"
$crystal = 4000000
Declare Sub Init
Declare Sub ConvAllT ' Convert T on ALL sensors
Declare Function Decigrades(BYVAL sc(9) as byte) as integer
Config 1wire = Portb.6 '0,1,2 NOP 3,4,5,6,7 works good ON MY Equipment
Config Lcd = 16 * 2
Config Lcdpin = Pin , Db4 = Porta.4 , Db5 = Porta.5 , Db6 = Porta.6 , Db7 = Porta.7 , E = Porta.3 , Rs = Porta.2
'Temp variables
Dim B As Byte
Dim W As Word
'Program variables
'Implicit Err created by compiler
Dim Dg As Integer 'DECIgrades, I call it, cause I have no space for commas on the display....
Dim Min1 As Integer
Dim Min2 As Integer
Dim Max1 As Integer
Dim Max2 As Integer
Dim Dsid1(8) As Byte 'Dallas ID 64 bits incl CRC
Dim DsId2(8) As Byte
'When used like this : DsId(1) = 1wread(8)
'DsId(1) = family code 'Ds1820 10h, DS18B20 28h, Ds18s20 10h
'DsId(2) '48 Bits Serial, LSB
'DsId(3)
'DsId(4)
'DsId(5)
'DsId(6)
'DsId(7) '48 Bits Serial, MSB
'DsId(8) '8 CRC
Dim Sc(9) as byte 'Scratchpad 0-8 72 bits incl CRC, explanations for DS18b20
'Sc(1) 'Temperature LSB
'Sc(2) 'Temperature MSB
'Sc(3) 'TH/user byte 1 also SRAM
'Sc(4) 'TL/user byte 2 also SRAM
'Sc(5) 'config also SRAM x R1 R0 1 1 1 1 1 - the r1 r0 are config for resolution - write FF to byte for 12 bit - others dont care
'Sc(6) 'res
'Sc(7) 'res
'Sc(8) 'res
'Sc(9) '8 CRC
'DALLAS DS18B20 ROM and scratchpad commands''''''''''''''''''''''''''1wwrite....
'&H 33 read rom - single sensor
'&H 55 match rom, followed by 64 bits
'&H CC skip rom
'&H EC alarm search - ongoining alarm >TH <TL
'&H BE read scratchpad
'&H 44 convert T
cls
lcd "This is a 2sensor DS18B20 thermometer"
locate 2,1
lcd " by gote@sys-op.com"
wait 1
for b = 1 to 20
shiftlcd left
waitms 500
next
wait 2
cls
W = 1wirecount()
' Here I assume 2 sensors - no errorcontrol made, but would be easy to do with the "Err"-variable
' Getting the two sensors IDs.
DsId1(1) = 1wsearchfirst()
Do
DsId2(1) = 1wsearchnext()
Loop Until Err = 1
' If displayed, everything went well.
' First sensor identified and stored in variable
if dsid1(8) = crc8(DsId1(1), 7) then ' Control that the received CRC match the calculated
locate 1,1
lcd "CRC OK Sensor 1 ID"
wait 1
locate 1,1
for B=1 to 8
lcd Hex(DsId1(b))
next
end if
' Second sensor
if dsid2(8) = crc8(DsId2(1), 7) then
locate 2,1
lcd "CRC OK Sensor 2 ID"
wait 1
locate 2,1
for B=1 to 8
lcd Hex(DsId2(b))
next
end if
wait 1
cls
Init
' Main loop
Do
ConvAllT ' "Convert ALL T on the 1w-bus"
Waitus 200 : waitus 200 : waitus 200 : waitus 200 'if you use 2-wire, could be reduced to 200us
1wverify DsId1(1) 'Issues the "Match ROM "
locate 1,1
if err = 1 then
lcd "Err " '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
if max1 < dg then max1 = dg
lcd dg : locate 1,7 : lcd min1 : locate 1,14 : lcd max1
end if
end if
1wverify DsId2(1)
locate 2,1
if err = 1 then
lcd "DsId2 not on bus "
elseif err = 0 then ' lcd " Sensor found "
1wwrite &HBE
Sc(1) = 1wread(9)
if sc(9) = crc8(sc(1),8) then
DG = DeciGrades(sc(9))
if min2 > dg then min2 = dg
if max2 < dg then max2 = dg
lcd dg : locate 2,7 : lcd min2 : locate 2,14 : lcd max2
end if
end if
wait 1
loop
end 'end program
'Sets variables and LCD for further use'''''''''''''''''''''''''''''''''''''''''
Sub Init
Cls
Lcd " Min Max"
locate 2,1
Lcd " Min Max"
Min1 = 999 ' to get a real value from start
Min2 = 999
end sub
'Makes the Dallas "Convert T" command on the 1w-bus configured in "Config 1wire = Portb. "
'WAIT 200-750 ms after issued, internal conversion time for the sensor''''''''''
'SKIPS ROM - so it makes the conversion on ALL sensors on the bus simultaniously
'When leaving this sub, NO sensor is selected, but ALL sensors has the actual
'temperature in their scratchpad ( within 750 ms )
Sub ConvAllT
1wreset ' reset the bus
1wwrite &HCC ' skip rom
1wwrite &H44 ' Convert T
End sub
'Makes a integer value of the first two bytes in scratchpad'''''''''''''
'Works on DS18 B 20 , observe "B". The R0 and R1 in Sc(5) tells you how many bits are accurate
function Decigrades(Byval Sc(9) as byte)
Decigrades = 0
Decigrades = Makeint(Sc(1) , Sc(2))
Decigrades = Decigrades * 10
Decigrades = Decigrades / 16
end function
' If you have DS1820 or DS18 S 20 , you can use this algo instead:
' Observe that DsId1(1) contains the info value of which sensor is used.
'(
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))
'Print Hex(t)
'Print T
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
'As integer, this routine gives T*10, with 1/10 degree precision
End Function
Igen, igen!
Ezt én is megtaláltam sűrű magámyomban. Az eleje megy is. De a vége az már nem. Pluszban húznom, kellett a kódból, mert a tiny2313-ba nem fért volna bele.
Tehát odáig jutottam, hogy a boszon lévő két ds1820-ast szépen felderíti, a DSid1,2 kijelzi, és stimmel is a kortábbról kiderítettekkel. Amikor viszont a hőfokot kellene lekérdezni na ott már csak az egyik működik. Ha felcserélem a megszólítási sorrendet akkor sem változik a kép. Az 1wverify sem ad hibát, hanem csak egy konstans értéket a hőmérsékletre (dg). Szóval itt tartok.
Ja a témában talált másik minta progi szépen dolgozik 1 tizedes hőfokokkal. Leellenőriztem, tényleg pontos. Már csak ezt a többszörös lekérdezéseben kéne előrejutnom.
Az már látszik, hogy felfelé lépnem kell, mert a kód túlnő bőven 2k-án.
Azért mellékelem a kódot is, hátha valakinek segít, vagy találsz benne valami bugot!
Guapo
Ezt én is megtaláltam sűrű magámyomban. Az eleje megy is. De a vége az már nem. Pluszban húznom, kellett a kódból, mert a tiny2313-ba nem fért volna bele.
Tehát odáig jutottam, hogy a boszon lévő két ds1820-ast szépen felderíti, a DSid1,2 kijelzi, és stimmel is a kortábbról kiderítettekkel. Amikor viszont a hőfokot kellene lekérdezni na ott már csak az egyik működik. Ha felcserélem a megszólítási sorrendet akkor sem változik a kép. Az 1wverify sem ad hibát, hanem csak egy konstans értéket a hőmérsékletre (dg). Szóval itt tartok.
Ja a témában talált másik minta progi szépen dolgozik 1 tizedes hőfokokkal. Leellenőriztem, tényleg pontos. Már csak ezt a többszörös lekérdezéseben kéne előrejutnom.
Az már látszik, hogy felfelé lépnem kell, mert a kód túlnő bőven 2k-án.
Azért mellékelem a kódot is, hátha valakinek segít, vagy találsz benne valami bugot!
Guapo
Kód: Egész kijelölése
Do
1wreset ' reset the bus
1wwrite &HCC ' skip rom
1wwrite &H44 ' Convert T ' "Convert ALL T on the 1w-bus"
Waitus 200 : 'if you use 2-wire, could be reduced to 200us
1wverify Dsid1(1) 'Issues the "Match ROM "
'If Err = 1 Then
'Print "Err " '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))
End If
Print "DS1: " ; Dg
1wverify Dsid2(1)
'If Err = 1 Then
'Print "DsId2 not on bus "
'Elseif Err = 0 Then ' lcd " Sensor found "
1wwrite &HBE
Sc(1) = 1wread(9)
If Sc(9) = Crc8(sc(1) , 8) Then
Dg = Decigrades(sc(9))
End If
Print "DS2: " ; Dg
Wait 1
Loop
End 'end program
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))
'Print Hex(t)
'Print T
'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
'As integer, this routine gives T*10, with 1/10 degree precision
End Function
Hali Robert!
A szívás rendesen folytatódott, mígnem csak kiderült, hogy az egyik érzékelő döglött. Valószínüleg az is volt, csak a szerencsétlen szerencsén múlt, hogy azt vettem elő először, amelyik jó volt.
Na az érdekes az, hogy nem teljesen rossz, mert az IDhét kiadja meg minden. A lekérdezésre is válaszol, csak éppen mérni nem mér. Nos ez miatt nem feltételeztem, hogy mégis az érzékelő a rossz.
Tanulság: midet egyenként le kell tesztelni, utána rendszerbe rakni. Egyébiránt a megmaradt 1 db a tizedfokokat szépen adja.
Találtam egy forrást, ahol az érzékelőt úgy néz ki jó áron adják, legalábbis telefonon 600-at mondtak. Hogy aztán ez áfás, vagy nem az nem biztos. Minden esetre kértem írásban ajánlatot, szóval meglátom mit kapok. A RET 900-ért adta, ráadásul az egyik féldöglött. Máshol még drágábban mérik.
Guapo
A szívás rendesen folytatódott, mígnem csak kiderült, hogy az egyik érzékelő döglött. Valószínüleg az is volt, csak a szerencsétlen szerencsén múlt, hogy azt vettem elő először, amelyik jó volt.
Na az érdekes az, hogy nem teljesen rossz, mert az IDhét kiadja meg minden. A lekérdezésre is válaszol, csak éppen mérni nem mér. Nos ez miatt nem feltételeztem, hogy mégis az érzékelő a rossz.
Tanulság: midet egyenként le kell tesztelni, utána rendszerbe rakni. Egyébiránt a megmaradt 1 db a tizedfokokat szépen adja.
Találtam egy forrást, ahol az érzékelőt úgy néz ki jó áron adják, legalábbis telefonon 600-at mondtak. Hogy aztán ez áfás, vagy nem az nem biztos. Minden esetre kértem írásban ajánlatot, szóval meglátom mit kapok. A RET 900-ért adta, ráadásul az egyik féldöglött. Máshol még drágábban mérik.
Guapo