I am creating a RTClock everyting is going well exept the date
can some one help my with this
here is my code:
'------------------------------------------------------------
' CLOCK RTClock.BAS
'-------------------------------------------------------------
$regfile = "M32def.dat" 'specific file for the µP
$crystal = 7372800
$hwstack = 80
$swstack = 64
$framesize = 64
$baud = 115200
'Mcusr = &H80
'Mcusr = &H80
Wait 1
Enable Interrupts ' config clock uses a Timer interrup
$lib "eurotimedate.lbx"
Dim Seconde As Integer
Dim Dag(7) As String * 9 , Maand(12) As String * 10 , Flagj As Bit
Dim Dow As String * 9 , Mnd As String * 10 , Indexdag As Byte , Indexmaand As Byte
Dim J As Byte
Config Pinc.0 = Input
Config Pinc.1 = Input
Config Graphlcd = 240 * 128 , Dataport = Porta , Controlport = Portb , Ce = 2 , Cd = 3 , Wr = 0 , Rd = 1 , Reset = 4 , Fs = 8 , Mode = 6
Config Date = Dmy , Separator = - ' ANSI-Format
Config Clock = Soft
Declare Sub Lcdtext(byval S As String , Byval Xoffset As Byte , Byval Yoffset As Byte , Byval Inverse As Byte , Byval Rotation As Byte)
Declare Sub Set_font(byval Fontset As Byte)
Glcdvet_font Alias 2
Inverted Alias 1
No_inverted Alias 0
Rotate_0 Alias 0
Rotate_90 Alias 1
Rotate_180 Alias 2
Rotate_270 Alias 3
'=== Variables declarations
Dim Row As Byte , Colums As Byte , Byteseach As Byte , Blocksize As Byte
Dim Font_adress As Word
'---------------the main--------------------------------------------------
'initialising
Indexdag = 1 'index of the day
Indexmaand = 1 'index of the month
Seconde = _sec
Cls
Gosub Table ' table of the day and month (we can use data too)
Cursor On , Blink
Gosub Setup
Gosub Setup_data ' adjustement of parameters
Cls
Cursor Off
Locate 1 , 2
Lcd "R E A L T I M E C l O C K"
Line(0 , 10) -(239 , 10) , 1
Line(58 , 10) -(58 , 127) , 1
Wait 2
Do
If Pinc.0 = 0 Or Pinc.1 = 0 Then
Cls
Cursor Off , Blink Off
Gosub Setup
End If
If _hour = 0 And _min = 0 And _sec = 0 Then
Flagj = 1
Gosub Setup_data
End If
Set_font Glcdvet_font
Lcdtext Time$ , 62 , 20 , Inverted , Rotate_0
Locate 8 , 11
Lcd "" ; Dow ; " " ; _day ; " " ; Mnd ; " 20" ; _year
Loop
'----gosub ---------------------------------------
Sub Set_font(byval Fontset As Byte)
Local Dummy_word As Word
Select Case Fontset ' You may use case 1, case 2 etc insted of alias names
Case Glcdvet_font : Font_adress = Loadlabel(glcdvet)
End Select
' --- Load font info needed for Lcdtext subroutine calculations ---
Dummy_word = Font_adress : Row = Cpeek(dummy_word)
Incr Dummy_word : Byteseach = Cpeek(dummy_word)
Incr Dummy_word : Blocksize = Cpeek(dummy_word)
' -----
Colums = Blocksize / Row 'Calculate the numbers of colums
Row = Row * 8 'Row is always 8 pixels high = 1 byte, so working with row in steps of 8.
Row = Row - 1 'Want to start with row=0 instead of 1
Colums = Colums - 1 'Same for the colums
Font_adress = Font_adress + 4 'Skip first 4 bytes in fontfile
End Sub
Sub Lcdtext(byval S As String , Xoffset As Byte , Yoffset As Byte , Inverse As Byte , Rotation As Byte)
Local Tempstring As String * 1 , Temp As Byte 'Dim local the variables
Local A As Byte , Pixels As Byte , Pixels_adress As Word , Carcount As Byte
Local Columcount As Byte , Rowcount As Byte , Stringsize As Byte
Local Xpos As Byte , Ypos As Byte , Pixel As Byte , Pixelcount As Byte
Local Dummy_word As Word
If Inverse > 1 Then Inverse = 0 'Inverse can't be greater then 1
If Rotation > 3 Then Rotation = 0 'There are only 4 rotation's
Stringsize = Len(s) - 1 'Size of the text string -1 because we must start with 0
For Carcount = 0 To Stringsize 'Loop for the numbers of caracters that must be displayed
Temp = Carcount + 1 'Cut the text string in seperate caracters
Tempstring = Mid(s , Temp , 1)
Temp = Asc(tempstring) - 32 'Font files start with caracter 32
Dummy_word = Blocksize * Temp
Pixels_adress = Font_adress + Dummy_word 'Do dummie read to point to the correct line in the fontfile
Temp = Carcount * Byteseach 'Do first part of calculation to get the character on the correct X or Y position
Select Case Rotation
Case 0 '0 degrees rotation
Temp = Temp + Xoffset
For Rowcount = 0 To Row Step 8 'Loop for numbers of Row
A = Rowcount + Yoffset
For Columcount = 0 To Colums 'Loop for numbers of Colums
Pixels = Cpeek(pixels_adress)
Incr Pixels_adress
If Inverse = 1 Then Toggle Pixels 'Read the byte from the file and if inverse = true then invert de byte
Xpos = Columcount
Xpos = Xpos + Temp 'Do rest of calculation to get the character on the correct X position
For Pixelcount = 0 To 7 'Loop for 8 pixels to be set or not
Ypos = A + Pixelcount 'Each pixel on his own spot
Pixel = Pixels.pixelcount 'Set the pixel (or not)
Pset Xpos , Ypos , Pixel 'Finaly we can set the pixel
Next Pixel
Next Columcount
Next Rowcount
Case 1 '90 degrees rotation
For Rowcount = Row To 0 Step -8 'Loop is now counting down
A = Rowcount + Xoffset
A = A - 15 'Correction to set Xpos on Xoffset with rotation
For Columcount = 0 To Colums
Pixels = Cpeek(pixels_adress)
Incr Pixels_adress
If Inverse = 1 Then Toggle Pixels
Xpos = Columcount
Xpos = Xpos + Yoffset
Xpos = Xpos + Temp 'We want that Xoffset is still Xoffset, so we need here the change from x to y
For Pixelcount = 7 To 0 Step -1
Ypos = A + Pixelcount
Pixel = Pixels.0
Pset Ypos , Xpos , Pixel
Shift Pixels , Right
Next Pixel
Next Columcount
Next Rowcount
Case 2 '180 degrees rotation
For Rowcount = Row To 0 Step -8
A = Rowcount + Yoffset
A = A - 7 'Correction to set Xpos on Xoffset with rotation
For Columcount = Colums To 0 Step -1
Pixels = Cpeek(pixels_adress)
Incr Pixels_adress
If Inverse = 1 Then Toggle Pixels
Xpos = Columcount
Xpos = Xpos - Temp
Xpos = Xpos - 8 'Correction to set Xpos on Xoffset with rotation
Xpos = Xpos + Xoffset
For Pixelcount = 7 To 0 Step -1
Ypos = A + Pixelcount
Pixel = Pixels.0
Pset Xpos , Ypos , Pixel
Shift Pixels , Right
Next Pixel
Next Columcount
Next Rowcount
Case 3 '270 degrees rotation
For Rowcount = 0 To Row Step 8
A = Rowcount + Xoffset
For Columcount = Colums To 0 Step -1
Pixels = Cpeek(pixels_adress)
Incr Pixels_adress
If Inverse = 1 Then Toggle Pixels
Xpos = Columcount
Xpos = Xpos - Temp
Xpos = Xpos - 8 'Correction to set Xpos on Xoffset with rotation
Xpos = Xpos + Yoffset
For Pixelcount = 0 To 7
Ypos = A + Pixelcount
Pixel = Pixels.pixelcount
Pset Ypos , Xpos , Pixel
Next Pixel
Next Columcount
Next Rowcount
End Select
Next Carcount
End Sub
'=== Includes ===
$include "Glcdvet.font"
'----setup----------------------------------------
Setup:
Opnieuw:
' Day------------------------
Locate 12 , 30 : Lcd "-SETUP- "
Waitms 400
Do
Locate 14 , 30 : Lcd Dag(indexdag)
If Pinc.0 = 0 Then
Indexdag = Indexdag + 1
Waitms 100
End If
If Indexdag = 8 Then
Indexdag = 1
Locate 14 , 30 : Lcd Dag(indexdag)
End If
Loop Until Pinc.1 = 0
Dow = Dag(indexdag)
Waitms 250
Cls
'- Year-------------------------
J = 0
Locate 12 , 30 : Lcd "-JAAR-"
Do
Locate 14 , 30 : Lcd J
If Pinc.0 = 0 Then
J = J + 1
Waitms 100
End If
If J = 60 Then
Locate 14 , 30 : Lcd " "
J = 0
End If
Loop Until Pinc.1 = 0
_year = J
Waitms 250
Cls
'- Month------------------------
Locate 12 , 30 : Lcd "-MAAND- "
Do
Locate 14 , 30 : Lcd Maand(indexmaand)
If Pinc.0 = 0 Then
Indexmaand = Indexmaand + 1
Waitms 100
End If
If Indexmaand = 13 Then
Indexmaand = 1
Locate 14 , 30 : Lcd Maand(indexmaand)
End If
Loop Until Pinc.1 = 0
_month = Maand(indexmaand)
Waitms 250
Cls
'-Day of month--------------------
J = 1
Locate 12 , 30 : Lcd "-DAG- "
Do
Locate 14 , 30 : Lcd J
If Pinc.0 = 0 Then
J = J + 1
Waitms 100
End If
If J = 32 Then
Locate 14 , 30 : Lcd " "
J = 1
End If
Loop Until Pinc.1 = 0
_day = J
Waitms 250
Cls
'- Hours---------------------------
J = 0
Locate 12 , 30 : Lcd "-UREN- "
Do
Locate 14 , 30 : Lcd J
If Pinc.0 = 0 Then
J = J + 1
Waitms 100
End If
If J = 24 Then
Locate 14 , 30 : Lcd " "
J = 0
End If
Loop Until Pinc.1 = 0
_hour = J
Waitms 250
Cls
'- Minutes-------------------------
J = 0
Locate 12 , 30 : Lcd "-MINUTEN- "
Do
Locate 14 , 30 : Lcd J
If Pinc.0 = 0 Then
J = J + 1
Waitms 100
End If
If J = 60 Then
Locate 14 , 30 : Lcd " "
J = 0
End If
Loop Until Pinc.1 = 0
_min = J
Waitms 250
Cls
'-----------------------------
Do
Locate 12 , 30 : Lcd "-Goed=R"
Locate 14 , 30 : Lcd "-Fout=L"
If Pinc.0 = 0 Then
Cls
Goto Opnieuw
Waitms 100
End If
Waitms 100
Loop Until Pinc.1 = 0
Cursor Off , Noblink
Cls
Return
'-----------------------------------------------
Table:
Dag(1) = "MAANDAG"
Dag(2) = "DINSDAG"
Dag(3) = "WOENSDAG"
Dag(4) = "DONDERDAG"
Dag(5) = "VRIJDAG"
Dag(6) = "ZATERDAG"
Dag(7) = "ZONDAG"
'-----------------------
Maand(1) = "JANUARI "
Maand(2) = "FEBRUARI "
Maand(3) = "MAART "
Maand(4) = "APRIL "
Maand(5) = "MEI "
Maand(6) = "JUNI "
Maand(7) = "JULI "
Maand(8) = "AUGUSTUS "
Maand(9) = "SEPTEMBER "
Maand(10) = "OKTOBER "
Maand(11) = "NOVEMBER "
Maand(12) = "DECEMBER "
Return
'----setup-data---------------------------------------
Setup_data:
If Flagj = 1 Then
Indexdag = Indexdag + 1
If Indexdag = 8 Then
Indexdag = 1
End If
If _day > 28 Then
Select Case _month
Case 1
If _day = 31 And Indexmaand = 1 Then
_day = 1
Mnd = Maand(2)
Indexmaand = 2
End If
Case 2
If _day = 28 And Indexmaand = 2 Then
_day = 1
Mnd = Maand(3)
Indexmaand = 3
End If
Case 3
If _day = 31 And Indexmaand = 3 Then
_day = 1
Mnd = Maand(4)
Indexmaand = 4
End If
Case 4
If _day = 30 And Indexmaand = 4 Then
_day = 1
Mnd = Maand(5)
Indexmaand = 5
End If
Case 5
If _day = 31 And Indexmaand = 5 Then
_day = 1
Mnd = Maand(6)
Indexmaand = 6
End If
Case 6
If _day = 30 And Indexmaand = 6 Then
_day = 1
Mnd = Maand(7)
Indexmaand = 7
End If
Case 7
If _day = 31 And Indexmaand = 7 Then
_day = 1
Mnd = Maand(8)
Indexmaand = 8
End If
Case 8
If _day = 31 And Indexmaand = 8 Then
_day = 1
Mnd = Maand(9)
Indexmaand = 9
End If
Case 9
If _day = 30 And Indexmaand = 9 Then
_day = 1
Mnd = Maand(10)
Indexmaand = 10
End If
Case 10
If _day = 31 And Indexmaand = 10 Then
_day = 1
Mnd = Maand(11)
Indexmaand = 11
End If
Case 11
If _day = 30 And Indexmaand = 11 Then
_day = 1
Mnd = Maand(12)
Indexmaand = 12
End If
Case 12
If _day = 31 And Indexmaand = 12 Then
_day = 1
Mnd = Maand(1)
Indexmaand = 1
End If
End Select
End If
End If
Dow = Dag(indexdag)
Mnd = Maand(indexmaand)
Dow = Rtrim(dow)
Dow = Dow + " "
Mnd = " " + Mnd
Mnd = Rtrim(mnd)
Flagj = 0
Waitms 500
Return
'---------------------------------------------------------------
[b:b559587e17][color=red:b559587e17](BASCOM-AVR version : 2.0.7.6 )[/b:b559587e17][/color:b559587e17]
↧