home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Between Heaven & Hell 2
/
BetweenHeavenHell.cdr
/
100
/
57
/
mngmonry.arc
/
DATEDIST.BAS
< prev
next >
Wrap
BASIC Source File
|
1986-07-19
|
2KB
|
53 lines
100 'Time between dates in years, months, days ("DATEDISTANCE")
110 CLS
120 COLOR 0,15 : PRINT "Date Distance" : COLOR 15,0
130 PRINT
140 ' Let user enter dates
150 GOSUB 1000 'Get number of days in months
160 PRINT "Enter starting date"
170 GOSUB 2000 'Get starting date
180 SMONTH = MONTH : SDAY = DAY : SYEAR = YEAR
190 PRINT
200 PRINT "Enter ending date"
210 GOSUB 2000 'Get ending date
220 EMONTH = MONTH : EDAY = DAY : EYEAR = YEAR
230 PRINT
240 ' Ending day at or after starting day
250 IF EDAY >= SDAY THEN TOTALDAYS = EDAY - SDAY
260 ' Ending day before starting day
270 PREVMONTH = EMONTH - 1
280 IF PREVMONTH = 0 THEN PREVMONTH = 12
290 IF EDAY < SDAY THEN TOTALDAYS = EDAY + NDAYS (PREVMONTH) - SDAY
300 ' Find number of elapsed months
310 TOTALMONTHS = 12 * (EYEAR - SYEAR) + EMONTH - SMONTH
320 IF EDAY < SDAY THEN TOTALMONTHS = TOTALMONTHS - 1
330 TOTALYEARS = TOTALMONTHS \ 12
340 TOTALMONTHS = TOTALMONTHS - 12 * TOTALYEARS
350 ' Print results
360 PRINT "Years: ", TOTALYEARS
370 PRINT "Months: ", TOTALMONTHS
380 PRINT "Days: ", TOTALDAYS"
390 END
990 ' Subroutine to set up list with number of days in months
1000 DIM NDAYS(12)
1010 FOR N = 1 TO 12
1020 READ NDAYS(N)
1030 NEXT N
1040 'Number of days in months
1050 DATA 31, 28, 31, 30
1060 DATA 31, 30, 31, 31
1070 DATA 30, 31, 30, 31
1080 RETURN
1990 ' Subroutine to let user enter date
2000 INPUT "Month (1-12): ", MONTH
2010 IF (MONTH < 1) OR (MONTH > 12) THEN PRINT " *No such month *": GOTO 2000
2020 INPUT "Day (1-31): ", DAY
2030 INPUT "Year: ", YEAR
2040 IF (YEAR < 1900) OR (YEAR > 2100) THEN PRINT "Invalid year": GOTO 2000
2050 'Check for leap year
2060 IF (YEAR MOD 4) = 0 AND (YEAR MOD 100) <> 0 THEN NDAYS(2) = 29
2070 IF (YEAR MOD 400) = 0 THEN NDAYS(2) = 29
2080 'Check for valid date
2090 IF DAY > NDAYS(MONTH) THEN PRINT "* No such day *": GOTO 2000
2100 RETURN