SUB DateConverter (StandardDate$, month%, DayOfMonth%, year%, DayNumber, DayOfWeek$, DayOfWeekNum%, week%, Language%) '(C) 1998 by Theatre Support Services, Inc., 310 SW 66th Terr., Margate, FL ' Shareware $2.00 licensing fee. 'This routine allows input of a date in standard MM-DD-YYYY format or as 'mm%,dd%,yy% or yyyy% to get the day of week (MON, etc.) and a day number 'that corresponds to the MS Works integer day number. 'This routine is only needed for QB or qBasic. 'VB Users have similar functionality by using SerialDate. 'The routine is highly annotated to show the logic to non-programmers. 'Experienced programmers may cringe at the occasional GOTO, but without 'the use of GOTOs, you wouldn't be here. Every single hyperlink on the net 'is essentially a GOTO with a different name, so lighten up guys!'Standard integer%, String$, etc. extensions are used for clarity. 'If a day number is input to this routine instead of a date, 'the date and day of week are returned. 'Proper conversions are crucial to any program offering continuous 'reporting functions, and to insure against Y2K problems. 'Faster code would start with a later date and eliminate floating point numbers 'but the routine is usually used only a few times in a program, so speed 'isn't an issue as much as compatibility and not relying on any outside code. 'The Players, in order of appearance: 'StandardDate$ 'Month% 'DayOfMonth% 'Year% 'DayNumber 'this could be long, but no harm is done using float 'DayofWeek$ 'DayOfWeekNum% 'Week% 'Language% 'The roles of the supporting cast become obvious. '---- DEFINITIONS BEGIN HERE ---------- DIM MO%(12) DIM DayOfWeek$(7) True% = 1 'Yeah, I know, -1. Whatever. False% = 0 'Yes, the following could be in a data file to shrink the dgroup memory usage. 'This is clearer and keeps the constants safer than in a data file. MO%(1) = 31 MO%(2) = 28 MO%(3) = 31 MO%(4) = 30 MO%(5) = 31 MO%(6) = 30 MO%(7) = 31 MO%(8) = 31 MO%(9) = 30 MO%(10) = 31 MO%(11) = 30 MO%(12) = 31 SELECT CASE Language% CASE 0 DayOfWeek$(1) = "FRI" DayOfWeek$(2) = "SAT" DayOfWeek$(3) = "SUN" DayOfWeek$(4) = "MON" DayOfWeek$(5) = "TUE" DayOfWeek$(6) = "WED" DayOfWeek$(7) = "THU" CASE 1 DayOfWeek$(1) = "Friday" DayOfWeek$(2) = "Saturday" DayOfWeek$(3) = "Sunday" DayOfWeek$(4) = "Monday" DayOfWeek$(5) = "Tuesday" DayOfWeek$(6) = "Wednesday" DayOfWeek$(7) = "Thursday" CASE 2 DayOfWeek$(1) = "VIE" DayOfWeek$(2) = "SAB" DayOfWeek$(3) = "DOM" DayOfWeek$(4) = "LUN" DayOfWeek$(5) = "MAR" DayOfWeek$(6) = "MIE" DayOfWeek$(7) = "JUE" 'add cases as needed for language END SELECT FinishedFlag% = False% '---- MAIN PROGRAM BEGINS HERE -------- ConvertDateToDOW: 'First, check to see if a DayNumber has been passed. It has priority. IF DayNumber < 0 THEN DayNumber = 0 IF DayNumber > 0 AND FinishedFlag% = False% THEN NumDays = DayNumber GOTO ConvertDayNumToDate END IF IF StandardDate$ > "" THEN 'break it into sections the program can eat 'Note- This version does not allow for other international date conventions. year% = VAL(MID$(StandardDate$, 7, 4)) month% = VAL(MID$(StandardDate$, 1, 2)) DayOfMonth% = VAL(MID$(StandardDate$, 4, 2)) END IF 'but if the sections have been entered manually or by the calling program, 'those sections take presidence over a full date IF month% > 0 AND month% < 13 THEN Mn% = month% IF DayOfMonth% > 0 AND DayOfMonth% < 32 THEN Da% = DayOfMonth% IF year% >= 1900 THEN Yr% = year% 'many bios default to 01-01-1980, so since 1980 was about the date of 'pc introduction, we'll use that as the pivot for two digit years '(This is the first part of Y2K compliance.) IF year% >= 80 AND year% <= 99 THEN Yr% = year% + 1900 IF year% >= 0 AND year% < 80 THEN Yr% = year% + 2000 'limit wild entries IF month% > 12 OR month% < 0 THEN BadDateFlag% = True% SELECT CASE month% CASE 1, 3, 5, 7, 8, 10, 12 IF DayOfMonth% > 31 OR DayOfMonth% < 0 THEN BadDateFlag% = True% CASE 4, 6, 9, 11 IF DayOfMonth% > 30 OR DayOfMonth% < 0 THEN BadDateFlag% = True% CASE 2 IF DayOfMonth% > 29 OR DayOfMonth% < 0 THEN BadDateFlag% = True% END SELECT IF year% > 2099 OR year% < 1900 THEN BadDateFlag% = True% IF BadDateFlag% = True% THEN BadDateFlag% = False% month% = 1 DayOfMonth% = 1 year% = 1980 FinishedFlag% = False% END IF 'Now that we have the year, month, and day of the month, we loop to 'come up with an integer representing the day. MS uses the part after the 'decimal to represent the seconds in a day, but that isn't used here. 'Day 1 is Jan 1, 1900 NumDays = 1 'calls January 1 the number 1 instead of 0 FOR TestYr% = 1900 TO Yr% - 1 'start a loop at Jan 1, 1900 adding days 'find if any year fits the definition of a leap year '(This is the second part of Y2K compliance) IF (TestYr% MOD 4 = 0 AND TestYr% MOD 100 <> 0) OR (TestYr% MOD 400 = 0) THEN 'This is a leap year; Add the number of days in a leap year. NumDays = NumDays + 366 ELSE 'Add the number of days in a regular year NumDays = NumDays + 365 END IF NEXT 'keep adding until all days up to the current year Jan 1 are totalled 'we don't want to add the current year in or we would be 365 days ahead 'thats why the loop specifies yr% - 1 YearDays = NumDays 'we know we have at least this many days. 'Now we need to know if the _current_ year is a leap year. '(This is the third part of Y2K compliance) IF (Yr% MOD 4 = 0 AND Yr% MOD 100 <> 0) OR (Yr% MOD 400 = 0) THEN 'It is a leap year. February has an extra day MO%(2) = 29 END IF FOR TestMo% = 1 TO Mn% - 1 'now do the same adding for the months NumDays = NumDays + MO%(TestMo%) NEXT 'again, don't add the current month 'now we add the days NumDays = NumDays + Da% 'Numdays is the total of year days + month days, 'Da% is the day of the month and cannot be 0 'this is as far as the DATE$ functions go in many microsoft products - 'they don't go the extra step to find the day of the week, as shown below 'use the MOD function to get rid of all whole weeks and get a number 'from 0 to 6 representing a day of the week DayOfWeekNum% = NumDays MOD 7 'for TSS applications DayOfWeekNum% 1 = Friday and so on. 'Since Friday normally starts a film week, this simplifies other code. SELECT CASE DayOfWeekNum% CASE 0 'sat DayOfWeekNum% = 2 CASE 1 'sun DayOfWeekNum% = 3 CASE 2 'mon DayOfWeekNum% = 4 CASE 3 'tue DayOfWeekNum% = 5 CASE 4 'wed DayOfWeekNum% = 6 CASE 5 'thu DayOfWeekNum% = 7 CASE 6 'fri DayOfWeekNum% = 1 END SELECT DayOfWeek$ = DayOfWeek$(DayOfWeekNum%) DayOfYear% = NumDays - YearDays week% = FIX((DayNumber - YearDays) / 7) DayNumber = NumDays FinishedFlag2% = True% '------------------------------------------------------------------------- ConvertDayNumToDate: 'now to reverse the process IF FinishedFlag% = True% GOTO FinishSub BuiltDays = 0 NumDays = NumDays - 1 'get back in synch with the algorythem FOR BuiltYr% = 1900 TO 2099 'use the loop at the year 1900 adding days 'find if any year fits the definition of a leap year IF (BuiltYr% MOD 4 = 0 AND BuiltYr% MOD 100 <> 0) OR (BuiltYr% MOD 400 = 0) THEN 'BuiltYr% qualifies as a leap year, add the number of days in a leap year BuiltDays = BuiltDays + 366 '(BuiltDays is the total days of all previous years) IF NumDays <= BuiltDays THEN 'the date is within this year FoundYear% = BuiltYr% MonthAndDay% = 366 - (BuiltDays - NumDays) EXIT FOR END IF ELSE 'add the number of days in a regular year BuiltDays = BuiltDays + 365 IF NumDays <= BuiltDays THEN 'the date is in this year FoundYear% = BuiltYr% MonthAndDay% = 365 - (BuiltDays - NumDays) EXIT FOR END IF END IF NEXT 'Year :keep adding until all days up to the current year Jan 1 are totalled 'we don't want to add the current year in or we would be 365 days ahead 'now we need to know if FoundYear% is a leap year IF (FoundYear% MOD 4 = 0 AND FoundYear% MOD 100 <> 0) OR (FoundYear% MOD 400 = 0) THEN 'correct the # of days in Feb MO%(2) = 29 END IF BuiltMo% = 0 'reset incrementer FOR TestMo% = 1 TO 12 'now do the same adding for the months IF MonthAndDay% > BuiltMo% + MO%(TestMo%) THEN BuiltMo% = BuiltMo% + MO%(TestMo%) '(add this month's days and continue to BuiltMo%) ELSE 'the number of days left are less than the days in the next month FoundMonth% = TestMo% FoundDay% = MonthAndDay% - BuiltMo% EXIT FOR END IF NEXT month% = FoundMonth% DayOfMonth% = FoundDay% year% = FoundYear% FinMonth$ = RIGHT$("0" + LTRIM$(STR$(month%)), 2) FinDay$ = RIGHT$("0" + LTRIM$(STR$(DayOfMonth%)), 2) FinYear$ = RIGHT$(LTRIM$(STR$(year%)), 4) StandardDate$ = FinMonth$ + "-" + FinDay$ + "-" + FinYear$ IF FinishedFlag2% = True% GOTO FinishSub IF FinishedFlag% = False% THEN 'we still need to get a day of the week FinishedFlag% = True% GOTO ConvertDateToDOW END IF FinishSub: END SUB