Code:
$crystal = 4000000
$regfile = "m16DEF.dat"
$baud = 115200
Declare Sub Initlcdc()
Declare Sub Initlcdg()
Declare Sub Sendlcdcommand(byval Command1 As Byte , Byval Data1 As Byte)
Declare Sub Waitifbusy()
Declare Sub Setcursor(byval Y As Byte , Byval X As Byte)
Declare Sub Setpixel(byval Y As Byte , Byval X As Byte)
Declare Sub Clearpixel(byval Y As Byte , Byval X As Byte)
Declare Sub Writechar(byval Char As Byte)
Declare Sub Lcdwait()
Declare Sub Shifte()
Declare Sub Writetext(byval Text As String , Byval Y As Byte , Byval X As Byte)
Declare Sub Clearlcd()
Declare Sub Drawline(byval X1 As Integer , Byval X2 As Integer , Byval Y1 As Integer , Byval Y2 As Integer)
Dim I As Byte , G As Integer , Tempstring As String * 30
Dim Temperaturc As Byte , Helligkeitc As Byte 'A/D Kanäle
Dim Temperatur As Word , Helligkeit As Word 'A/D Werte
Config Adc = Single , Prescaler = Auto , Reference = Avcc
Ddrc = &B11111111
Ddrd = &B11100000
Ddrb = &B00000011
Ddra = &B00000000
cbi portb, 1
sbi portb, 0
Waitms 500
Call Initlcdc
Call Clearlcd
Call Writetext( "BCC-FAHRADCOMPUTER-SYSTEM" , 3 , 8)
Call Writetext( "VERSION 1.0" , 4 , 15)
Call Writetext( "STATUS:" , 6 , 1)
Call Writetext( "STARTE A/D WANDLER" , 7 , 1)
Start Adc
Waitms 500
Call Writetext( "KONFIGURIERE A/D KANAELE" , 7 , 1)
Temperaturc = 0
Helligkeitc = 1
Waitms 500
Call Writetext( "KANAELE KONFIGURIERT " , 7 , 1)
Waitms 500
Call Writetext( "STARTE SYSTEM " , 7 , 1)
Waitms 500
sbi portb,1
cbi portb,0
Call Clearlcd
Call Setcursor(1 , 1)
Call Writetext( "FAHRRADCOMPUTER V.1.0" , 1 , 10)
Waitms 300
Do
Temperatur = Getadc(temperaturc)
Helligkeit = Getadc(helligkeitc)
Temperatur = Temperatur / 1024 'Faktor bestimmen
Temperatur = Temperatur * 5 'Mit Vrev Multiplizieren
Temperatur = Temperatur * 100 'Grad bestimmen (1mv = 1°C)
Tempstring = Str(temperatur)
Tempstring = "Temperatur: " + Tempstring
Tempstring = Tempstring + " C "
Call Writetext(tempstring , 4 , 1)
If Helligkeit < 300 Then
Call Writetext( "LICHTHELLIGKEIT-GERING" , 7 , 1)
Sound Pinb.2 , 1000 , 10
Else
Call Writetext( "========= OK =========" , 7 , 1)
End If
Tempstring = Str(helligkeit)
Tempstring = "Helligkeit: " + Tempstring
Tempstring = Tempstring + " LUX "
Call Writetext(tempstring , 5 , 1)
Waitms 200
Loop
End
Sub Initlcdc()
Call Sendlcdcommand(&H0 , &H30) 'Mode Controll schreiben
Call Sendlcdcommand(&H1 , &H75) 'Character Pitch schreiben
Call Sendlcdcommand(&H2 , &H27) 'Send Horizontal Count data
Call Sendlcdcommand(&H3 , &H7F) 'MUX-Rate schreiben
Call Sendlcdcommand(&H4 , &H7) 'Cursor Position schreiben
Call Sendlcdcommand(&H8 , &H0) 'Start High Adresse schreiben
Call Sendlcdcommand(&H9 , &H0) 'Start Low Adresse schreiben
Call Sendlcdcommand(&Ha , &H0) 'Cursor Setzen (Position) (Low)
Call Sendlcdcommand(&Hb , &H0) 'Cursor Setzen (Position) (high) 'LCD Ist Initialisiert
End Sub
Sub Initlcdg()
Call Sendlcdcommand(&H0 , &H32) 'Mode Controll schreiben
Call Sendlcdcommand(&H1 , &H77) 'Character Pitch schreiben
Call Sendlcdcommand(&H2 , &H1D) 'Send Horizontal Count data
Call Sendlcdcommand(&H3 , &H7F) 'MUX-Rate schreiben
Call Sendlcdcommand(&H4 , &H7) 'Cursor Position schreiben
Call Sendlcdcommand(&H8 , &H0) 'Start High Adresse schreiben
Call Sendlcdcommand(&H9 , &H0) 'Start Low Adresse schreiben
Call Sendlcdcommand(&Ha , &H0) 'Cursor Setzen (Position) (Low)
Call Sendlcdcommand(&Hb , &H0) 'Cursor Setzen (Position) (high)
End Sub
Sub Sendlcdcommand(byval Command1 As Byte , Byval Data1 As Byte)
Call Waitifbusy
Portd = &H20 'R/S auf 1 Setzen, alle anderen auf 0
Portc = Command1
Call Shifte
'R/S und E auf 1 setzen
Call Waitifbusy
Portd = &H0 'Alle auf 0 Setzem
Portc = Data1
Call Shifte ' E auf 1 Setzem
End Sub
Sub Waitifbusy()
Ddrc = &B01111111
Portd = &B01100000
Do
Portd = &B11100000
If Pinc.7 = 0 Then
Exit Do
Else
End If
Portd = &B011000000
nop
Loop
Ddrc = &B11111111
End Sub
Sub Writechar(byval Char As Byte)
Call Waitifbusy
Portd = &H20
Portc = &HC
Call Shifte
Call Waitifbusy
Portd = &H0
Portc = Char
Call Shifte
Portd = &H0
End Sub
Sub Setcursor(byval Y As Byte , Byval X As Byte)
Dim Testdata As String * 4 , Temp As String * 2
G = X - 1
G = G * 40
Y = Y - 1
G = G + Y
Testdata = Hex(g)
If Len(testdata) = 1 Then
Testdata = "000" + Testdata
Elseif Len(testdata) = 2 Then
Testdata = "00" + Testdata
Elseif Len(testdata) = 3 Then
Testdata = "0" + Testdata
Else
Testdata = Testdata
End If
Temp = Mid(testdata , 3 , 2)
I = Hexval(temp)
Call Sendlcdcommand(&Ha , I)
Temp = Mid(testdata , 1 , 2)
I = Hexval(temp)
Call Sendlcdcommand(&Hb , I) 'Set Upper byte
End Sub
Sub Lcdwait()
nop
nop
nop
nop
nop
nop
End Sub
Sub Shifte()
sbi portd, 7
Call Lcdwait
cbi portd,7
End Sub
Sub Writetext(byval Text As String , Byval Y As Byte , Byval X As Byte)
Dim F As Byte
Dim Temps As String * 1
Call Setcursor(x , Y)
For I = 1 To Len(text)
Temps = Mid(text , I , 1)
F = Asc(temps)
Call Writechar(f)
Next I
End Sub
Sub Clearlcd()
Call Setcursor(1 , 1)
For G = 1 To 320
Call Writechar(&H20)
Next I
Call Setcursor(1 , 1)
End Sub
Sub Setpixel(byval Y As Byte , Byval X As Byte)
Call Setcursor(y , X)
Call Sendlcdcommand(&Hf , &H2) 'Set Lower byte
End Sub
Sub Clearpixel(byval Y As Byte , Byval X As Byte)
Call Sendlcdcommand(&He , &H7) 'Set Lower byte
End Sub
Sub Drawline(byval X1 As Integer , Byval X2 As Integer , Byval Y1 As Integer , Byval Y2 As Integer)
End Sub
Da kannste doch Text und Pixel mit setzen.
Zitieren
Lesezeichen