Code:
$regfile = "m8def.dat"
$crystal = 3686400
$baud = 115200
'*******************************************************************************
'Portb.0 Brenner Ein/Aus
'Portb.1 Pumpe Ein/Aus
'Portb.2 Pumpe Ein/Aus
'Portb.3 Pumpe Ein/Aus
'Portb.4 Pumpe Ein/Aus
'Portb.5 Pumpe Ein/Aus
'***************************Definition allgemeiner Variabeln********************
Dim J As Byte
Dim Relais As Byte
Dim Tagnacht As Bit
Dim Zeitinmin As Integer
'Dim Testzeit As Integer
'Testzeit = 21
'***************************Config LCD-Display**********************************
Config Lcd = 16 * 2
Config Lcdpin = Pin , Rs = Portd.2 , E = Portd.3 , Db4 = Portd.4 , Db5 = Portd.5 , Db6 = Portd.6 , Db7 = Portd.7
Config Lcdbus = 4
Config Lcdmode = Port
'***************************Config Schaltausgänge*******************************
Config Portb = Output
'Config Portb.0 = Output
'Config Portb.1 = Output
'Config Portb.2 = Output
'*************************Config Timer1*****************************************
Config Timer1 = Timer , Prescale = 64 '256 'Konfiguriere Timer1
Enable Timer1 'schalte den Timer1 ein
On Timer1 Isr_von_timer1 'verzweige bei Timer1 überlauf zu Isr_von_Timer1
Enable Interrupts
Timer1 = 51135 'Timer1 soll schon von 34285 wegzählen
'***************************Config RTC******************************************
Config Sda = Portc.4
Config Scl = Portc.5
Const Ds1307w = &HD0 ' Addresses of Ds1307 clock
Const Ds1307r = &HD1
Config Clock = User ' this will dim the bytes automatic
Dim Weekday As Byte
'Time$ = "19:07:00" ' to watch the day changing value
'Date$ = "13.10.07" ' erstmaliges stellen der Uhr
'***************************Config 1Wire****************************************
Config 1wire = Portb.3 ' DS1820 on pin 12 (pull up)
Declare Sub Read1820
Declare Sub Crcit
Declare Sub Temperature
Dim Bd(9) As Byte
Dim I As Byte , Tmp As Byte
Dim Crc As Byte
Dim T As Integer , Temp As Single
Dim V As Byte
'Dim Temp_ad(j) As Byte
Deflcdchar 0 , 6 , 9 , 9 , 6 , 32 , 32 , 32 , 32 ' replace ? with number (0-7)
Cursor Off Noblink
Cls
'***************************Config AD-Wandler***********************************
Config Adc = Single , Prescaler = Auto
Start Adc
Config Portc.0 = Input
Config Portc.1 = Input
Config Portc.2 = Input
Config Portc.3 = Input
Dim Ad As Integer
Dim Sp As Single
Dim Temp_ad(9) As Single
'***************************Hauptprogramm***************************************
Do
Temperature
Waitms 250
Gosub Anzeigetime
Gosub Ad_wandler
Gosub Anzeigeadwandler
Gosub Schalterelais
Waitms 1000
Loop
End
'*************************Anzeige AD_Wandler************************************
Anzeigeadwandler:
Locate 2 , 1
Lcd "Tk ="
For J = 1 To 4
Locate 2 , 3
Lcd J
Locate 2 , 7
Lcd Fusing(temp_ad(j) , "##.##")
Waitms 1500
Next J
Return
'*************************Sub AnzeigeTime***************************************
Anzeigetime:
Locate 1 , 1
Lcd Time$
'Locate 1 , 1
'Lcd Date$ ;
'Waitms 1000
Return
'**************************Sub AD_Wanlder***************************************
Ad_wandler:
For J = 1 To 4
Ad = J - 1
Ad = Getadc(ad)
Sp = Ad * 0.51
If Temp_ad(j) > 100 Then
Temp_ad(j) = 999.99
Else
Temp_ad(j) = Sp - 272
End If
Waitms 10
Next I
Ad = Getadc(4)
Temp_ad(3) = Temp_ad(3) - 3.5
Return
'**************************Subroutine für Timer1********************************
Isr_von_timer1: 'ISR von Timer1
Timer1 = 51135
If _hour >= 20 Then 'Sp > 2 Then 'Timer1 soll wieder von 34285 wegzählen
Tagnacht = 0
End If
If _hour >= 2 And _hour < 20 Then
Tagnacht = 1
End If
Zeitinmin = _hour * 60
Zeitinmin = Zeitinmin + _min
Return
'*************************Sub Relais schalten***********************************
Schalterelais:
Select Case Tagnacht
Case 1
Gosub Tagbetrieb
Case 0
Gosub Nachtbetrieb
End Select
Return
'**************************Sub für Tagbetrieb***********************************
Tagbetrieb:
Portb.0 = 1 'Brenner
Portb.1 = 1 'Pumpe
Return
'**************************Sub für Nachtbetrieb*********************************
Nachtbetrieb:
Portb.0 = 0
If Zeitinmin > 1200 And Zeitinmin < 1245 Then
Portb.1 = 1
Else
Portb.1 = 0
End If
If Temp_ad(3) > 21.1 Then
Portb.0 = 0
Portb.1 = 0
Else
Portb.0 = 1
Portb.1 = 1
End If
Return
'***************************Subs für RTC****************************************
Getdatetime:
I2cstart ' Generate start code
I2cwbyte Ds1307w ' send address
I2cwbyte 0 ' start address in 1307
I2cstart ' Generate start code
I2cwbyte Ds1307r ' send address
I2crbyte _sec , Ack
I2crbyte _min , Ack ' MINUTES
I2crbyte _hour , Ack ' Hours
I2crbyte Weekday , Ack ' Day of Week
I2crbyte _day , Ack ' Day of Month
I2crbyte _month , Ack ' Month of Year
I2crbyte _year , Nack ' Year
I2cstop
_sec = Makedec(_sec) : _min = Makedec(_min) : _hour = Makedec(_hour)
_day = Makedec(_day) : _month = Makedec(_month) : _year = Makedec(_year)
Return
Setdate:
_day = Makebcd(_day) : _month = Makebcd(_month) : _year = Makebcd(_year)
I2cstart ' Generate start code
I2cwbyte Ds1307w ' send address
I2cwbyte 4 ' starting address in 1307
I2cwbyte _day ' Send Data to SECONDS
I2cwbyte _month ' MINUTES
I2cwbyte _year ' Hours
I2cstop
Return
Settime:
_sec = Makebcd(_sec) : _min = Makebcd(_min) : _hour = Makebcd(_hour)
I2cstart ' Generate start code
I2cwbyte Ds1307w ' send address
I2cwbyte 0 ' starting address in 1307
I2cwbyte _sec ' Send Data to SECONDS
I2cwbyte _min ' MINUTES
I2cwbyte _hour ' Hours
I2cstop
Return
'*******************************************************************************
Sub Temperature ' actual measuring
'
' 1wwrite &HCC : 1wwrite &H44 ' start measure
' Waitms 300 ' wait for end of conversion
' Read1820 ' read 9 bytes
'
' If Err = 1 Then ' if there is no sensor
' Locate 2 , 8 : Lcd " -- " ' we put "-- " on LCD
' Else
' If Crc = 0 Then ' sensor present, check CRC
' Locate 2 , 8 : Lcd Fusing(temp , "#.##") ; Chr(0) ; "C" ' CRC OK, print T*10 on LCD
' Else
' Locate 2 , 8 : Lcd " ** " ' CRC NOT OK, "** " on LCD
' End If
' End If
End Sub
'*******************************************************************************
'Sub Read1820 ' reads sensor ans calculate
' ' T for 0.1 C
' 1wreset ' reset the bus
' 1wwrite &HCC ' read internal RAM
' 1wwrite &HBE ' read 9 data bytest
' Bd(1) = 1wread(9) ' read bytes in array
' 1wreset ' reset the bus
'
' Crcit ' ckeck CRC
'' If Crc = 0 Then ' if is OK, calculate for
' Tmp = Bd(1) And 1 ' 0.1C precision
' If Tmp = 1 Then Decr Bd(1)
' T = Makeint(bd(1) , Bd(2))
' T = T / 2
' Temp = Bd( - Bd(7)
' Temp = Temp / Bd(
' Temp = T + Temp
' Temp = Temp - 0.25
' End If
'End Sub
'*******************************************************************************
Sub Crcit ' calculate 8 bit CRC
' bigger but faster
Crc = 0 ' needs a 256 elements table
For I = 1 To 9
Tmp = Crc Xor Bd(i)
Crc = Lookup(tmp , Crc8)
Next
End Sub
'*******************************************************************************
Crc8:
Data 0 , 94 , 188 , 226 , 97 , 63 , 221 , 131 , 194 , 156
Data 126 , 32 , 163 , 253 , 31 , 65 , 157 , 195 , 33 , 127
Data 252 , 162 , 64 , 30 , 95 , 1 , 227 , 189 , 62 , 96
Data 130 , 220 , 35 , 125 , 159 , 193 , 66 , 28 , 254 , 160
Data 225 , 191 , 93 , 3 , 128 , 222 , 60 , 98 , 190 , 224
Data 2 , 92 , 223 , 129 , 99 , 61 , 124 , 34 , 192 , 158
Data 29 , 67 , 161 , 255 , 70 , 24 , 250 , 164 , 39 , 121
Data 155 , 197 , 132 , 218 , 56 , 102 , 229 , 187 , 89 , 7
Data 219 , 133 , 103 , 57 , 186 , 228 , 6 , 88 , 25 , 71
Data 165 , 251 , 120 , 38 , 196 , 154 , 101 , 59 , 217 , 135
Data 4 , 90 , 184 , 230 , 167 , 249 , 27 , 69 , 198 , 152
Data 122 , 36 , 248 , 166 , 68 , 26 , 153 , 199 , 37 , 123
Data 58 , 100 , 134 , 216 , 91 , 5 , 231 , 185 , 140 , 210
Data 48 , 110 , 237 , 179 , 81 , 15 , 78 , 16 , 242 , 172
Data 47 , 113 , 147 , 205 , 17 , 79 , 173 , 243 , 112 , 46
Data 204 , 146 , 211 , 141 , 111 , 49 , 178 , 236 , 14 , 80
Data 175 , 241 , 19 , 77 , 206 , 144 , 114 , 44 , 109 , 51
Data 209 , 143 , 12 , 82 , 176 , 238 , 50 , 108 , 142 , 208
Data 83 , 13 , 239 , 177 , 240 , 174 , 76 , 18 , 145 , 207
Data 45 , 115 , 202 , 148 , 118 , 40 , 171 , 245 , 23 , 73
Data 8 , 86 , 180 , 234 , 105 , 55 , 213 , 139 , 87 , 9
Data 235 , 181 , 54 , 104 , 138 , 212 , 149 , 203 , 41 , 119
Data 244 , 170 , 72 , 22 , 233 , 183 , 85 , 11 , 136 , 214
Data 52 , 106 , 43 , 117 , 151 , 201 , 74 , 20 , 246 , 168
Data 116 , 42 , 200 , 150 , 21 , 75 , 169 , 247 , 182 , 232
Data 10 , 84 , 215 , 137 , 107 , 53
As Byte
Zitieren
Lesezeichen