What follows is a date information utility program. The main features are:
> computing the difference in days between two dates.
> computing the date of Easter Sunday and other holidays for a given year.
> computing the day of the week.
> cumputing the day of the year (Julian day).
> computing the week number.
After compiling, run the program without any parameters to see the help.
Parts of this program were written as far back as 1985. In general, it is not a model of new programming standards. Gosubs are used throughout, so be tolerant. So far, after all these years, the program works 100%. So before you critique it, compile it and test it.
Please contact me at
[email protected] if you have any questions or issues.
Note: This program will not compile with FreeBasic unless you wish to do extensive modifications.
rem "!DATE" Date Information Program
rem 18-Dec-94 (C) Copyright 1994 Edward F. Moneo
rem 01-Jan-95: Ver 2.0: Add Easter Sunday calculation.
rem 17-Feb-97: Ver 3.0: - Add * input date to mean today's date
rem - Add /e switch means display in Spanish
rem - Add /h switch means show holidays
rem - Add help screen in Spanish (!date /e)
rem - Besides Easter, show Ash Wednesday, Palm Sunday
rem and Thanksgiving.
REM *************************************************************************
REM |-----------------------------------------------|
REM | I N I T I A L I Z A T I O N S E C T I O N |
REM |-----------------------------------------------|
DEFINT A-Z
DECLARE FUNCTION NumStrict (Z$)
REM ***************************************************************************
REM
REM D A T E F U N C T I O N S & S U B R O U T I N E S
REM
REM ***************************************************************************
REM By Edward F. Moneo, 17Aug88, 09Oct88, 25Nov88, 09Feb89, 06Aug94, 01Jan95
REM ***************************************************************************
REM *
REM *** DECLARATIONS FOR DATE FUNCTIONS & SUBROUTINES.
REM *
REM DECLARE'S MUST COME FIRST!
DECLARE FUNCTION Easter$ (YYYY)
DECLARE FUNCTION IsLeapYear% (Z)
DECLARE FUNCTION FillString$ (V#,ZL)
'NOTES ON VARIABLES: VARIABLE TYPE
' (1) means user provided input to date routines.
' (2) means date routine output.
' (3) means can be user input or routine output.
' (4) means for internal use only of routines.
'Warning: Do not leave values in these variables across calls to date routines.
DIM DAYS.OFFSET AS LONG '(1) Plus or minus offset days from given date
DIM YEAR.MIN AS INTEGER '(1) Minimum valid year for dates (default=0)
DIM Lang.Bit AS INTEGER '(1) Language switch: 0=Spanish (default) 1=English
DIM DATE.FACTOR AS SINGLE '(2) Number of days given date is from day zero.
DIM WEEK.DAY AS INTEGER '(2) Day of week value: 1=Sunday....7=Saturday.
DIM WEEK.NUM AS INTEGER '(2) Week number within year (1 to 54).
DIM JULIAN.DAY AS INTEGER '(2) Day number within year (1 to 366).
DIM DATE.OK AS INTEGER '(2) Valid date indicator: -1=True, 0=False.
EASTERSUNDAY$ = "" '(2) Date of Easter as YYYYMMDD for given year.
Z$ = "" '(3) Date string as YYYYMMDD.
DIM ZYY AS INTEGER '(3) Value of the 4 digit year.
DIM ZMM AS INTEGER '(3) Value of the 2 digit month.
DIM ZDD AS INTEGER '(3) Value of the 2 digit day.
DIM ZMAX AS INTEGER '(4) Routine internal value of max days in month.
DIM ZDWORK AS LONG '(4) Variable internal to date routines.
DIM ZFSAVE AS SINGLE '(4) Variable internal to date routines.
DIM ZFSAVE2 AS SINGLE '(4) Variable internal to date routines.
ZTEMP$ = "" '(4) Work string internal to date routines.
ZTEMP2$ = "" '(4) Work string internal to date routines.
'NOTE: The following variables ZMO() and ZMO3$ are internal to date routines.
DIM ZMO(1 TO 12) AS INTEGER
DATA 31,28,31,30,31,30,31,31,30,31,30,31
FOR ZMM=1 TO 12:READ ZMO(ZMM):NEXT
CONST ZMO3$="JANENEFEBFEBMARMARAPRABRMAYMAYJUNJUNJULJULAUGAGOSEPSEPOCTOCTNOVNOVDECDIC"
REM ***** END OF DECLARATIONS FOR DATE FUNCTIONS & SUBROUTINES ****************
REM ***************************************************************************
BY$="!DATE V3.0, (C) Copyright 1994-1997, Edward F. Moneo"
corg$=ltrim$(rtrim$(command$))
c$=ucase$(corg$)
z$="/E":gosub switch.scan
Lang.Bit=(z xor 1) 'Lang.Bit=0=Spanish, =1=English
IF C$="" THEN
CLS
if Lang.Bit=1 then
PRINT "!DATE Date Information Utility Ver 3.0 17-Feb-97"
PRINT " (C) Copyright 1994-1997, Edward F. Moneo
[email protected]"
PRINT
PRINT "Usage: !DATE date#1 [date#2] [offset_days] [/options]"
PRINT
PRINT " - Format for date#1 and date#2 is YYYYMMDD."
PRINT " - An * may be used for date#1 or date#2 to mean today's date."
PRINT " - offset_days may be positive or negative."
PRINT " - Note: date#2 and offset_days are mutually exclusive."
PRINT
PRINT "Options:"
PRINT " - /H means display dates of moveable holidays."
PRINT " - /E means use Spanish for display."
PRINT
PRINT "Output:"
PRINT " - These values are always produced for input and result dates:"
PRINT " * week day = 1 to 7 is Sunday to Saturday respectively."
PRINT " * week number = 1 to 54 is week number within year."
PRINT " * Julian day = 1 to 366 is day number within year."
PRINT " - The following produced when date#1 and date#2 given:"
PRINT " * offset_days = Difference in days, date#2 minus date#1."
PRINT " - The following produced when offset_days given:"
PRINT " * result date = date#1 plus (or minus) offset_days."
else
PRINT "!DATE Utileria de Informacion de Fechas Ver 3.0 17-Feb-97"
PRINT " (C) Copyright 1994-1997, Edward F. Moneo
[email protected]"
PRINT
PRINT "Uso: !DATE Fecha_No.1 [Fecha_No.2] [dias_de_diferencia] [/opciones]"
PRINT
PRINT " - El formato para Fecha_No.1 y Fecha_No.2 es AAAAMMDD."
PRINT " - Un * en estos campos de fecha indica que se use la fecha de hoy."
PRINT " - El campo dias_de_diferencia puede ser positivo o negativo."
PRINT " - Ojo: Fecha_No.2 y dias_de_diferencia son mutuamente exclusivos."
PRINT
PRINT "Opciones:"
PRINT " - /E significa utilizar espa"+chr$(164)+"ol."
PRINT " - /H significa desplegar dias festivos movibles."
PRINT
PRINT "Output:"
PRINT " - Siempre se despliegan los siguientes valores para las fechas:"
PRINT " * Dia de la semana = 1 al 7 es domingo a sabado respectivamente."
PRINT " * Semana numero = 1 al 54 es numero de la semana del a"+chr$(164)+"o."
PRINT " * Dia juliano = 1 al 366 es numero de dia del a"+chr$(164)+"o."
PRINT " - Cuando aparecen los campos Fecha_No.1 y Fecha_No.2, se despliega:"
PRINT " * Dias de diferencia = Fecha_No.2 menos Fecha_No.1."
PRINT " - Cuando aparece el campo dias_de_deferencia, se despliega:"
PRINT " * Fecha de Resultado = Fecha_No.1 mas o menos dias_de_diferencia."
end if
SYSTEM
END IF
cls
color 15,1:print by$
color 7,0
'*** Strip valid switches from corg$; i.e., don't show if valid.
savec$=c$
c$=corg$
z$="/E":gosub switch.scan
z$="/e":gosub switch.scan
z$="/H":gosub switch.scan
z$="/h":gosub switch.scan
corg$=c$
c$=savec$
'***
z$="[!DATE "+corg$+"]"
print z$
print string$(len(z$),".")
if Lang.Bit=0 then 'If Spanish
twide = 20 'width of text before equalsign is 20 in Spanish
z$="ERROR: Fecha invalida en parametro No."
em1$=z$+"1"
em2$=z$+"2"
em3$=z$+"1 y/o No.2"
z$="ERROR: Dias de diferencia: "
em4$=z$+"no son numericos"
em5$=z$+"invalidos"
em6$="*** Error interno de fechas #"
wdate1$="Fecha No.1"
wdate2$="Fecha No.2"
wdate3$="Fecha de Resultado"
textoffset$="Dias de diferencia"
else
twide = 14 'width of text before equalsign is 14 in English
z$="ERROR: Invalid date in parameter #"
em1$=z$+"1"
em2$=z$+"2"
em3$=z$+"1 and/or #2"
em4$="ERROR: Non-numeric offset_days"
em5$="ERROR: Invalid offset_days"
em6$="*** Internal date error #"
wdate1$="date#1"
wdate2$="date#2"
wdate3$="result date"
textoffset$="days_offset"
end if
z$="/H":gosub switch.scan
holidays=z
ZDELIM=INSTR(C$," ")
IF ZDELIM=0 THEN
ZDELIM=INSTR(C$,",")
IF ZDELIM=0 THEN
ZDELIM=LEN(C$)+1
C$=C$+" "
END IF
END IF
Param1$=LTRIM$(RTRIM$(LEFT$(C$,ZDELIM-1))) 'date#1
if param1$="*" then gosub date.today:param1$=z$
Param2$=LTRIM$(RTRIM$(MID$(C$,ZDELIM+1))) 'date#2 or offset_days
if param2$="*" then gosub date.today:param2$=z$
REM *************************************************************************
REM |-------------------------------------|
REM | P R O G R A M M A I N L I N E |
REM |-------------------------------------|
REM *************************************************************************
z$=Param1$
gosub date.factor
if not(date.ok) then print em1$:system
year1$=left$(z$,4)
w$=wdate1$:gosub display
if param2$="" then system
print "....."
if len(param2$)=8 then
z$=Param2$
gosub date.factor
if not(date.ok) then print em2$:system
if left$(z$,4)=year1$ then holidays=0 'dont show holidays again if same yr
w$=wdate2$:gosub display
z$=Param1$
zto$=Param2$
gosub date.difference
IF not(date.ok) then print em3$:system
print "....."
print left$(textoffset$+space$(twide),twide);"= ";days.offset
else 'else must be offset_days
sign=1
if left$(param2$,1)="-" then
sign=-1
param2$=mid$(param2$,2) 'strip sign
elseif left$(param2$,1)="+" then
param2$=mid$(param2$,2) 'strip sign
end if
if not NumStrict(param2$) then print em4$:system
days.offset=val(param2$)*sign
z$=param1$
gosub date.offset
if not(date.ok) then print em5$:system
if left$(z$,4)=year1$ then holidays=0 'dont show holidays again if same yr
w$=wdate3$:gosub display
end if
SYSTEM
REM ***************************************************************************
REM ***** S U B R O U T I N E S
REM ***************************************************************************
display:
savedate$=z$
gosub date.format
print left$(w$+space$(twide),twide);"= ";z$
if Lang.Bit=1 then 'if English
print "week day = ";:print using "###";week.day;
print " ";mid$("SunMonTueWedThuFriSat",3*week.day-2,3)
print "week number = ";:print using "###";week.num
print "Julian day = ";:print using "###";julian.day
if holidays=1 then
gosub getholidays
z$=AshWednesday$:gosub date.format
print "Ash Wednesday = ";z$
z$=PalmSunday$:gosub date.format
print "Palm Sunday = ";z$
z$=EasterSunday$:gosub date.format
print "Easter Sunday = ";z$
z$=Thanksgiving$:gosub date.format
print "Thanksgiving = ";z$
end if
else
' 12345678901234567890
print "Dia de la semana = ";:print using "###";week.day;
print " ";mid$("DOMLUNMARMIEJUEVIESAB",3*week.day-2,3)
print "Semana numero = ";:print using "###";week.num
print "Dia juliano = ";:print using "###";julian.day
if holidays=1 then
gosub getholidays
z$=AshWednesday$:gosub date.format
print "Miercoles de Ceniza = ";z$
z$=PalmSunday$:gosub date.format
print "Domingo de Ramos = ";z$
z$=EasterSunday$:gosub date.format
print "Domingo de Pascuas = ";z$
'* Don't print Thanksgiving when Spanish
end if
end if
return '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
getholidays: 'Based on Easter, compute Palm Sunday & Ash Wednesday
'Also compute Thanksgiving
days.offset= -7 'Palm Sunday is 7 days before Easter
z$=EasterSunday$
gosub date.offset
if not(date.ok) then print em6$;"1":system
PalmSunday$=z$
days.offset=-39 'Palm Sunday is 40th day (last) of lent
gosub date.offset
if not(date.ok) then print em6$;"2":system
AshWednesday$=z$
'* Compute Thanksgiving
nov$=left$(savedate$,4)+"110" 'set to Nov 1 -1
gotthurs=0
for xx=1 to 7 'find 1st Thurs in Nov
z$=nov$+mid$(str$(xx),2)
gosub date.factor
if not(date.ok) then print em6$;"3":system
if week.day=5 then gotthurs=1:exit for
next xx
if gotthurs=0 then print em6$;"4":system
days.offset=21 'Thanksgiving is 4th Thurs in Nov, or 21 days after 1st Thurs
gosub date.offset
if not(date.ok) then print em6$;"5":system
Thanksgiving$=z$
return '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
SWITCH.SCAN: 'Scan C$ for a / type switch in Z$.
' - If not found, Z=0
' - If found, Z=1, and switch bytes removed from C$.
Z=INSTR(UCASE$(C$),Z$)
IF Z>0 THEN
ZL=LEN(Z$):GOSUB ZAP.STRING
Z=1
END IF
return '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
ZAP.STRING: 'Remove string from within C$,
'beginning at Z byte for ZL bytes.
C$=RTRIM$(LEFT$(C$,Z-1)+MID$(C$,Z+ZL))
return '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
REM ***************************************************************************
REM ***** D A T E S U B R O U T I N E S *********************************
REM ***************************************************************************
REM ***************************************************************************
REM ************************ DATE.FACTOR ************************************
REM *
REM *** PRINCIPAL DATE SUBROUTINE:
REM * =========================
REM * - Validate input date string.
REM * - Compute number of days (date.factor) from year 0, month 0, day 0.
REM * - Compute day of week.
REM * - Compute week number.
REM * - Compute "julian" day of year.
REM * - Compute date of Easter Sunday for given year.
REM *
REM * INPUT:
REM * =====
REM * Z$ = Date string formatted as YYYYMMDD.
REM * YEAR.MIN = Minimum year user wishes to allow (default 0)
REM *
REM * OUTPUT:
REM * ======
REM * DATE.OK = -1 if input date VALID. (true)
REM * = 0 if Input date INVALID. (false)
REM * NOTE: IF VALID, THE FOLLOWING VARIABLES AR BASED ON INPUT DATE.
REM * IF INVALID, THE VALUES MAY HAVE CHANGED AND ARE MEANINGLESS.
REM * DATE.FACTOR = Number of cumulative days from year/month/day 0.
REM * WEEK.DAY = 1 to 7 is Sunday to Saturday respectively.
REM * WEEK.NUM = 1 TO 54 is week number within year.
REM * JULIAN.DAY = 1 TO 366 is day number within year.
REM * ZYY = Value of of 4 digit year.
REM * ZMM = Value of month.
REM * ZDD = Value of day.
REM * EASTERSUNDAY$ = Date of Easter for given year.
REM * Z$ = (unchanged).
REM * YEAR.MIN = (unchanged).
REM *
REM *
REM * Date factor logic adopted from a Texas Instruments calculator manual.
REM *
DATE.FACTOR:
gosub Date.Check 'check input date
if not(date.ok) then RETURN 'exit if invalid
zmm=1:zdd=1 'set to January 1st
gosub Compute.Factor 'compute factor of Jan 1st
zfsave=date.factor 'save factor of Jan 1st
gosub Compute.Weekday 'week.day now has day of week of Jan 1st
zdd=val(right$(z$,2)) 'Restore input date's day + month
zmm=val(mid$(z$,5,2))
gosub Compute.Factor 'compute factor of input date
'* Julian day is input date minus Jan 1st of same year +1
julian.day=date.factor-zfsave+1
'* Compute the week number: (week.day-1 is week day of Jan 1st relative to 0)
week.num=int((julian.day+(week.day-1)-1)/7)+1
'* Compute the day of the week of input date:
gosub Compute.Weekday
'* Compute date of Easter Sunday:
EasterSunday$ = EASTER(zyy)
RETURN
COMPUTE.FACTOR:
DATE.FACTOR=365!*ZYY+ZDD+31*(ZMM-1) 'NOTE: WON'T WORK WITHOUT ! AFTER 365.
IF ZMM<3 THEN
DATE.FACTOR=DATE.FACTOR+INT((ZYY-1)/4)-INT(3/4*(INT((ZYY-1)/100)+1))
ELSE
DATE.FACTOR=DATE.FACTOR-INT(.4*ZMM+2.3)+INT(ZYY/4)-INT(3/4*(INT(ZYY/100)+1))
END IF
RETURN
COMPUTE.WEEKDAY:
'* Compute the day of the week:
WEEK.DAY=DATE.FACTOR-INT(DATE.FACTOR/7)*7 'Modulo 7.
IF WEEK.DAY=0 THEN WEEK.DAY=7 'WEEK.DAY=1=Sunday.
RETURN
REM ***************************************************************************
REM ****************** DATE.OFFSET ******************************************
REM *
REM *** COMPUTE THE DATE WHICH IS NUMBER OF DAYS FROM GIVEN DATE.
REM *
REM * INPUT:
REM * =====
REM * Z$ = Given date as YYYYMMDD.
REM * DAYS.OFFSET = Number of calendar days plus or minus from given date.
REM * YEAR.MIN = Minimum year user wishes to allow (default 0)
REM *
REM * OUTPUT:
REM * ======
REM * DATE.OK = -1 if input/offset/result date is VALID. (true)
REM * = 0 if input/offset/result date is INVALID. (false)
REM * NOTE: IF VALID, THE FOLLOWING VARIABLES AR BASED ON COMPUTED/RESULT DATE.
REM * IF INVALID, THE VALUES MAY HAVE CHANGED AND ARE MEANINGLESS.
REM * Z$ = Computed/Result date (Given+DAYS.OFFSET) (as YYYYMMDD).
REM * DAYS.OFFSET = (unchanged).
REM * DATE.FACTOR = Number of cumulative days from year/month/day 0.
REM * WEEK.DAY = 1 to 7 is Sunday to Saturday respectively.
REM * WEEK.NUM = 1 TO 54 is week number within year.
REM * JULIAN.DAY = 1 TO 366 is day number within year.
REM * ZYY = Value of of 4 digit year.
REM * ZMM = Value of month.
REM * ZDD = Value of day.
REM * EASTERSUNDAY$ = Date of Easter for computed/result year.
REM * YEAR.MIN = (unchanged).
REM *
DATE.OFFSET:
gosub date.factor
if not (date.ok) then RETURN
if date.factor+days.offset < 0 or_
date.factor+days.offset > 3652424 then Date.ok=0 : RETURN
'3652424 is date.factor for max date of 99991231.
'* Note: Date was split into zyy/zmm/zdd by date.factor routine.
zdwork=zdd+days.offset 'Set to Given day + increment.
if zdwork < 1 then
do
zmm=zmm-1:if zmm=0 then zmm=12:zyy=zyy-1
gosub GetZMax 'go get max days cur month (zmm)
zdwork=zdwork+zmax
loop while zdwork<1
else
gosub GetZMax 'go get max days cur month (zmm)
do while zdwork>zmax
zmm=zmm+1:IF zmm>12 then zmm=1:zyy=zyy+1
zdwork=zdwork-zmax
gosub GetZMax
loop
end if
zdd=zdwork
'* Pack the date as YYYYMMDD
Z$=FILLSTRING$((ZYY),4)+FILLSTRING$((ZMM),2)+FILLSTRING$((ZDD),2)
gosub date.factor 'get all pertinent variables for final date
'* Note: date.factor routine also sets date.ok indicator.
RETURN
GetZMax:
IF ZMM=2 AND ISLEAPYEAR(ZYY) THEN ZMAX=ZMO(ZMM)+1 ELSE ZMAX=ZMO(ZMM)
RETURN
REM ***************************************************************************
REM ****************** DATE.DIFFERENCE **************************************
REM *
REM *** COMPUTE THE DIFFERENCE IN DAYS BETWEEN FROM-DATE AND TO-DATE.
REM *
REM * INPUT:
REM * =====
REM * Z$ = FROM date as YYYYMMDD.
REM * ZTO$ = TO date as YYYYMMDD.
REM * YEAR.MIN = Minimum year user wishes to allow (default 0)
REM *
REM * OUTPUT:
REM * ======
REM * DATE.OK = -1 if FROM/TO dates are VALID. (true)
REM * = 0 if FROM/TO dates are INVALID. (false)
REM * NOTE: IF VALID, THE FOLLOWING VARIABLES AR BASED ON THE TO-DATE.
REM * IF INVALID, THE VALUES MAY HAVE CHANGED AND ARE MEANINGLESS.
REM * DAYS.OFFSET = Difference in days (plus or minus).
REM * DATE.FACTOR = Number of cumulative days from year/month/day 0.
REM * WEEK.DAY = 1 to 7 is Sunday to Saturday respectively.
REM * WEEK.NUM = 1 TO 54 is week number within year.
REM * JULIAN.DAY = 1 TO 366 is day number within year.
REM * ZYY = Value of of 4 digit year.
REM * ZMM = Value of month.
REM * ZDD = Value of day.
REM * EASTERSUNDAY$ = Date of Easter for the year of the TO date.
REM * Z$ = (unchanged)
REM * ZTO$ = (unchanged)
REM * YEAR.MIN = (unchanged).
REM *
DATE.DIFFERENCE:
gosub Date.Factor 'Validate & get factor for FROM-DATE
if not(date.ok) then RETURN 'exit if invalid
zfsave2=date.factor 'save factor of FROM-DATE
Ztemp2$=Z$ 'save FROM-DATE
Z$=ZTO$
gosub Date.Factor 'Validate & get factor for TO-DATE
Z$=ZTemp2$ 'restore FROM-DATE
if not(date.ok) then RETURN 'exit if invalid
Days.Offset = Date.Factor-zfsave2 'TO factor minus FROM factor is diff.
RETURN
REM ***************************************************************************
REM ****************** DATE.TODAY *******************************************
REM *
REM *** SUBROUTINE TO GET TODAY'S DATE AND FORMAT AS YYYYMMDD.
REM *
REM * INPUT: (None)
REM *
REM * OUTPUT: Z$ = Today's date, string as YYYYMMDD.
REM *
DATE.TODAY:
z$=date$ 'Date is mm-dd-yyyy
if left$(time$,2)="00" then z$=date$ 'make sure date didn't just roll over
Z$=right$(z$,4)+left$(z$,2)+mid$(z$,4,2) 'in YYYYMMDD format
RETURN
REM ***************************************************************************
REM ********************* DATE.CHECK ****************************************
REM *
REM *** VALIDATE A DATE IN YYYYMMDD FORMAT.
REM *
REM * INPUT: Z$ = Given date in format YYYYMMDD.
REM * YEAR.MIN = Minimum valid year allowed. (default=0)
REM *
REM * OUTPUT: DATE.OK = -1 if input date is VALID. (true)
REM * 0 if input date is INVALID. (false)
REM * (if VALID):
REM * ZYY = Value of 4 digit year.
REM * ZMM = Value of month.
REM * ZDD = Value of day.
REM *
REM *
DATE.CHECK:
DATE.OK = 0 'preset to false
ZTEMP$="1"+Z$+"1"
IF LEN(Z$)<>8 OR MID$(STR$(VAL(ZTEMP$)),2)<>ZTEMP$ THEN RETURN
ZDD=VAL(RIGHT$(Z$,2)) 'Set day
ZMM=VAL(MID$(Z$,5,2)) 'Set month.
ZYY=VAL(LEFT$(Z$,4)) 'Set year.
IF ZMM<1 OR ZMM>12 OR ZDD<1 OR ZDD>31 OR ZYY<YEAR.MIN THEN RETURN
IF ZMO(ZMM)+1*(-(ZMM=2 AND ISLEAPYEAR(ZYY))) < ZDD THEN RETURN
' If expression (month=2 and is leapyear) is TRUE which is -1, then
' taking the negative of this issues a plus 1. Conversely, the FALSE
' always gives a zero. Multiplying the +1 by this result of 1 or 0
' will either add 1 or not to the number of days in the month.
' The routine wants to add 1 only when it is February and leap year.
DATE.OK = -1 '-1=valid (true)
RETURN
REM ***************************************************************************
REM ****************** DATE.FORMAT ******************************************
REM *
REM *** FORMAT A DATE FOR PRINTING.
REM *
REM * INPUT: Z$ in format YYYYMMDD. (assumed to be already validated)
REM *
REM * OUTPUT: Z$ formatted as DD-MMM-YYYY.
REM * Where MMM is alpha month, in English or Spanish,
REM * based on LANG.BIT (0=Spanish).
REM * NOTE: LANG.BIT is external to this routine.
REM *
DATE.FORMAT:
Z$=RIGHT$(Z$,2)+"-"+MID$(ZMO3$,6*VAL(MID$(Z$,5,2))-2-(3*Lang.Bit),3)_
+"-"+LEFT$(Z$,4)
RETURN
REM ***************************************************************************
REM ***************************************************************************
rem NOTE:
rem * A date can be set to a working day (Mon-Fri) by going to Date.Factor
rem and testing if week.day is 2 to 6.
REM ***************************************************************************
REM ***************************************************************************
END
REM ***************************************************************************
REM ***************************************************************************
REM ***** D A T E F U N C T I O N S *************************************
REM ***************************************************************************
' ====================== ISLEAPYEAR ==========================
' Determines if a year is a leap year or not.
' ============================================================
'
FUNCTION IsLeapYear (Z) STATIC
' If the year is evenly divisible by 4 and not divisible
' by 100, or if the year is evenly divisible by 400, then
' it's a leap year.
' NOTE: The logic for years being a multiple of 4000 has not been
' implemented pending official notification.
IsLeapYear = (Z MOD 4 = 0 AND Z MOD 100 <> 0) OR (Z MOD 400 = 0)
END FUNCTION
' ========================= FILLSTRING =============================
' Converts a value to string of specified length with leading zeros.
' ==================================================================
FUNCTION FillString$ (V#,ZL) STATIC
FILLSTRING$=right$(STRING$(ZL,"0")+MID$(STR$(V#),2),ZL)
END FUNCTION
' ===================================================================
' ========================= EASTER ============================================
' Computes date of Easter Sunday for input year.
' Acknowledgement and thanks to Donald E. Knuth.
' Ref: The Art of Computer Programming, Volume 1 Fundamental Algorithms, 1.3.2.
' Knuth's algorithm was implemented as such, with no enhancements.
' According to Knuth, this logic will work up to a 5 digit year.
' This logic has been tested up to the year 9999.
' The resultant Easter dates have been verified for years 1901 through 2100.
' =============================================================================
FUNCTION Easter$ (YYYY) STATIC
REM *
REM *** COMPUTE DATE OF EASTER SUNDAY FOR GIVEN YEAR.
REM *
REM * INPUT: YYYY assumed to be a 4 digit year (max 9999)
REM *
REM * OUTPUT: a date string formatted as YYYYMMDD.
REM *
REM * USAGE: E$ = EASTER$(YYYY)
'* All variables are set to LONG to handle arithmetic
'* for large year numbers.
DIM Y AS LONG
DIM G AS LONG
DIM C AS LONG
DIM X AS LONG
DIM Z AS LONG
DIM D AS LONG
DIM E AS LONG
DIM TEMP AS LONG
DIM N AS LONG
Y = YYYY '* Force year as long
'* Compute "golden number" of the year in the 19-year Metonic cycle.
G = (Y mod 19) + 1
'* Compute the Century. Note: When Y is not multiple of 100,
'* C is the century number.
C = INT(Y/100) + 1
'* Corrections:
'* X is number of years, like 1900, in which leap year was dropped
'* in order to keep in step with the sun.
'* Z is special correction to sync Easter with the moon's orbit.
X = INT(3*C/4) - 12
Z = INT((8*C + 5) / 25) - 5
'* Find Sunday
D = INT(5*Y/4) - X - 10
'* Compute so-called Epact, which specifies when a full moon occurs.
TEMP = (11*G + 20 + Z - X)
E = TEMP-30*INT(TEMP/30) 'Same as TEMP MOD 30 but works for negative TEMP.
if (E=25 and G>11) or E=24 then E=E+1
'* Find full moon. Easter is the 1st Sunday after the 1st full moon
'* which occurs on or after March 21st.
'* This is a "calendar moon" not actual moon.
N = 44 - E
if N<21 then N=N+30
'* Advance to Sunday.
N = N + 7 - ( (D+N) mod 7 )
'* Get Month.
'* N is the day.
if N>31 then
zmm=4 'April
N=N-31
else
zmm=3 'March
end if
'* Pack Easter date as YYYYMMDD
Easter$=FILLSTRING$((Y),4)+FILLSTRING$((zmm),2)+FILLSTRING$((N),2)
END FUNCTION
' =============================================================================
FUNCTION NumStrict (Z$)
REM *
REM *** (NUMSTRICT) - CHECK FOR STRICTLY NUMERIC ONLY (NO NULL NO DECIMAL)
REM *
NumStrict=0 'Init to False
IF Z$="" THEN EXIT FUNCTION
FOR X = 1 TO LEN(Z$)
A=ASC(MID$(Z$,X,1))
IF A<48 OR A>57 THEN EXIT FUNCTION
NEXT X
NumStrict = -1 'True
END FUNCTION