BlaueLed
18.03.2008, 20:53
Hallo,
habe einen DS18S20 an Portb.0 meines mega32 hängen. Folgendes Programm gibt mir als Temperatur immer 850 aus:
'--- Controller ---
$regfile = "m32def.dat"
$crystal = 16000000
$baud = 4800
$hwstack = 32
$swstack = 10
$framesize = 40
'--- Grafikroutine ---
$lib "glcdKS108.lib"
'--- DS18S20 ---
Config 1wire = Portb.0
'--- Declare Subs ---
Declare Sub Init
Declare Sub Convallt
Declare Function Decigrades(byval Sc(9) As Byte) As Integer
'--- Dims ---
Dim B As Byte
Dim W As Word
Dim Dg As Integer
Dim Min1 As Integer
Dim Min2 As Integer
Dim Max1 As Integer
Dim Max2 As Integer
Dim Dsid1(8) As Byte
Dim Sc(9) As Byte
'--- Grafikdisplay ---
Config Graphlcd = 128 * 64sed , Dataport = Porta , Controlport = Portc , Ce = 1 , Ce2 = 0 , Cd = 2 , Rd = 3 , Reset = 4 , Enable = 5
Cls
Showpic 0 , 0 , Lcdblank
Setfont Font6x8
Lcdat 2 , 32 , "Sensorcheck"
Line(0 , 20) -(128 , 20 ) , 1
Wait 1
'--- Sensor ---
Setfont Kayfont5x5
Dsid1(1) = 1wsearchfirst()
If Dsid1(8) = Crc8(dsid1(1) , 7) Then
Lcdat 4 , 2 , "CRC OK Sensor"
Wait 1
For B = 1 To 8
Lcdat 5 , 2 , Hex(dsid1(b))
Next
End If
'--- Main Hauptprogramm ---
Main:
Call 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
Lcdat 6 , 2 , "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))
Lcdat 7 , 2 , Dg
End If
End If
Wait 1
Goto Main
'--- Temperatur konvertieren ---
Sub Convallt
1wreset ' reset the bus
1wwrite &HCC ' skip rom
1wwrite &H44 ' Convert T
End Sub
'--- Funktion zum auslesen des Temperatursensors ---
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
'--- Includes ---
$include "kayfont5x5.font"
$include "font6x8.font"
'--- Bilder ---
Lcdblank:
$bgf "lcdblank.bgf"
Die ID bekomme ich angezeigt. Hab 2 DS18S20 ausprobiert. Am Datenausgang habe ich einen 4,7k Pullup. Vielleicht sitz ich ja auch nur auf der Leitung. Vielleicht kann mir ja jemand von Euch helfen.
mfg Kay
habe einen DS18S20 an Portb.0 meines mega32 hängen. Folgendes Programm gibt mir als Temperatur immer 850 aus:
'--- Controller ---
$regfile = "m32def.dat"
$crystal = 16000000
$baud = 4800
$hwstack = 32
$swstack = 10
$framesize = 40
'--- Grafikroutine ---
$lib "glcdKS108.lib"
'--- DS18S20 ---
Config 1wire = Portb.0
'--- Declare Subs ---
Declare Sub Init
Declare Sub Convallt
Declare Function Decigrades(byval Sc(9) As Byte) As Integer
'--- Dims ---
Dim B As Byte
Dim W As Word
Dim Dg As Integer
Dim Min1 As Integer
Dim Min2 As Integer
Dim Max1 As Integer
Dim Max2 As Integer
Dim Dsid1(8) As Byte
Dim Sc(9) As Byte
'--- Grafikdisplay ---
Config Graphlcd = 128 * 64sed , Dataport = Porta , Controlport = Portc , Ce = 1 , Ce2 = 0 , Cd = 2 , Rd = 3 , Reset = 4 , Enable = 5
Cls
Showpic 0 , 0 , Lcdblank
Setfont Font6x8
Lcdat 2 , 32 , "Sensorcheck"
Line(0 , 20) -(128 , 20 ) , 1
Wait 1
'--- Sensor ---
Setfont Kayfont5x5
Dsid1(1) = 1wsearchfirst()
If Dsid1(8) = Crc8(dsid1(1) , 7) Then
Lcdat 4 , 2 , "CRC OK Sensor"
Wait 1
For B = 1 To 8
Lcdat 5 , 2 , Hex(dsid1(b))
Next
End If
'--- Main Hauptprogramm ---
Main:
Call 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
Lcdat 6 , 2 , "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))
Lcdat 7 , 2 , Dg
End If
End If
Wait 1
Goto Main
'--- Temperatur konvertieren ---
Sub Convallt
1wreset ' reset the bus
1wwrite &HCC ' skip rom
1wwrite &H44 ' Convert T
End Sub
'--- Funktion zum auslesen des Temperatursensors ---
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
'--- Includes ---
$include "kayfont5x5.font"
$include "font6x8.font"
'--- Bilder ---
Lcdblank:
$bgf "lcdblank.bgf"
Die ID bekomme ich angezeigt. Hab 2 DS18S20 ausprobiert. Am Datenausgang habe ich einen 4,7k Pullup. Vielleicht sitz ich ja auch nur auf der Leitung. Vielleicht kann mir ja jemand von Euch helfen.
mfg Kay