BBS: Inland Empire Archive Date: 01-08-93 (10:54) Number: 392 From: JOE NEGRON Refer#: NONE To: AL LAWRENCE Recvd: NO Subj: Calendar Code 02 of 02 Conf: (2) Quik_Bas
'*********************************************************************** '* FUNCTION MthName$ '* '* PURPOSE '* Returns then name of the month given a string in the standard date '* format. '*********************************************************************** FUNCTION MthName$ (DateX$) STATIC MthName$ = MID$("JanFebMarAprMayJunJulAugSepOctNovDec",_ VAL(DateX$) * 3 - 2, 3) END FUNCTION '*********************************************************************** '* SUB OneMthCal '* '* PURPOSE '* Prints a one-month calendar for the given date at the current '* screen location. '* '* INTERNAL ROUTINE(S) '* FUNCTION Date2Day% (DateX$) '* FUNCTION Date2Mth% (DateX$) '* FUNCTION Date2Serial& (DateX$) '* FUNCTION Date2Year% (DateX$) '* FUNCTION DayOfTheWeek$ (DateX$) '* FUNCTION MDY2Date$ (Month%, Day%, Year%) '* FUNCTION MthName$ (DateX$) '* FUNCTION Serial2Date$ (Serial&) '*********************************************************************** SUB OneMthCal (DateX$) STATIC Row% = CSRLIN Col% = POS(0) MName$ = MthName$(DateX$) LOCATE Row%, Col% + 12 - LEN(MName$) \ 2 Year% = Date2Year%(DateX$) PRINT MName$; ","; Year% Month% = Date2Mth%(DateX$) Day% = 1 Date1$ = MDY2Date$(Month%, Day%, Year%) Serial& = Date2Serial&(Date1$) Heading$ = " Sun Mon Tue Wed Thu Fri Sat" WA% = INSTR(1, Heading$, LEFT$(DayOfTheWeek$(Date1$), 3)) \ 4 LOCATE Row% + 1, Col% PRINT Heading$ RowLoc% = Row% + 2 LOCATE RowLoc%, Col% + 4 * WA% DO PRINT USING "####"; Day%; IF WA% = 6 THEN RowLoc% = RowLoc% + 1 LOCATE RowLoc%, Col% END IF WA% = (WA% + 1) MOD 7 Serial& = Serial& + 1 Day% = Date2Day%(Serial2Date$(Serial&)) LOOP UNTIL Day% = 1 END SUB '*********************************************************************** '* FUNCTION Serial2Date$ '* '* PURPOSE '* Returns a date in the standard date format given a Julian day '* number. '* '* INTERNAL ROUTINE(S) '* FUNCTION MDY2Date$ (Month%, Day%, Year%) '*********************************************************************** FUNCTION Serial2Date$ (Serial&) STATIC X& = 4 * Serial& - 6884477 Y& = (X& \ 146097) * 100 D& = (X& MOD 146097) \ 4 X& = 4 * D& + 3 Y& = (X& \ 1461) + Y& D& = (X& MOD 1461) \ 4 + 1 X& = 5 * D& - 3 M& = X& \ 153 + 1 D& = (X& MOD 153) \ 5 + 1 IF M& < 11 THEN Month% = M& + 2 ELSE Month% = M& - 10 END IF Day% = D& Year% = Y& + M& \ 11 DateX$ = MDY2Date$(Month%, Day%, Year%) Serial2Date$ = DateX$ END FUNCTION =============================== End code =============================== <<< End part 02 of 02 >>> --Joe in Bay Ridge, Brooklyn, NY-- Fri 01-08-1993, 10:53 ... Make it as simple as possible, but no simpler. ___ X Blue Wave/QWK v2.12 X --- Maximus 2.01wb * Origin: * BlueDog BBS * (212) 594-4425 * NYC FileBone Hub (1:278/709)
Books at Amazon:
Back to BASIC: The History, Corruption, and Future of the Language
Hackers: Heroes of the Computer Revolution (including Tiny BASIC)
Go to: The Story of the Math Majors, Bridge Players, Engineers, Chess Wizards, Scientists and Iconoclasts who were the Hero Programmers of the Software Revolution
The Advent of the Algorithm: The Idea that Rules the World
Moths in the Machine: The Power and Perils of Programming
Mastering Visual Basic .NET