Sie sind hier: Home » ES-Messung » ES-Geber » Programm ESG

Link zu: Programm Erdsonden-Temperaturgeber.bas

'##############################################################
'Temperaturmesschaltung mit serieller Ausgabe für die Erdsonde
'
' file: 1-wire zu seriell_Text.bas
'##############################################################

'Programm für den uP in der Erdsonde, der die Temperatur von einem DS18S20 in einen
'seriellen Text umsetzt. Das °-Zeichen [hier chr(223)] zeigt gleichzeitig das Ende der Übertragung an.
'Die Temperatur wird so im Klartext übertragen.


$regfile = "attiny85.dat"
$framesize = 32
$swstack = 32
$hwstack = 64
$crystal = 8000000                                          '8MHz, interner RC-Oszi ohne Teiler (mit 1MHz geht 1-wire NICHT)

Declare Function Decigrades(BYVAL sc(9) as byte) as integer

'
'=========================== serielle Ausgabe ==================================

Dim Text as string * 20                                     'max 20 Zeichen für die serielle Ausgabe
Dim Baudrate as Word
Baudrate = 1200
'serielles Port ist PORTB.4


'=========================== 1-Wire Konfiguration ==============================
Config 1wire = PortB.3                                      '1-Wire-Port

Dim Sc(9) as byte                                           'Scratchpad Bytes 0-8, 9 Bytes, 72 bits incl CRC

Dim Temp_Adr(8) As Byte

Temp_Adr(1) = &h10                                          'fixe Adresse des Temp-Sensor
Temp_Adr(2) = &h4A
Temp_Adr(3) = &h66
Temp_Adr(4) = &h8D
Temp_Adr(5) = &h02
Temp_Adr(6) = &h08
Temp_Adr(7) = &h00
Temp_Adr(8) = &hB1

Dim Sondentemperatur as Integer
Dim Temperatursingle as Single
Dim TempKomma as String * 10

 

'*******************************************************************************
'***************************** Programmstart ***********************************
'*******************************************************************************


'Hauptprogramm

Do
     wait 1
     gosub Temperaturmessung                                'erst Temperatur messen
     waitms 10

     if sondentemperatur = 9998 then
        Text = " AdrFehler "
        serout Text , 0 , B , 4 , Baudrate , 0 , 8 , 1
        if sondentemperatur = 9999 then
           Text = " CRCFehler "
           serout Text , 0 , B , 4 , Baudrate , 0 , 8 , 1
        endif
     else
        TemperaturSingle = Sondentemperatur / 10
        TempKomma = Fusing(TemperaturSingle , "##.#")         'Komma festlegen
        Text = Format(TempKomma , "+0000") + chr(223)         'Zahlenausgabe formatieren und Gradzeichen anhängen
        if Temperatursingle > 100 then Text = " --.- "
        if Temperatursingle < -100 then Text = " --.- "

        serout Text , 0 , B , 4 , Baudrate , 0 , 8 , 1

     endif
     wait 10                                                'alle 10 sec eine Messung

Loop

'_______________________________________________________________________________

Temperaturmessung:                                          'die Temperaturmessung anstossen (Konvertierung starten)
   1wreset                                                  '1-Wire-Bus zurücksetzen
   1wwrite &HCC                                             'Adressromīs überspringen
   1wwrite &H44                                             'Temperaturkonverion für alle anstossen
   wait 1                                                   'Konvertierzeit
   1wverify Temp_Adr(1)                                     'sendet "Match ROM "
   if err = 1 then                                          'Error = 1 Fehler aufgetreten
      Sondentemperatur = 9998                               'damit die Stelle nicht leer bleibt, 9998 = Adressmatchfehler
   elseif err = 0 then                                      'Sensor hat geantwortet
      1wwrite &HBE
      Sc(1) = 1wread(9)                                     '9 Bytes in Array einlesen
      if sc(9) = crc8(sc(1) , 8) then
         Sondentemperatur = DeciGrades(sc(9))               'Umwandlung in ein Integer-Word (-32768...32767) zum abspeichern
      else
          Sondentemperatur = 9999                           'damit die Stelle nicht leer bleibt, 9999 = CRC-Fehler
      end if
   endif
Return

'-----------------------------------------------------------

Function Decigrades(byval Sc(9) As Byte)
   Dim Tmp As Byte , T1 As Integer , T2 As Integer

   Tmp = Sc(1) And 1                                        'für 0.1C Genauigkeit, Bit 0 ausmaskieren
   If Tmp = 1 Then Decr Sc(1)                               'wenn 1 dann 1 abziehen
      T1 = Makeint(sc(1) , Sc(2))                           'Umwandeln in Integerwert, Anzahl 1/2° (Temp-Schritt ist 0.5°C)
      T1 = T1 * 50                                          'x50, da 1/100°-Schritte
      T1 = T1 - 25                                          'gemäss DS18S20 data sheet 0.25(*100) abziehen
      T2 = Sc(8) - Sc(7)
      T2 = T2 * 100
      T2 = T2 / Sc(8)
      T1 = T1 + T2
      Decigrades = T1 / 10                                  'Anzahl 1/10°C
End Function

'_______________________________________________________________________________

crlf:
   Text = chr(&h0D) + chr(&h0A)
   serout Text , 0 , B , 4 , Baudrate , 0 , 8 , 1
Return

Seriellaus:
   serout Text , 0 , B , 4 , Baudrate , 0 , 8 , 1
Return

'_______________________________________________________________________________

End


 
besucherzaehler-kostenlos.de