home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / dos / prg / bas / hanlin3 / basupd20 / dateseri.bas < prev    next >
BASIC Source File  |  1992-06-18  |  2KB  |  48 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |           BasUpd  Copyright (c) 1992  Thomas G. Hanlin III           |
  4. '   |                                                                      |
  5. '   |            See BASUPD.DOC for info on distribution policy            |
  6. '   |                                                                      |
  7. '   +----------------------------------------------------------------------+
  8.  
  9.    DEFINT A-Z
  10.  
  11. FUNCTION DateSerial# (YearNr, MonthNr, DayNr)
  12.    IF YearNr < 179 THEN
  13.       Y = YearNr + 1900
  14.    ELSE
  15.       Y = YearNr
  16.    END IF
  17.    IF MonthNr < 1 OR MonthNr > 12 OR DayNr < 1 OR DayNr > 31 OR Y < 1753 OR Y > 2078 THEN
  18.       Result# = 123456789#
  19.    ELSE
  20.       SELECT CASE MonthNr
  21.          CASE 1: Result# = 0#
  22.          CASE 2: Result# = 31#
  23.          CASE 3: Result# = 59#
  24.          CASE 4: Result# = 90#
  25.          CASE 5: Result# = 120#
  26.          CASE 6: Result# = 151#
  27.          CASE 7: Result# = 181#
  28.          CASE 8: Result# = 212#
  29.          CASE 9: Result# = 243#
  30.          CASE 10: Result# = 273#
  31.          CASE 11: Result# = 304#
  32.          CASE 12: Result# = 334#
  33.       END SELECT
  34.       Result# = Result# + CDBL(DayNr) - 1#
  35.       IF Y MOD 4 = 0 AND (Y MOD 100 > 0 OR Y MOD 400 = 0) THEN
  36.          IF MonthNr > 2 THEN Result# = Result# + 1#
  37.       END IF
  38.       DO UNTIL Y <= 1753
  39.          Y = Y - 1
  40.          IF Y MOD 4 = 0 AND (Y MOD 100 > 0 OR Y MOD 400 = 0) THEN
  41.             Result# = Result# + 1#
  42.          END IF
  43.          Result# = Result# + 365#
  44.       LOOP
  45.    END IF
  46.    DateSerial# = Result# - 53688#
  47. END FUNCTION
  48.