Calendar Code 01 of 02

 BBS: Inland Empire Archive
Date: 01-08-93 (10:53)             Number: 391
From: JOE NEGRON                   Refer#: NONE
  To: AL LAWRENCE                   Recvd: NO  
Subj: Calendar Code 01 of 02         Conf: (2) Quik_Bas

Al, I'm reposting this as Richard Dale informs me that the copy he
received had been cut off.  Let me know if you receive it OK.

============================== Begin code ==============================
DEFINT A-Z

DECLARE SUB OneMthCal (DateX$)

DECLARE FUNCTION Date2Day% (DateX$)
DECLARE FUNCTION Date2Mth% (DateX$)
DECLARE FUNCTION Date2Serial& (DateX$)
DECLARE FUNCTION Date2Year% (DateX$)
DECLARE FUNCTION DayOfTheWeek$ (DateX$)
DECLARE FUNCTION Serial2Date$ (Serial&)
DECLARE FUNCTION MDY2Date$ (Month%, Day%, Year%)
DECLARE FUNCTION MthName$ (DateX$)

CLS
OneMthCal DATE$

SYSTEM

'***********************************************************************
'* FUNCTION Date2Day%
'*
'* PURPOSE
'*    Returns the day number given a date in the standard date format.
'***********************************************************************
FUNCTION Date2Day% (DateX$) STATIC
   Date2Day% = VAL(MID$(DateX$, 4))
END FUNCTION

'***********************************************************************
'* FUNCTION Date2Mth%
'*
'* PURPOSE
'*    Returns the month number given a date in the standard date format.
'***********************************************************************
FUNCTION Date2Mth% (DateX$) STATIC
   Date2Mth% = VAL(DateX$)
END FUNCTION

'***********************************************************************
'* FUNCTION Date2Serial&
'*
'* PURPOSE
'*    Returns the astronomical Julian day number given a date in the
'*    standard date format.  Note that the year must be 1583 or greater.
'*
'* INTERNAL ROUTINE(S)
'*    FUNCTION Date2Day% (DateX$)
'*    FUNCTION Date2Mth% (DateX$)
'*    FUNCTION Date2Year% (DateX$)
'***********************************************************************
FUNCTION Date2Serial& (DateX$) STATIC
   Month% = Date2Mth%(DateX$)
   Day% = Date2Day%(DateX$)
   Year% = Date2Year%(DateX$)

   IF Month% > 2 THEN
      Month% = Month% - 3
   ELSE
      Month% = Month% + 9
      Year% = Year% - 1
   END IF

   TA& = 146097 * (Year% \ 100) \ 4
   TB& = 1461& * (Year% MOD 100) \ 4
   TC& = (153 * Month% + 2) \ 5 + Day% + 1721119
   Date2Serial& = TA& + TB& + TC&
END FUNCTION

'***********************************************************************
'* FUNCTION Date2Year%
'*
'* PURPOSE
'*    Returns the year number given a date in the standard date format.
'***********************************************************************
FUNCTION Date2Year% (DateX$) STATIC
   Date2Year% = VAL(MID$(DateX$, 7))
END FUNCTION

'***********************************************************************
'* FUNCTION DayOfTheWeek$
'*
'* PURPOSE
'*    Returns a string stating the day of the week given a date in the
'*    standard date format.
'*
'* INTERNAL ROUTINE(S)
'*    FUNCTION Date2Serial& (DateX$)
'***********************************************************************
FUNCTION DayOfTheWeek$ (DateX$) STATIC
   DayOfTheWeek$ = MID$("MonTueWedThuFriSatSun",_
                        ((Date2Serial&(DateX$) MOD 7) + 1) * 3 - 2, 3)
END FUNCTION

'***********************************************************************
'* FUNCTION MDY2Date$
'*
'* PURPOSE
'*    Converts Month%, Day%, and Year% to a string in the standard date
'*    format.
'***********************************************************************
FUNCTION MDY2Date$ (Month%, Day%, Year%) STATIC
   MDY2Date$ = RIGHT$("0" + MID$(STR$(Month%), 2), 2) + "-"_
             + RIGHT$("0" + MID$(STR$(Day%), 2), 2) + "-"_
             + RIGHT$("000" + MID$(STR$(Year%), 2), 4)
END FUNCTION
                       <<< End part 01 of 02 >>>

                                --Joe in Bay Ridge, Brooklyn, NY--
                                      Fri  01-08-1993, 10:52

... I would if I could but I can't so I won't.
___
 X Blue Wave/QWK v2.12 X

--- Maximus 2.01wb
 * Origin: * BlueDog BBS * (212) 594-4425 * NYC FileBone Hub (1:278/709)