home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / dos / prg / bas / hanlin3 / pbc30a / dater2a.bas < prev    next >
BASIC Source File  |  1994-03-13  |  1KB  |  41 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        PBClone  Copyright (c) 1990-1994  Thomas G. Hanlin III        |
  4. '   |                                                                      |
  5. '   +----------------------------------------------------------------------+
  6.  
  7.    DECLARE FUNCTION AscM% (St$, BYVAL Posn%)
  8.  
  9. SUB DateR2A (MonthNr%, DayNr%, YearNr%, RelDate&)
  10.    TDate& = RelDate&
  11.    YearNr% = 1899
  12.    DO WHILE TDate& >= 365&
  13.       IF YearNr% MOD 4 = 0 AND YearNr% MOD 100 > 0 OR YearNr% MOD 400 = 0 THEN
  14.          TDate& = TDate& - 366&
  15.       ELSE
  16.          TDate& = TDate& - 365&
  17.       END IF
  18.       YearNr% = YearNr% + 1
  19.    LOOP
  20.    IF TDate& < 0& THEN
  21.       MonthNr% = 12
  22.       DayNr% = 31
  23.       YearNr% = YearNr% - 1
  24.    ELSE
  25.       TDate& = TDate& + 1&
  26.       MonthNr% = 1
  27.       IF YearNr% MOD 4 = 0 AND YearNr% MOD 100 > 0 OR YearNr% MOD 400 = 0 THEN
  28.          MonthDay$ = "313232332323"
  29.       ELSE
  30.          MonthDay$ = "303232332323"
  31.       END IF
  32.       tmp% = AscM%(MonthDay$, MonthNr%) - 20
  33.       DO WHILE TDate& > CLNG(tmp%)
  34.          TDate& = TDate& - CLNG(tmp%)
  35.          MonthNr% = MonthNr% + 1
  36.          tmp% = AscM%(MonthDay$, MonthNr%) - 20
  37.       LOOP
  38.       DayNr% = CINT(TDate&)
  39.    END IF
  40. END SUB
  41.