Code:
$regfile = "M32def.dat"
$lcd = &HC000
$lcdrs = &H8000
Config Lcdbus = 8
Config Lcd = 20 * 4
Dim Messergebnis As Word
Dim Command As Byte
Dim Tt As String * 20
Dim Ff As String * 20
Dim Calc As Single
Dim Calc1 As Single
Dim Calc2 As Single
Dim Rh_lin As Single
Dim Rh_komp As Single
Dim Tempc As Single
Dim Tempf As Single
Dim Ctr As Single
Dim Dataword As Word
Dim A As Byte
Dim Temp1ist As String * 20
Dim Temp2ist As String * 20
Dim Temp3ist As String * 20
Dim Temp4ist As String * 20
Dim Rlf1ist As String * 20
Dim Rlf2ist As String * 20
Dim Rlf3ist As String * 20
Dim Rlf4ist As String * 20
Dim Temp1soll As Word
Dim Temp2soll As Word
Dim Temp3soll As Word
Dim Temp4soll As Word
Dim Rlf1soll As Word
Dim Rlf2soll As Word
Dim Rlf3soll As Word
Dim Rlf4soll As Word
Const C1 = -4
Const C2 = 0.648
Const C3 = -0.00072
Const T1 = 0.01
Const T2 = 0.00128
Const T1c = 0.04
Const T1f = 0.072
Temp1soll = 30
Temp2soll = 30
Temp3soll = 30
Temp4soll = 30
Rlf1soll = 75
Rlf2soll = 75
Rlf3soll = 75
Rlf4soll = 75
Declare Sub Getit1()
Declare Sub Getit2()
Declare Sub Getit3()
Declare Sub Getit4()
Declare Sub Connection1()
Declare Sub Connection2()
Declare Sub Connection3()
Declare Sub Connection4()
Declare Sub Transmission1()
Declare Sub Transmission2()
Declare Sub Transmission3()
Declare Sub Transmission4()
Declare Sub Temp()
Declare Sub Feucht_lin()
Declare Sub Feucht_kom()
Declare Sub Statusregister()
Declare Sub Befehl1()
Declare Sub Befehl2()
Declare Sub Befehl3()
Declare Sub Befehl4()
Sck1 Alias Portb.0
Dataout1 Alias Portb.1
Datain1 Alias Pinb.1
Sck2 Alias Portb.2
Dataout2 Alias Portb.3
Datain2 Alias Pinb.3
Sck3 Alias Portb.4
Dataout3 Alias Portb.5
Datain3 Alias Pinb.5
Sck4 Alias Portb.6
Dataout4 Alias Portb.7
Datain4 Alias Pinb.7
A = 1
Sensoren_reset:
Command = &B00011110
If A = 1 Then Call Transmission1
If A = 2 Then Call Transmission2
If A = 3 Then Call Transmission3
If A = 4 Then Call Transmission4
If A = 1 Then Call Befehl1
If A = 2 Then Call Befehl2
If A = 3 Then Call Befehl3
If A = 4 Then Call Befehl4
If A < 5 Then Call Statusregister
A = A + 1
If A = 5 Then Goto Main Else Goto Sensoren_reset
Main:
Do
A = 1
Gosub Anzeige
Gosub Sensoren_auslesen
Waitms 10
Loop
Anzeige:
Cls
Locate 1 , 1
Print "1.Chamäleon " ; Temp1ist ; "/" ; Temp1soll ; " °C " ; Rlf1ist ; "/" ; Rlf1soll ; "%"
Locate 2 , 1
Print "2.Geko´s " ; Temp2ist ; "/" ; Temp2soll ; " °C " ; Rlf2ist ; "/" ; Rlf2soll ; "%"
Locate 3 , 1
Print "3.Aufzucht " ; Temp3ist ; "/" ; Temp3soll ; " °C " ; Rlf3ist ; "/" ; Rlf3soll ; "%"
Locate 4 , 1
Print "4.Incubator " ; Temp3ist ; "/" ; Temp3soll ; " °C " ; Rlf3ist ; "/" ; Rlf3soll ; "%"
Return
Sensoren_auslesen:
If A = 1 Then Call Connection1
If A = 2 Then Call Connection2
If A = 3 Then Call Connection3
If A = 4 Then Call Connection4
Command = &B00000011
If A = 1 Then Call Befehl1
If A = 2 Then Call Befehl2
If A = 3 Then Call Befehl3
If A = 4 Then Call Befehl4
Waitms 60
If A = 1 Then Call Getit1
If A = 2 Then Call Getit2
If A = 3 Then Call Getit3
If A = 4 Then Call Getit4
Call Temp
If A = 1 Then Temp1ist = Tt
If A = 2 Then Temp2ist = Tt
If A = 3 Then Temp3ist = Tt
If A = 4 Then Temp4ist = Tt
If A = 1 Then Call Connection1
If A = 2 Then Call Connection2
If A = 3 Then Call Connection3
If A = 4 Then Call Connection4
Command = &B00000101
If A = 1 Then Call Befehl1
If A = 2 Then Call Befehl2
If A = 3 Then Call Befehl3
If A = 4 Then Call Befehl4
Waitms 20
If A = 1 Then Call Getit1
If A = 2 Then Call Getit2
If A = 3 Then Call Getit3
If A = 4 Then Call Getit4
Call Feucht_lin
If Tempc <= 5 Then
Call Feucht_kom
Else
If Tempc >= 45 Then
Call Feucht_kom
Else
Rh_komp = Rh_lin
End If
End If
Ff = Fusing(rh_komp , "##.##")
If A = 1 Then Rlf1ist = Ff
If A = 2 Then Rlf2ist = Ff
If A = 3 Then Rlf3ist = Ff
If A = 4 Then Rlf4ist = Ff
A = A + 1
If A = 5 Then Goto Main Else Goto Sensoren_auslesen
Sub Getit1
Local Datavalue As Word
Local Databyte As Byte
Config Datain1 = Input
Shiftin Datain1 , Sck1 , Databyte , 1 'get the MSB
Datavalue = Databyte
Config Datain1 = Output
Reset Dataout1
Set Sck1
Reset Sck1
Config Datain1 = Input
Shiftin Datain1 , Sck1 , Databyte , 1 'get the LSB
Shift Datavalue , Left , 8
Datavalue = Datavalue Or Databyte
Dataword = Datavalue
Config Datain1 = Output
Set Dataout1
Set Sck1
Reset Sck1
End Sub
Sub Getit2
Local Datavalue As Word
Local Databyte As Byte
Config Datain2 = Input
Shiftin Datain2 , Sck2 , Databyte , 1 'get the MSB
Datavalue = Databyte
Config Datain2 = Output
Reset Dataout2
Set Sck2
Reset Sck2
Config Datain2 = Input
Shiftin Datain2 , Sck2 , Databyte , 1 'get the LSB
Shift Datavalue , Left , 8
Datavalue = Datavalue Or Databyte
Dataword = Datavalue
Config Datain2 = Output
Set Dataout2
Set Sck2
Reset Sck2
End Sub
Sub Getit3
Local Datavalue As Word
Local Databyte As Byte
Config Datain3 = Input
Shiftin Datain3 , Sck3 , Databyte , 1 'get the MSB
Datavalue = Databyte
Config Datain3 = Output
Reset Dataout3
Set Sck3
Reset Sck3
Config Datain3 = Input
Shiftin Datain3 , Sck3 , Databyte , 1 'get the LSB
Shift Datavalue , Left , 8
Datavalue = Datavalue Or Databyte
Dataword = Datavalue
Config Datain3 = Output
Set Dataout3
Set Sck3
Reset Sck3
End Sub
Sub Getit4
Local Datavalue As Word
Local Databyte As Byte
Config Datain4 = Input
Shiftin Datain4 , Sck1 , Databyte , 1 'get the MSB
Datavalue = Databyte
Config Datain4 = Output
Reset Dataout4
Set Sck4
Reset Sck4
Config Datain4 = Input
Shiftin Datain4 , Sck4 , Databyte , 1 'get the LSB
Shift Datavalue , Left , 8
Datavalue = Datavalue Or Databyte
Dataword = Datavalue
Config Datain4 = Output
Set Dataout4
Set Sck4
Reset Sck4
End Sub
Sub Connection1
Config Datain1 = Output
Set Dataout1
For Ctr = 1 To 15
Set Sck1
Waitus 2
Reset Sck1
Waitus 2
Next Ctr
Call Transmission1
End Sub
Sub Connection2
Config Datain2 = Output
Set Dataout2
For Ctr = 1 To 15
Set Sck2
Waitus 2
Reset Sck2
Waitus 2
Next Ctr
Call Transmission2
End Sub
Sub Connection3
Config Datain3 = Output
Set Dataout3
For Ctr = 1 To 15
Set Sck3
Waitus 2
Reset Sck3
Waitus 2
Next Ctr
Call Transmission3
End Sub
Sub Connection4
Config Datain4 = Output
Set Dataout4
For Ctr = 1 To 15
Set Sck4
Waitus 2
Reset Sck4
Waitus 2
Next Ctr
Call Transmission4
End Sub
Sub Transmission1
Config Datain1 = Output
Set Sck1
Reset Dataout1
Reset Sck1
Set Sck1
Set Dataout1
Reset Sck1
End Sub
Sub Transmission2
Config Datain2 = Output
Set Sck2
Reset Dataout2
Reset Sck2
Set Sck2
Set Dataout2
Reset Sck2
End Sub
Sub Transmission3
Config Datain3 = Output
Set Sck3
Reset Dataout3
Reset Sck3
Set Sck3
Set Dataout3
Reset Sck3
End Sub
Sub Transmission4
Config Datain4 = Output
Set Sck4
Reset Dataout4
Reset Sck4
Set Sck4
Set Dataout4
Reset Sck4
End Sub
Sub Temp
Tempf = T1f * Dataword
Tempf = Tempf - 40
Tempc = T1c * Dataword
Tempc = Tempc - 40
Tt = Fusing(tempc , "###.##")
End Sub
Sub Feucht_lin
Calc = C2 * Dataword
Calc1 = Dataword * Dataword
Calc2 = C3 * Calc1
Calc1 = Calc + C1
Rh_lin = Calc1 + Calc2
End Sub
Sub Feucht_kom
Calc = T2 * Dataword
Calc1 = Calc + T1c
Calc2 = Tempc - 25
Calc = Calc2 * Calc1
Rh_komp = Calc + Rh_lin
End Sub
Sub Statusregister
If A = 1 Then Call Transmission1
If A = 2 Then Call Transmission2
If A = 3 Then Call Transmission3
If A = 4 Then Call Transmission4
Command = &B00000110
If A = 1 Then Call Befehl1
If A = 2 Then Call Befehl2
If A = 3 Then Call Befehl3
If A = 4 Then Call Befehl4
If A = 1 Then Call Transmission1
If A = 2 Then Call Transmission2
If A = 3 Then Call Transmission3
If A = 4 Then Call Transmission4
Command = &B00000001 'Switch to 8/12 bit resolution
If A = 1 Then Call Befehl1
If A = 2 Then Call Befehl2
If A = 3 Then Call Befehl3
If A = 4 Then Call Befehl4
End Sub
Sub Befehl1
Config Datain1 = Output
Shiftout Dataout1 , Sck1 , Command , 1
Reset Dataout1
Reset Sck1
Set Sck1
Bitwait Datain1 , Reset 'Wait ACK
Reset Sck1
End Sub
Sub Befehl2
Config Datain2 = Output
Shiftout Dataout2 , Sck2 , Command , 1
Reset Dataout2
Reset Sck2
Set Sck2
Bitwait Datain2 , Reset 'Wait ACK
Reset Sck2
End Sub
Sub Befehl3
Config Datain3 = Output
Shiftout Dataout3 , Sck3 , Command , 1
Reset Dataout3
Reset Sck3
Set Sck3
Bitwait Datain3 , Reset 'Wait ACK
Reset Sck3
End Sub
Sub Befehl4
Config Datain4 = Output
Shiftout Dataout4 , Sck4 , Command , 1
Reset Dataout4
Reset Sck4
Set Sck4
Bitwait Datain4 , Reset 'Wait ACK
Reset Sck4
End Sub
laut simulator sollte es funktionieren
Lesezeichen