Code:
$regfile = "m32def.dat"
$framesize = 16
$swstack = 256
$hwstack = 128
$crystal = 16000000
$baud = 9600
Declare Function Decigrades(byval Sc(9) As Byte) As Integer
Declare Sub Ziffer(byval X As Byte , Byval Y As Byte , Byval Z As Byte)
Declare Sub Minmax(byval Id As String , Byval Nr As Byte , Byval Y1 As Byte)
Declare Sub Temp(byval Pin As Byte)
'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------
Declare Sub Settime(byval S As Byte , Byval M As Byte , Byval H As Byte , Byval D As Byte , Byval Month As Byte)
Declare Sub Gettime
Config Timer1 = Timer , Prescale = 256
Config I2cdelay = 5
Config Sda = Portd.4
Config Scl = Portd.3
'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------
Config Pind.4 = Input
Config Pind.5 = Input
Config Pind.6 = Input
Config Porta = Output
Config Portc = Output
Config Graphlcd = 240 * 128 , Dataport = Porta , Controlport = Portc , Ce = 3 , Cd = 0 , Wr = 2 , Rd = 1 , Reset = 4 , Fs = 6 , Mode = 6
'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------
On Timer1 Timer_irq
'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------
Const Timervorgabe = 3036
Dim First As Byte
Dim Rset As Boolean
Dim I As Byte
Dim Ta As Single
Dim Temp As Integer
Dim Temp2 As String * 3
Dim Temp3 As Integer
Dim Dstemp(8) As Byte
Dim Dsid1(8) As Byte
Dim Dsid2(8) As Byte
Dim Dsid3(8) As Byte
Dim Dsid4(8) As Byte
Dim Dsid5(8) As Byte
Dim Dsid6(8) As Byte
Dim Dsid7(8) As Byte
Dim Dsid8(8) As Byte
Dim Dsid9(8) As Byte
Dim Dsid10(8) As Byte
Dim Dsid11(8) As Byte
Dim Dsid12(8) As Byte
Dim Sc(9) As Byte
Dim Minn(12) As Integer
Dim Maxx(12) As Integer
'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------
Dim S As Byte , M As Byte , H As Byte , D As Byte , Month As Byte
Dim Wm As Byte , Yd As Byte
Dim K As String * 20
Enable Timer1
Enable Interrupts
Cls
Cursor Off
Waitms 100
Call Settime(0 , 0 , 0 , 24 , 6)
'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------
Wait 2
First = 2
Portd.3 = 1
Dstemp(1) = &H28
'-------------------------------------------------------------------------------
Dsid1(2) = &H61 'Paul
Dsid1(3) = &HC1
Dsid1(4) = &H81
Dsid1(8) = &H53
'-------------------------------------------------------------------------------
Dsid2(2) = &H80 'Wohnzimmer
Dsid2(3) = &H13
Dsid2(4) = &H82
Dsid2(8) = &H18
'-------------------------------------------------------------------------------
'Dsid3(2) = &H22
'Dsid3(3) = &H42
'Dsid3(4) = &H15
'Dsid3(8) = &H15
'-------------------------------------------------------------------------------
'Dsid4(2) = &HFA
'Dsid4(3) = &H85
'Dsid4(4) = &H15
'Dsid4(8) = &H03
'-------------------------------------------------------------------------------
Dsid5(2) = &HD0 'Küche
Dsid5(3) = &H24
Dsid5(4) = &H82
Dsid5(8) = &HE3
'-------------------------------------------------------------------------------
Dsid6(2) = &H5E 'Flur
Dsid6(3) = &HC1
Dsid6(4) = &H81
Dsid6(8) = &H9A
'-------------------------------------------------------------------------------
Dsid7(2) = &H4A 'Keller
Dsid7(3) = &HC6
Dsid7(4) = &H81
Dsid7(8) = &H4C
'-------------------------------------------------------------------------------
Dsid8(2) = &HD2 'Gisela
Dsid8(3) = &H45
Dsid8(4) = &H82
Dsid8(8) = &H51
'-------------------------------------------------------------------------------
Dsid9(2) = &H12 'Vorlauf
Dsid9(3) = &HAD
Dsid9(4) = &H81
Dsid9(8) = &HA2
'-------------------------------------------------------------------------------
Dsid10(2) = &H73 'Eingang
Dsid10(3) = &HAE
Dsid10(4) = &H81
Dsid10(8) = &H18
'-------------------------------------------------------------------------------
Dsid11(2) = &H71 'Out
Dsid11(3) = &H2B
Dsid11(4) = &H27
Dsid11(8) = &HCF
'-------------------------------------------------------------------------------
Dsid12(2) = &H64 'Büro
Dsid12(3) = &HAC
Dsid12(4) = &H9B
Dsid12(8) = &H66
'-------------------------------------------------------------------------------
'Locate 1 , 32 : Lcd "18:41:13"
Locate 1 , 1 : Lcd " 05.06.2005 min max"
Locate 3 , 1 : Lcd "Paul --.-" : Showpic 72 , 16 , Nrg2 : Showpic 112 , 16 , Nrg2 : Showpic 148 , 16 , Nrg2
Locate 4 , 1 : Lcd "Flur --.-" : Showpic 72 , 24 , Nrg2 : Showpic 112 , 24 , Nrg2 : Showpic 148 , 24 , Nrg2
Locate 5 , 1 : Lcd "Eing. --.-" : Showpic 72 , 32 , Nrg2 : Showpic 112 , 32 , Nrg2 : Showpic 148 , 31 , Nrg2
Locate 6 , 1 : Lcd "Bad --.-" : Showpic 72 , 40 , Nrg2 : Showpic 112 , 40 , Nrg2 : Showpic 148 , 40 , Nrg2
Locate 7 , 1 : Lcd "Keller --.-" : Showpic 72 , 48 , Nrg2 : Showpic 112 , 48 , Nrg2 : Showpic 148 , 48 , Nrg2
Locate 8 , 1 : Lcd "B ro --.-" : Showpic 72 , 56 , Nrg2 : Showpic 7 , 56 , Nrue : Showpic 112 , 56 , Nrg2 : Showpic 148 , 56 , Nrg2
Locate 9 , 1 : Lcd "K che --.-" : Showpic 72 , 64 , Nrg2 : Showpic 7 , 64 , Nrue : Showpic 112 , 64 , Nrg2 : Showpic 148 , 64 , Nrg2
Locate 10 , 1 : Lcd "Wohnz. --.-" : Showpic 72 , 72 , Nrg2 : Showpic 112 , 72 , Nrg2 : Showpic 148 , 72 , Nrg2
Locate 11 , 1 : Lcd "Vorl. --.-" : Showpic 72 , 80 , Nrg2 : Showpic 112 , 80 , Nrg2 : Showpic 148 , 80 , Nrg2
Locate 12 , 1 : Lcd "Nachl. --.-" : Showpic 72 , 88 , Nrg2 : Showpic 112 , 88 , Nrg2 : Showpic 148 , 88 , Nrg2
Locate 13 , 1 : Lcd "Gisela --.-" : Showpic 72 , 96 , Nrg2 : Showpic 112 , 96 , Nrg2 : Showpic 148 , 96 , Nrg2
Locate 14 , 1 : Lcd "OUT 1 --.-" : Showpic 72 , 104 , Nrg2 : Showpic 112 , 104 , Nrg2 : Showpic 148 , 104 , Nrg2
Locate 15 , 1 : Lcd "OUT 2 --.-" : Showpic 72 , 112 , Nrg2 : Showpic 112 , 112 , Nrg2 : Showpic 148 , 112 , Nrg2
Line(0 , 10) -(239 , 10) , 255
Line(77 , 0) -(77 , 127) , 255
Line(113 , 0) -(113 , 127) , 255
Line(149 , 0) -(149 , 127) , 255
Locate 10 , 26 : Lcd "IN"
Locate 14 , 26 : Lcd "OUT"
Showpic 206 , 103 , Nrp
Showpic 232 , 103 , Nrg
Showpic 206 , 71 , Nrp
Showpic 232 , 71 , Nrg
Do
'-------------------------------------------------------------------------------
Locate 3 , 9 'Paul 01
For I = 2 To 4
Dstemp(i) = Dsid1(i)
Next
Dstemp(8) = Dsid1(8)
Call Temp(6) 'Temperature
If Temp <> 850 Then
Call Ziffer(170 , 71 , 1)
Call Ziffer(188 , 71 , 2)
Call Ziffer(214 , 71 , 3)
End If
Call Minmax( "010" , 1 , 3)
'-------------------------------------------------------------------------------
Locate 4 , 9 'Flur 06
For I = 2 To 4
Dstemp(i) = Dsid6(i)
Next
Dstemp(8) = Dsid6(8)
Call Temp(5)
Call Minmax( "020" , 6 , 4)
'-------------------------------------------------------------------------------
Locate 5 , 9 'Eingang 10
For I = 2 To 4
Dstemp(i) = Dsid10(i)
Next
Dstemp(8) = Dsid10(8)
Call Temp(5)
Call Minmax( "030" , 10 , 5)
'-------------------------------------------------------------------------------
Locate 7 , 9 'Keller 07
For I = 2 To 4
Dstemp(i) = Dsid7(i)
Next
Dstemp(8) = Dsid7(8)
Call Temp(4)
Call Minmax( "050" , 7 , 7)
'-------------------------------------------------------------------------------
Locate 8 , 9 'Büro 12
For I = 2 To 4
Dstemp(i) = Dsid12(i)
Next
Dstemp(8) = Dsid12(8)
Call Temp(4)
Call Minmax( "060" , 12 , 8)
'-------------------------------------------------------------------------------
Locate 9 , 9 'Küche 05
For I = 2 To 4
Dstemp(i) = Dsid5(i)
Next
Dstemp(8) = Dsid5(8)
Call Temp(6)
Call Minmax( "070" , 5 , 9)
'-------------------------------------------------------------------------------
Locate 10 , 9 'Wohnzimmer 02
For I = 2 To 4
Dstemp(i) = Dsid2(i)
Next
Dstemp(8) = Dsid2(8)
Call Temp(5)
Call Minmax( "080" , 2 , 10)
'-------------------------------------------------------------------------------
Locate 11 , 9 'Vorlauf 09
For I = 2 To 4
Dstemp(i) = Dsid9(i)
Next
Dstemp(8) = Dsid9(8)
Call Temp(6)
Call Minmax( "090" , 9 , 11)
'-------------------------------------------------------------------------------
'(
Locate 12 , 9 'Nachlauf
For I = 2 To 4
Dstemp(i) = Dsid10(i)
Next
Dstemp(8) = Dsid10(8)
Temperature
Call Minmax( "100" , 10 , 12)
')
'-------------------------------------------------------------------------------
Locate 13 , 9 'Gisela 08
For I = 2 To 4
Dstemp(i) = Dsid8(i)
Next
Dstemp(8) = Dsid8(8)
Call Temp(6)
Call Minmax( "110" , 8 , 13)
'-------------------------------------------------------------------------------
Locate 14 , 9 'OUT1 11
For I = 2 To 4
Dstemp(i) = Dsid11(i)
Next
Dstemp(8) = Dsid11(8)
Call Temp(6)
If Temp <> 850 Then
Call Ziffer(170 , 103 , 1)
Call Ziffer(188 , 103 , 2)
Call Ziffer(214 , 103 , 3)
End If
Call Minmax( "120" , 11 , 14)
'-------------------------------------------------------------------------------
If First = 2 Then
First = 1
Elseif First = 1 Then
First = 0
Else
Wait 20
End If
If Rset = 1 Then
First = 1
Rset = 0
End If
Loop
End
Light:
Portd.4 = 1
Wait 5
Portd.4 = 0
Return
Rst:
Rset = 1
Return
'------------------------------------------------------------------------------'
' S T A R T T E M P '
'------------------------------------------------------------------------------'
Sub Temp(byval Pin As Byte) ' actual measuring
1wreset Pind , Pin ' reset the bus
1wwrite &H55 , 1 , Pind , Pin
1wwrite Dstemp(1) , 8 , Pind , Pin
1wwrite &H44 , 1 , Pind , Pin ' Convert T
Waitus 750
1wreset Pind , Pin
1wwrite &H55 , 1 , Pind , Pin
1wwrite Dstemp(1) , 8 , Pind , Pin
1wverify Dstemp(1) , Pind , Pin 'Issues the "Match ROM "
If Err = 0 Then
1wwrite &HBE , 1 , Pind , Pin
Sc(1) = 1wread(9 , Pind , Pin) 'read bytes into array
If Sc(9) = Crc8(sc(1) , 8) Then
Temp = Decigrades(sc(9))
If Temp <> 850 Then
Ta = Temp / 10
If Temp < 100 Then Lcd " "
Lcd Fusing(ta , "#.#")
End If
End If
Else
Lcd "Err "
End If
Waitms 500
End Sub
Sub Minmax(byval Id As String * 3 , Byval Nr As Byte , Byval Y1 As Byte)
If Temp <> 850 Then
Print Id ; Temp
If First = 0 Then
If Temp < Minn(nr) Then
Minn(nr) = Temp
End If
If Temp > Maxx(nr) Then
Maxx(nr) = Temp
End If
Else
Maxx(nr) = Temp
Minn(nr) = Temp
End If
Locate Y1 , 15
Ta = Minn(nr) / 10
If Minn(nr) < 100 And Minn(nr) > 0 Then Lcd " "
Lcd Fusing(ta , "#.#")
Locate Y1 , 21
Ta = Maxx(nr) / 10
If Maxx(nr) < 100 And Maxx(nr) > 0 Then Lcd " "
Lcd Fusing(ta , "#.#")
Temp = 850
End If
End Sub
Function Decigrades(byval Sc(9) As Byte)
Decigrades = 0
Decigrades = Makeint(sc(1) , Sc(2))
Decigrades = Decigrades * 10
Decigrades = Decigrades / 16
End Function
'------------------------------------------------------------------------------'
' E N D T E M P '
'------------------------------------------------------------------------------'
Sub Ziffer(byval X As Byte , Byval Y As Byte , Byval Z As Byte)
If Temp < 100 And Temp >= 0 Then
Showpic 170 , Y , Leer
If Z = 1 Then X = 188
If Z = 2 Then X = 214
If Z = 3 Then Exit Sub
End If
If Temp < 0 And Temp > -100 Then
Showpic 170 , 103 , Minus
Else
If Temp < -100 Then
Showpic 152 , 103 , Minus
End If
End If
If Temp < 10 And Temp > -10 Then
Showpic 188 , 103 , Nr0
If Z = 1 Then X = 214
If Z = 2 Then Exit Sub
If Z = 3 Then Exit Sub
If Temp < 0 Then Z = 2
End If
If Temp < -10 And Temp > -100 Then
If Z = 1 Then X = 188
If Z = 2 Then X = 214
If Z = 3 Then Exit Sub
Z = Z + 1
End If
If Temp < -100 Then
Z = Z + 1
Else
Showpic 152 , 103 , Leer
End If
Temp2 = Str(temp)
Temp2 = Mid(temp2 , Z , 1)
Select Case Val(temp2)
Case 0 : Showpic X , Y , Nr0
Case 1 : Showpic X , Y , Nr1
Case 2 : Showpic X , Y , Nr2
Case 3 : Showpic X , Y , Nr3
Case 4 : Showpic X , Y , Nr4
Case 5 : Showpic X , Y , Nr5
Case 6 : Showpic X , Y , Nr6
Case 7 : Showpic X , Y , Nr7
Case 8 : Showpic X , Y , Nr8
Case 9 : Showpic X , Y , Nr9
End Select
End Sub
'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------
Sub Gettime()
I2cstart 'generate start
I2cwbyte &HA0 'write addres of PCF8583
I2cwbyte 2 'select second register
I2cstart 'generate repeated start
I2cwbyte &HA1 'write address for reading info
I2crbyte S , Ack 'read seconds
I2crbyte M , Ack 'read minuts
I2crbyte H , Ack 'read hours
I2crbyte Yd , Ack 'read year and days
I2crbyte Wm , Nack 'read weekday and month
I2cstop 'generate stop
'Print Bcd(h) ; ":" ; Bcd(m) ; ":" ; Bcd(s)
'Print Bcd(yd) ; " Month : " ; Bcd(wm)
Locate 1 , 32
Lcd Bcd(h) ; ":" ; Bcd(m) ; ":" ; Bcd(s)
'Locate 3 , 1
'Lcd H ; ":" ; M ; ":" ; S
'Locate 5 , 1
'Lcd Bcd(yd) ; " " ; Bcd(wm)
'Locate 7 , 1
'Lcd Yd ; " " ; Wm
End Sub
Sub Settime(s As Byte , M As Byte , H As Byte , D As Byte , Month As Byte)
S = Makebcd(s) 'seconds
M = Makebcd(m) 'minuts
H = Makebcd(h) 'hours
D = Makebcd(d) 'days
Month = Makebcd(month) 'months
I2cstart 'generate start
I2cwbyte &HA0 'write address
I2cwbyte 0 'select control register
I2cwbyte 8 'set year and day bit for masking
I2cstop 'generate stop
I2cstart 'generate start
I2cwbyte &HA0 'write mode
I2cwbyte 2 'select seconds Register
I2cwbyte S 'write seconds
I2cwbyte M 'write minuts
I2cwbyte H 'write hours
I2cwbyte D 'write days
I2cwbyte Month 'write months
I2cstop
End Sub
Timer_irq:
Timer1 = Timervorgabe
Call Gettime()
Return
'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------
Nr0:
$bgf "0.bgf"
Nr1:
$bgf "1.bgf"
Nr2:
$bgf "2.bgf"
Nr3:
$bgf "3.bgf"
Nr4:
$bgf "4.bgf"
Nr5:
$bgf "5.bgf"
Nr6:
$bgf "6.bgf"
Nr7:
$bgf "7.bgf"
Nr8:
$bgf "8.bgf"
Nr9:
$bgf "9.bgf"
Nrp:
$bgf "p.bgf"
Nrg:
$bgf "g.bgf"
Nrg2:
$bgf "g2.bgf"
Nrue:
$bgf "ue.bgf"
Leer:
$bgf "leer.bgf"
Minus:
$bgf "minus.bgf"
Zitieren
Lesezeichen