Solar Calendar - Printable Version +- Qbasicnews.com (http://qbasicnews.com/newforum) +-- Forum: QBasic (http://qbasicnews.com/newforum/forum-4.html) +--- Forum: QB Projects (http://qbasicnews.com/newforum/forum-12.html) +--- Thread: Solar Calendar (/thread-3014.html) |
Solar Calendar - dadsherm - 01-19-2004 Here's a project I've been working on,(one of many), and I'd like to finish. I've sent it to moneo, but it doesn't seem to arrive there, so I've decided to post it here. It's a Solar Calendar based on the rotation of the Earth around the sun,(solar cycle), as opposed to the lunar cycle, which is what our current calendars are based upon. The only thing left to do, is add some code so it can switch between months, both Forwards and back. Like what you see on a planner. The days of the month and season, year end, ...etc, are not what you'd expect;(i,e: 30 days in Feb. as opposed to 28 or 29, in the case of a leap year.) You'll notice the other differences as you go along. If anyone is interested, please feel free to have fun. The only thing I ask is that you do not use DEFINT, Type(s), Subs, sprites, or call routines. As these are not needed in this type of program. Have Fun ! ' REM DEC. 21ST STANDARD CALENDAR = DEC. 31ST SOLAR ORBIT CALENDAR (S.O.C.) ' REM DEC. 22ND STANDARD CALENDAR = JAN. 1ST (S.O.C.) ' REM FEB. 4TH @ 12:00:00pm (MIDNIGHT) - WINTER ENDS (S.O.C.) ' REM FEB 5TH @ 12:00:01am ( AFTER (PAST) MIDNIGHT) - SPRING BEGINS (S.O.C.) ' REM MARCH 23RD @ 12:00:01PM - 2ND HALF OF SPRING BEGINS (S.O.C.) ' REM MAY 7TH @ 12:00:00pm - SPRING ENDS (S.O.C.) ' REM MAY 8TH @ 12:00:01pm ( AFTER (PAST) MIDNIGHT) - SUMMER BEGINS (S.O.C.) ' REM JUNE 21ST @ 12:00:01PM - 2ND HALF OF SUMMER BEGINS (S.O.C.) ' REM AUG. 7TH @ 12:00:00pm - 2ND HALF OF SUMMER ENDS (S.O.C.) ' REM AUG. 8TH @ 12:00:01am - FALL BEGINS (S.O.C.) ' REM SEPT. 21ST @ 12:00:01 - 2ND HALF OF FALL BEGINS (S.O.C.) ' REM NOV. 4TH @ 12:00:00pm - FALL ENDS (S.O.C.) ' REM NOV. 5TH @ 12:00:01pm - WINTER BEGINS (S.O.C.) ' REM DEC. 21ST @ 12:00:01pm - 2ND HALF OF WINTER BEGINS (S.O.C.) ON ERROR GOTO ERREND CLS : SCREEN 0: WIDTH 80: CLS : R = 6: C = 7 COLOR 12, 7: VIEW PRINT 2 TO 24: CLS FOR R = 2 TO 22 LOCATE R, 6: PRINT STRING$(70, 32): NEXT: R = 6: C = 10: CLS DIM M$(12): DIM NUM(14, 14): DIM F(6, 32): DIM S(6, 32) FOR M = 1 TO 12 READ M$(M): READ NUM(M, 1), NUM(M, 2): NEXT: LY = 0 YEAR: FOR I = 0 TO 2525 GOSUB REFRESH COLOR 15, 7: COL1 = 15: COL2 = 7 MONTH: FOR P = 1 TO 12 LOCATE 2, 11: PRINT STRING$(40, 32); : LOCATE 2, 11: PRINT I LOCATE 2, 25: PRINT M$(P), NUM(P, 1); "/"; NUM(P, 2) IF LY = 4 THEN LOCATE 2, 55: PRINT "LEAPYEAR" DAY: D = D + 1 CD$ = MID$(DATE$, 4, 2): CD = VAL(CD$) IF D > NUM(P, 1) THEN GOTO DNEXT ELSE IF D = CD THEN COLOR 15, 2 ELSE COLOR COL1, COL2 ON P GOTO P1, P2, P3, P4, P5, P6, P7, P8, P9, P10, P11, P12 GOTO SHOWIT P1: COLOR 15, 7 IF D > 20 THEN D2 = D2 + 1: COL1 = 15: COL2 = 7 ELSE IF D2 >= 5 THEN COL1 = 1: COL2 = 7 ELSE COLOR 15, 7: IF D = NUM(P, 1) THEN GOTO PRNTMESS1 ELSE GOTO SHOWIT PRNTMESS1: LOCATE 18, 9: COLOR 15, 7 PRINT "FEB.4TH @ 12:00:00pm (MIDNIGHT) - WINTER ENDS "; COLOR 1, 7: PRINT "/ AND SPRING BEGINS!" COLOR 15, 7: GOTO SHOWIT P2: IF D > 19 THEN D2 = D2 + 1 ELSE IF D = NUM(P, 1) THEN GOTO PRNTMESS2 ELSE COLOR 1, 7: GOTO SHOWIT PRNTMESS2: COLOR 1, 7 LOCATE 18, 31: PRINT "IT'S SPRING TIME!" COLOR 1, 7: COL1 = 1: COL2 = 7: GOTO SHOWIT P3: IF D >= 22 THEN D2 = D2 + 1 ELSE IF D = NUM(P, 1) THEN GOTO PRNTMESS3 ELSE COLOR 1, 7: GOTO SHOWIT PRNTMESS3: LOCATE 18, 13 PRINT "BY MARCH 23RD AT 12:00 NOON, SPRING WILL BE HALF SPRUNG...." GOTO SHOWIT P4: IF D >= 22 THEN D2 = D2 + 1 IF D2 >= 8 THEN COL1 = 14: COL2 = 7 ELSE IF D = NUM(P, 1) THEN GOTO PRNTMESS4 ELSE COLOR 1, 7: GOTO SHOWIT PRNTMESS4: COLOR 1, 7: LOCATE 18, 10 PRINT "MAY 7TH @ 12:00:00 (MIDNIGHT), SPRING ENDS "; COLOR 14, 7: PRINT "/ AND SUMMER BEGINS!" COLOR 1, 7: GOTO SHOWIT P5: IF D >= 22 THEN D2 = D2 + 1 ELSE IF D = NUM(P, 1) THEN GOTO PRNTMESS5 ELSE DCOL1 = 14: DCOL2 = 7: COLOR DCOL1, DCOL2: GOTO SHOWIT PRNTMESS5: COLOR 14, 7: LOCATE 18, 34: PRINT "IT'S SUMMER!" GOTO SHOWIT P6: IF P = 6 AND D >= 22 THEN D2 = D2 + 1 IF D = NUM(P, 1) THEN GOTO PRNTMESS6 ELSE GOTO SHOWIT PRNTMESS6: LOCATE 18, 30: PRINT "WARM ENOUGH FOR YOU?" GOTO SHOWIT P7: IF D >= 23 THEN D2 = D2 + 1 ELSE IF D2 >= 8 THEN COL1 = 6: COL2 = 7 ELSE COLOR DCOL1, DCOL2 IF D = NUM(P, 1) THEN GOTO PRNTMESS7 ELSE GOTO SHOWIT PRNTMESS7: LOCATE 18, 8 PRINT " ON JULY 30TH @ 12:00:00 (MIDNIGHT) SUMMER ENDS "; COLOR 6, 7: PRINT "/ AND FALL BEGINS...": COLOR 14, 7 GOTO SHOWIT P8: DCOL1 = 6: DCOL2 = 7: COLOR DCOL1, DCOL2 IF D >= 23 THEN D2 = D2 + 1 ELSE IF D = NUM(P, 1) THEN GOTO PRNTMESS8 ELSE GOTO SHOWIT PRNTMESS8: LOCATE 18, 18: PRINT "DON'T SWEAT IT...COOLER WEATHER IS ON IT'S WAY!" GOTO SHOWIT P9: IF D >= 23 THEN D2 = D2 + 1 ELSE IF D = NUM(P, 1) THEN GOTO PRNTMESS9 ELSE GOTO SHOWIT PRNTMESS9: LOCATE 18, 29: COLOR 6, 7: PRINT "AHHHH, THIS IS NICE..." GOTO SHOWIT P10: IF D >= 23 THEN D2 = D2 + 1 IF D2 >= 5 THEN COL1 = 15: COL2 = 7 ELSE IF D = NUM(P, 1) THEN GOTO PRNTMESS10 ELSE COLOR 6, 7: GOTO SHOWIT PRNTMESS10: COLOR 6, 7: LOCATE 18, 10 PRINT " AT 12:00:00 (MIDNIGHT) NOV.4TH, FALL ENDS "; COLOR 15, 7: PRINT "/ AND WINTER BEGINS..." COLOR 6, 7: GOTO SHOWIT P11: IF D = 5 THEN COLOR 15, 7 ELSE IF D > 21 THEN D2 = D2 + 1: COL1 = 15: COL2 = 7 ELSE IF D = NUM(P, 1) THEN GOTO PRNTMESS11 ELSE GOTO SHOWIT PRNTMESS11: COLOR 15, 7: LOCATE 18, 6 PRINT "THIS THANKSGIVING, BE SURE TO GIVE GOD THANKS FOR ALL OF YOUR"; PRINT " BLESSINGS": COLOR 15, 7 GOTO SHOWIT P12: IF D > 21 THEN D2 = D2 + 1 ELSE IF D = NUM(P, 1) THEN GOTO PRNTMESS12 ELSE GOTO SHOWIT PRNTMESS12: LOCATE 18, 26: COLOR 6, 11 PRINT " CHRISTMAS TIMES A COME'N " COLOR 15, 7 SHOWIT: LOCATE R, C: IF D = CD THEN NUC = 1: COL1 = COL1 + 16: COLOR COL1, 7 ELSE PRINT D; IF NUC = 1 THEN COL1 = COL1 - 16: NUC = 0 ELSE COLOR COL1, 7: PRINT "/"; IF D2 >= 1 AND D2 <> CD THEN COLOR COL1, COL2: PRINT D2: GOTO SHOWIT2 ELSE IF D2 = CD THEN NUC = 1: COL1 = COL1 + 16: COLOR COL1, COL2: PRINT D2 ELSE IF NUC = 1 THEN COL1 = COL1 - 16: NUC = 0 ELSE COLOR COL1, COL2 SHOWIT2: IF LY = 4 AND P = 1 THEN LOCATE 2, 55: COLOR 15, 7: PRINT "LEAPYEAR" ELSE COLOR COL1, COL2 IF LY = 4 AND P = 5 AND D = 30 THEN LOCATE R, C: GOSUB LEAPYEAR ELSE C = C + 9 IF C >= 70 THEN R = R + 2: C = 10 IF R > 20 THEN R = 6 GOTO DAY: DNEXT: A$ = "" DO WHILE A$ = "" A$ = INKEY$ LOOP L = LEN(A$): IF L = 2 THEN GOTO DNEXT A = ASC(A$) IF A = &H1B THEN END ELSE IF A = &HD THEN GOSUB NEWMONTH ELSE GOTO DNEXT NEXT LY = LY + 1: IF LY > 4 THEN LY = 1 ELSE NEXT NEWMONTH: LOCATE R, C: C1 = C FOR R = 6 TO 18 LOCATE R, 6: PRINT STRING$(72, 32): NEXT D = D2: D2 = 0: R = 6: LOCATE R, C RETURN REFRESH: COLOR 0, 7 LOCATE 2, 55: PRINT STRING$(10, 32) COLOR 1, 7: LOCATE 2, 5: PRINT " YEAR "; LOCATE 4, 10: PRINT " SUNDAY "; " MONDAY "; " TUESDAY "; " WEDNESDAY "; PRINT " THURSDAY "; " FRIDAY "; " SATURDAY "; : COLOR 15, 7 LOCATE 21, 26: PRINT "WINTER "; : COLOR 1, 7: PRINT " SPRING "; COLOR 14, 7: PRINT " SUMMER "; : COLOR 6, 7: PRINT " FALL "; COLOR 0, 7: LOCATE 23, 15 PRINT " OLD CALENDAR MONTH & DAY/NEW CALENDAR MONTH & DAY "; RETURN LEAPYEAR: D = D + 1: D2 = D2 + 1: C = C + 9 IF C >= 70 THEN R = R + 2: C = 10 ELSE LOCATE R, C: PRINT D; "/"; COLOR COL1, COL2: PRINT D2 R = R + 2: IF R > 14 THEN R = 6 ELSE RETURN ERREND: SCREEN , 0, 0: PRINT ERR, ERL RESUME ERRNXT ERRNXT: END DATA JANUARY/FEBURARY,31,30 DATA FEBURARY/MARCH,30,31, MARCH/APRIL,31,30, APRIL/MAY,30,30, MAY/JUNE,30,30 DATA JUNE/JULY,30,31, JULY/AUGUST,31,31, AUGUST/SEPTEMBER,31,30 DATA SEPTEMBER/OCTOBER,30,31, OCTOBER/NOVEMBER,31,30, NOVEMBER/DECEMBER,30,31 DATA DECEMBER/JANUARY,31,31 |