'===========================================================================
' Subject: Number of days between dates       Date: 09-15-02 (  :  )       
'  Author: David Williams                     Code: QB,Qbasic,PDS          
'  Origin: david.williams@ablelink.org      Packet: DATETIME.ABC
'===========================================================================
' DATECALC.BAS 
  
' David Williams. 2002 
  
' david.williams@ablelink.org 
  
' Program does simple calendar calculations, finding the number 
' of days between two dates, or the date that is a given number of 
' days after or before a given date. 
  
' Decimal fractions of days are allowed. 
  
DECLARE SUB SubDates () 
DECLARE SUB AddDays () 
DECLARE SUB DateIn (P$) 
DECLARE SUB XD2G () 
DECLARE SUB G2XD () 
DECLARE FUNCTION Dte$ () 
DECLARE FUNCTION DivMult% (Sep$, N&) 
DEFINT A-Z 
DIM SHARED Year AS INTEGER, Month AS INTEGER, Day AS SINGLE 
DIM SHARED XDay AS DOUBLE 
CLS 
DO 
  PRINT 
  PRINT "1. Calculate number of days between two dates" 
  PRINT "2. Calculate a date plus or minus some days" 
  PRINT "3. Quit program" 
  PRINT 
  PRINT "Which (1 - 3)? "; 
  DO 
    K$ = INKEY$ 
  LOOP UNTIL K$ >= "1" AND K$ <= "3" 
  PRINT K$ 
  PRINT 
  SELECT CASE K$ 
    CASE "1" 
      CALL SubDates 
    CASE "2" 
      CALL AddDays 
    CASE "3" 
      EXIT DO 
  END SELECT 
LOOP 
END 
  
SUB AddDays 
  CALL DateIn("Starting") 
  INPUT "Add how many days (to subtract, use negative)"; Offset# 
  XDay = XDay + Offset# 
  CALL XD2G 
  PRINT "Resulting date (Year, Month, Day) is "; Dte$ 
END SUB 
  
SUB DateIn (P$) 
  DO 
    PRINT P$; " date "; 
    INPUT "(YYYY,MM,DD - with commas)"; Year, Month, Day 
    D1$ = Dte$ 
    CALL G2XD 
    CALL XD2G 
    IF D1$ = Dte$ THEN EXIT DO 
    BEEP 
    PRINT "Illegal Gregorian Date!" 
  LOOP 
END SUB 
  
FUNCTION DivMult (Sep$, N&) 
 A$ = ";146097,400;36524,100;1461,4;365,1:153,5:61,2:31,1" 
 Total = 0 
 B = 1 
 DO 
   B = INSTR(B, A$, Sep$) + 1 
   IF B = 1 THEN EXIT DO 
   Days& = VAL(MID$(A$, B)) 
   IF N& < 0 OR N& >= Days& THEN 
     Quot = INT(N& / Days&) 
     IF Quot = 4 THEN IF MID$(A$, B, 3) = "365" THEN Quot = 3 
     N& = N& - Quot * Days& 
     Total = Total + Quot * VAL(MID$(A$, INSTR(B, A$, ",") + 1)) 
   END IF 
 LOOP 
 DivMult = Total 
END FUNCTION 
  
FUNCTION Dte$ 
  Dte$ = LTRIM$(STR$(Year)) + "," + STR$(Month) + "," + STR$(Day) 
END FUNCTION 
  
SUB G2XD 
  IF Month < 3 THEN 
      Mth = Month + 9 
      Yr = Year - 1 
  ELSE 
      Mth = Month - 3 
      Yr = Year 
  END IF 
  Leap = INT(Yr / 4) - INT(Yr / 100) + INT(Yr / 400) 
  Before = INT(30.6 * Mth + .5) 
  XDay = 365& * Yr + Leap + Before + Day - 1 
END SUB 
  
SUB SubDates 
  CALL DateIn("Earlier") 
  X# = XDay 
  CALL DateIn("Later") 
  PRINT "Difference between dates is"; CSNG(XDay - X#); "days." 
END SUB 
  
SUB XD2G 
  N& = INT(XDay) 
  F! = XDay - N& 
  Year = DivMult(";", N&) 
  Month = DivMult(":", N&) + 3 
  Day = N& + F! + 1 
  IF Month > 12 THEN 
    Month = Month - 12 
    Year = Year + 1 
  END IF 
END SUB