2000-12-29 19:37

'DaysDates Calculator
'(Dec. 29, 2000)
'By Achilles Mina

'This utility is one of the modules of Calculait 3.0, a full-featured
'scientific calculator with a world clock. It will soon be available
'for downloading from ZDNet, Nonags, RocketDownload, CNet and other freeware
'sites. Version 2.0 is currently downloadable at these sites.

'You can do as you please with this code.

     $INCLUDE "RAPIDQ.INC"

     DECLARE SUB GetMonth(monthtocheck AS STRING)
     DECLARE SUB GetDay(daytocheck AS STRING)
     DECLARE SUB NewD
     DECLARE SUB New_Date(key AS BYTE)
     DECLARE SUB DaysD
     DECLARE SUB DaysDifference(key AS BYTE)
     DECLARE FUNCTION GetAOdays AS INTEGER
     DECLARE FUNCTION GetOdays AS INTEGER

     DEFWORD monthnow, monththen, monthchecked, yearnow, yearthen, betyears
     DEFBYTE leapnow, leapthen, bleap, circa, weekday, fmonth, emonth, pmonth, todate, inthepast
     DEFWORD byear, bmonth, bleapyear, yearhence, AOyears, fyear, eyear, pyear
     DEFINT Bdays, rundays, edays, otherdays, totdays, yeardays,Odays, AOdays, diffdays, betleaps, daynow, daythen, Adays
     DEFINT fday, eday, pday, neweday, newpday, monthdays, daysthence, dayshence, bday, days


     CREATE Arial9B AS QFONT
      Name = "Arial"
      Size = 12
      AddStyles(fsBold)
     END CREATE

     CREATE TimeFont AS QFONT
      Name = "Univers"
      COLOR = clGreen
      Size = 12
      AddStyles(fsBold)
     END CREATE

     CREATE DaysDates AS QFORM
      Width = 500
      Height = 250
      Center
      CAPTION = "DaysDates Calculator"
      CREATE NewDForm AS QPANEL
       COLOR = &HABC111
       CAPTION = "New Date"
       Top = 10
       Left = 5
       Width = 237
       Height = 205
       CREATE Month AS QEDIT
        Text = LEFT$(DATE$,2)
        Left = 10
        Top = 5
        Width = 65
        TabOrder = 1
        OnKeyPress = New_Date
       END CREATE
       CREATE Day AS QEDIT
        Text = MID$(DATE$,4,2)
        Left = 82
        Top = 5
        Width = 65
        TabOrder = 2
        OnKeyPress = New_Date
       END CREATE
       CREATE Year AS QEDIT
        Text = RIGHT$(DATE$,4)
        Left = 154
        Top = 5
        Width = 65
        TabOrder = 3
        OnKeyPress = New_Date
       END CREATE
       CREATE DayThence AS QEDIT
        Text = "Days past"
        Left = 10
        Top = 30
        Width = 65
        TabOrder = 4
        OnKeyPress = New_Date
       END CREATE
       CREATE DayHence AS QEDIT
        Text = "Days hence"
        Left = 154
        Top = 30
        Width = 65
        TabOrder = 5
        OnKeyPress = New_Date
       END CREATE
       CREATE DateButt AS QPANEL
        Font = Arial9B
        CAPTION = "New Date"
        Left = 10
        Top = 65
        Width = 210
        Height = 25
       END CREATE
       CREATE DatePanel AS QPANEL
        Left = 10
        Top = 90
        Width = 210
        COLOR = Black
        Font = TimeFont
        CAPTION = "The new date"
       END CREATE
       CREATE WeekdayPanel AS QPANEL
        Left = 10
        Top = 130
        Width = 210
        COLOR = Black
        Font = TimeFont
        CAPTION = "Day of the week"
       END CREATE
      END CREATE
      CREATE DaysDForm AS QPANEL
       COLOR = &HABC111
       CAPTION = "Days Difference"
       Top = 10
       Left = 250
       Width = 237
       Height = 205
       CREATE Month1 AS QEDIT
        Text = LEFT$(DATE$,2)
        Left = 10
        Top = 5
        Width = 65
        TabOrder = 1
        OnKeyPress = DaysDifference
       END CREATE
       CREATE Day1 AS QEDIT
        Text = MID$(DATE$,4,2)
        Left = 82
        Top = 5
        Width = 65
        TabOrder = 2
        OnKeyPress = DaysDifference
       END CREATE
       CREATE Year1 AS QEDIT
        Text = RIGHT$(DATE$,4)
        Left = 154
        Top = 5
        Width = 65
        TabOrder = 3
        OnKeyPress = DaysDifference
       END CREATE
       CREATE Month2 AS QEDIT
        Text = "End month"
        Left = 10
        Top = 30
        Width = 65
        TabOrder = 4
        OnKeyPress = DaysDifference
       END CREATE
       CREATE Day2 AS QEDIT
        Text = "End day"
        Left = 82
        Top = 30
        Width = 65
        TabOrder = 5
        OnKeyPress = DaysDifference
       END CREATE
       CREATE Year2 AS QEDIT
        Text = "End year"
        Left = 154
        Top = 30
        Width = 65
        TabOrder = 6
        OnKeyPress = DaysDifference
       END CREATE
       CREATE DaysButt AS QPANEL
        Font = Arial9B
        CAPTION = "Days Difference"
        Left = 10
        Top = 65
        Width = 210
        Height = 25
       END CREATE
       CREATE DaysPanel AS QPANEL
        Left = 10
        Top = 90
        Width = 210
        COLOR = Black
        Font = TimeFont
        CAPTION = "Difference in days"
       END CREATE
       CREATE WeeksPanel AS QPANEL
        Left = 10
        Top = 130
        Width = 210
        COLOR = Black
        Font = TimeFont
        CAPTION = "Difference in weeks"
       END CREATE
      END CREATE
     END CREATE

     DaysDates.SHOWMODAL

     SUB New_Date(key AS BYTE)
      IF key <> 13 THEN EXIT SUB
      IF soundoff = 0 THEN PLAYWAV  "whoosh.wav",1
      byear = VAL(Year.Text)
      GetMonth(Month.Text)
      bmonth = monthchecked
      bday = VAL(Day.Text)
      dayshence = VAL(DayHence.Text)
      daysthence = VAL(DayThence.Text)
      IF daysthence = 0 THEN
       eday = bday
       eyear = byear
       emonth = bmonth
       SELECT CASE emonth
       CASE 1,3,5,7,8,10,12
        monthdays = 31
       CASE 4,6,9,11
        monthdays = 30
       CASE 2
        IF eyear MOD 4 = 0 THEN
         leapday = 1
         IF eyear MOD 100 = 0 AND eyear MOD 400 <> 0 THEN leapday = 0
        ELSE
         leapday = 0
        END IF
        monthdays = 28 + leapday
       END SELECT
       totdays = eday + dayshence
       IF monthdays >= totdays THEN
        fday = totdays
       ELSE
        neweday = monthdays
        DO
         INC emonth
         IF emonth = 13 THEN
          emonth = 1
          INC eyear
         END IF
         SELECT CASE emonth
         CASE 1,3,5,7,8,10,12
          monthdays = 31
         CASE 4,6,9,11
          monthdays = 30
         CASE 2
          IF eyear MOD 4 = 0 THEN
           leapday = 1
           IF eyear MOD 100 = 0 AND eyear MOD 400 <> 0 THEN leapday = 0
          ELSE
           leapday = 0
          END IF
          monthdays = 28 + leapday
         END SELECT
         neweday = neweday + monthdays
        LOOP UNTIL neweday > totdays
        DEC neweday,monthdays
        fday = totdays - neweday
       END IF
       fmonth = emonth
       fyear = eyear
      ELSE
       pday = bday
       pyear = byear
       pmonth = bmonth
       IF daysthence < pday THEN
        fday = pday - daysthence
       ELSE
        monthdays = 0
        newpday = pday
        DO
         DEC pmonth
         IF pmonth = 0 THEN
          pmonth = 12
          DEC pyear
         END IF
         SELECT CASE pmonth
         CASE 1,3,5,7,8,10,12
          monthdays = 31
         CASE 4,6,9,11
          monthdays = 30
         CASE 2
          IF pyear MOD 4 = 0 THEN
           leapday = 1
           IF pyear MOD 100 = 0 AND pyear MOD 400 <> 0 THEN leapday = 0
          ELSE
           leapday = 0
          END IF
          monthdays = 28 + leapday
         END SELECT
         newpday = newpday + monthdays
        LOOP UNTIL newpday > daysthence
        fday = newpday - daysthence
       END IF
       fmonth = pmonth
       fyear = pyear
      END IF
      SELECT CASE fmonth
      CASE 1
       month$ = "January"
      CASE 2
       month$ = "February"
      CASE 3
       month$ = "March"
      CASE 4
       month$ = "April"
      CASE 5
       month$ = "May"
      CASE 6
       month$ = "June"
      CASE 7
       month$ = "July"
      CASE 8
       month$ = "August"
      CASE 9
       month$ = "September"
      CASE 10
       month$ = "October"
      CASE 11
       month$ = "November"
      CASE 12
       month$ = "December"
      END SELECT
      DatePanel.CAPTION = month$ + " " + STR$(fday) + ", " + STR$(fyear)
      circa = 1
      DaysDifference(key AS BYTE)
     END SUB

     SUB DaysDifference(key AS BYTE)
      IF key <> 13 THEN EXIT SUB
      IF circa = 0 THEN
       IF soundoff = 0 THEN PLAYWAV  "whoosh.wav",1
       GetMonth(Month2.text)
       monthnow = monthchecked
       daynow = VAL(Day2.text)
       yearnow = VAL(Year2.text)
       GetMonth(Month1.text)
       monththen = monthchecked
       daythen = VAL(Day1.text)
       yearthen = VAL(Year1.text)
      ELSEIF circa = 1 THEN
       monthnow = fmonth
       yearnow = fyear
       daynow = fday
       monththen = 1
       yearthen = 1900 'this is arbitrary
       daythen = 1
      END IF
      IF yearnow < yearthen THEN
       SWAP(yearnow,yearthen)
       SWAP(monthnow,monththen)
       SWAP(daynow,daythen)
      END IF
      AOyears = yearnow - yearthen
      betyears = AOyears - 1
      betleaps = betyears \ 4
      trialyear = yearthen + 1
      stepyear = 1
      DO
       IF trialyear MOD 100 = 0 THEN
        IF trialyear MOD 400 <> 0 THEN DEC betleaps
        stepyear = 100
       END IF
       INC trialyear,stepyear
      LOOP UNTIL trialyear >= yearnow
      IF AOyears = 0 THEN
       IF monthnow = monththen THEN
        diffdays = daynow - daythen
       ELSE
        IF yearthen MOD 4 = 0 THEN
         leapthen = 1
         IF yearthen MOD 100 = 0 AND yearthen MOD 400 <> 0 THEN leapthen = 0
        ELSE
         leapthen = 0
        END IF
        IF yearnow MOD 4 = 0 THEN
         leapnow = 1
         IF yearnow MOD 100 = 0 AND yearnow MOD 400 <> 0 THEN leapnow = 0
        ELSE
         leapnow = 0
        END IF
        SELECT CASE monththen
        CASE 1
         Adays = daythen
        CASE 2
         Adays = 31 + daythen
        CASE 3
         Adays = 59 + daythen + leapthen
        CASE 4
         Adays = 90 + daythen + leapthen
        CASE 5
         Adays = 120 + daythen + leapthen
        CASE 6
         Adays = 151 + daythen + leapthen
        CASE 7
         Adays = 181 + daythen + leapthen
        CASE 8
         Adays = 212 + daythen + leapthen
        CASE 9
         Adays = 243 + daythen + leapthen
        CASE 10
         Adays = 273 + daythen + leapthen
        CASE 11
         Adays = 304 + daythen + leapthen
        CASE 12
         Adays = 334 + daythen + leapthen
        END SELECT
        diffdays = GetOdays - Adays
       END IF
      ELSEIF AOyears = 1 THEN
       diffdays = GetAOdays
      ELSE
       diffdays = (betyears*365) + GetAOdays + betleaps
      END IF
      IF circa = 1 THEN
       circa = 0
       IF fday = 0 OR fmonth = 0 OR fyear = 0 THEN
        todate = 8
       ELSE
        todate = diffdays MOD 7
       END IF
       IF fyear < VAL(RIGHT$(DATE$,4)) THEN
        past = 1
       ELSEIF fyear = VAL(RIGHT$(DATE$,4)) THEN
        IF fmonth < VAL(LEFT$(DATE$,2)) THEN
         past = 1
        ELSEIF fmonth = VAL(LEFT$(DATE$,2)) THEN
         IF fday < VAL(MID$(DATE$,4,2)) THEN past = 1
        END IF
       END IF
       SELECT CASE todate
       CASE 0
        IF daysthence = 0 AND past = 0 THEN
         weekday$ = "It's a Monday!"
        ELSEIF daysthence <> 0 OR past = 1 THEN
         past = 0
         weekday$ = "It was a Monday!"
        END IF
       CASE 1
        IF daysthence = 0 AND past = 0 THEN
         weekday$ = "It's a Tuesday!"
        ELSEIF daysthence <> 0 OR past = 1 THEN
         past = 0
         weekday$ = "It was a Tuesday!"
        END IF
       CASE 2
        IF daysthence = 0 AND past = 0 THEN
         weekday$ = "It's a Wednesday!"
        ELSEIF daysthence <> 0 OR past = 1 THEN
         past = 0
         weekday$ = "It was a Wednesday!"
        END IF
       CASE 3
        IF daysthence = 0 AND past = 0 THEN
         weekday$ = "It's a Thursday!"
        ELSEIF daysthence <> 0 OR past = 1 THEN
         past = 0
         weekday$ = "It was a Thursday!"
        END IF
       CASE 4
        IF daysthence = 0 AND past = 0 THEN
         weekday$ = "It's a Friday!"
        ELSEIF daysthence <> 0 OR past = 1 THEN
         past = 0
         weekday$ = "It was a Friday!"
        END IF
       CASE 5
        IF daysthence = 0 AND past = 0 THEN
         weekday$ = "It's a Saturday!"
        ELSEIF daysthence <> 0 OR past = 1 THEN
         past = 0
         weekday$ = "It was a Saturday!"
        END IF
       CASE 6
        IF daysthence = 0 AND past = 0 THEN
         weekday$ = "It's a Sunday!"
        ELSEIF daysthence <> 0 OR past = 1 THEN
         past = 0
         weekday$ = "It was a Sunday!"
        END IF
       CASE ELSE
        weekday$ = "Error. Check date entry."
       END SELECT
       WeekDayPanel.CAPTION = weekday$
      ELSE
       IF ABS(diffdays) = 1 THEN
        days$ = " day"
       ELSE
        days$ = " days"
       END IF
       DaysPanel.CAPTION = FORMAT$("%.0n",diffdays) + days$
       diffdays = ABS(diffdays)
       remaindays = diffdays MOD 7
       IF remaindays = 1 THEN
        remaindays$ = " " + STR$(remaindays) + " day)"
       ELSEIF remaindays > 1 THEN
        remaindays$ = " " + STR$(remaindays) + " days)"
       ELSEIF remaindays = 0 THEN
        remaindays$ = ")"
       ELSE
        diffdays = 0
        remaindays$ = ")"
       END IF
       IF ABS(diffdays\7) = 1 THEN
        weeks$ = " week"
       ELSE
        weeks$ = " weeks"
       END IF
       WeeksPanel.CAPTION = "(" + STR$(diffdays\7) + weeks$ + remaindays$
      END IF
     END SUB

     FUNCTION GetAOdays
      IF yearthen MOD 4 = 0 THEN
       leapthen = 1
       IF yearthen MOD 100 = 0 AND yearthen MOD 400 <> 0 THEN leapthen = 0
      ELSE
       leapthen = 0
      END IF
      SELECT CASE monththen
      CASE 1
       Adays = 365 - daythen + leapthen
      CASE 2
       Adays = 334 - daythen + leapthen
      CASE 3
       Adays = 306 - daythen
      CASE 4
       Adays = 275 - daythen
      CASE 5
       Adays = 245 - daythen
      CASE 6
       Adays = 214 - daythen
      CASE 7
       Adays = 184 - daythen
      CASE 8
       Adays = 153 - daythen
      CASE 9
       Adays = 122 - daythen
      CASE 10
       Adays = 92 - daythen
      CASE 11
       Adays = 61 - daythen
      CASE 12
       Adays = 31 - daythen
      END SELECT
      GetAOdays = Adays + GetOdays
     END FUNCTION

     FUNCTION GetOdays
      IF yearnow MOD 4 = 0 THEN
       leapnow = 1
       IF yearnow MOD 100 = 0 AND yearnow MOD 400 <> 0 THEN leapnow = 0
      ELSE
       leapnow = 0
      END IF
      SELECT CASE monthnow
      CASE 1
       Odays = daynow
      CASE 2
       Odays = 31 + daynow
      CASE 3
       Odays = 59 + daynow + leapnow
      CASE 4
       Odays = 90 + daynow + leapnow
      CASE 5
       Odays = 120 + daynow + leapnow
      CASE 6
       Odays = 151 + daynow + leapnow
      CASE 7
       Odays = 181 + daynow + leapnow
      CASE 8
       Odays = 212 + daynow + leapnow
      CASE 9
       Odays = 243 + daynow + leapnow
      CASE 10
       Odays = 273 + daynow + leapnow
      CASE 11
       Odays = 304 + daynow + leapnow
      CASE 12
       Odays = 334 + daynow + leapnow
      END SELECT
      RESULT = Odays
     END FUNCTION


     SUB GetMonth
      validmonth = VAL(monthtocheck)
      IF validmonth > 12 THEN monthtocheck = STR$(validmonth MOD 12)
      SELECT CASE LCASE$(monthtocheck)
      CASE "1","01","jan","jan.","january"
       monthchecked = 1
      CASE "2","02","feb","feb.","february"
       monthchecked = 2
      CASE "3","03","mar","mar.","march"
       monthchecked = 3
      CASE "4","04","apr","apr.","april"
       monthchecked = 4
      CASE "5","05","may.","may"
       monthchecked = 5
      CASE "6","06","jun","jun.","june"
       monthchecked = 6
      CASE "7","07","jul","jul.","july"
       monthchecked = 7
      CASE "8","08","aug","aug.","august"
       monthchecked = 8
      CASE "9","09","sep","sep.","sept","sept.","september"
       monthchecked = 9
      CASE "10","oct","oct.","october"
       monthchecked = 10
      CASE "11","nov","nov.","november"
       monthchecked = 11
      CASE "12","dec","dec.","december"
       monthchecked = 12
      END SELECT
     END SUB

2000-12-29 19:37