Some Date Functions

[gbos]

Regards

Code:

'' Functions List
'' -----------------

'' Function DaysValue(TheDate as string) as Long
'' Returns the nuber of days from 12-31-1900 (Date Format m-d-yyyy)

'' Function DayOfWeek(TheDate as string) as integer
'' Returns Day of Week, 1 Monday, 2 Tue. etc.

'' Function DaysBetween(FutDate as string, PrevDate as string) as Long
'' Returns the number of Days from a starting date - to an ending date
'' without counting the initial starting Date (Date Format m-d-yyyy)

'' Function WorkDaysBetween(FutDate as string, PrevDate as string) as Long
'' Returns the number of Working Days from a starting date - to an ending date
'' without counting the initial starting Date (Date Format m-d-yyyy)

'' Function DaysOfMonth(TheMonth as Integer,TheYear as Integer) as Integer
'' The Number of days of a month  


Function DaysValue(TheDate as string) as Long
   '' TheDate format m-d-yyyy
   Dim year as integer
   Dim month as integer
   Dim day as integer
   year=val(RIGHT$(TheDate,4))
   IF MID$(TheDate,2,1)="-" THEN
      month=val(LEFT$(TheDate,1))
      IF MID$(TheDate,4,1)="-" THEN day=val(MID$(TheDate,3,1)) ELSE day=val(MID$(TheDate,3,2))
   ELSE
      month=val(LEFT$(TheDate,2))
      IF MID$(TheDate,5,1)="-" THEN day=val(MID$(TheDate,4,1)) ELSE day=val(MID$(TheDate,4,2))
   END IF
   if year<1901 then goto erlabel:
   if month>12 then goto erlabel:
   if (month=1 or month=3 or month=5 or month=7 or month=8 or month=10 or month=12) and day>31 then goto erlabel:
   if (month=4 or month=6 or month=9 or month=11) and day>30 then goto erlabel:
   if (month=2 and (year-1901) mod 4=3) and day>29 then goto erlabel:
   if (month=2 and (year-1901) mod 4<>3) and day>28 then goto erlabel:
   Dim c as Long
   c=0
   dim mc(11) as integer
   c=c+(year-1901)*365
   c=c+int((year-1901)/4)
   mc(0)=0
   mc(1)=31
   if (year-1901) mod 4=3 then mc(2)=29 else mc(2)=28
   mc(3)=31
   mc(4)=30
   mc(5)=31
   mc(6)=30
   mc(7)=31
   mc(8)=31
   mc(9)=30
   mc(10)=31
   mc(11)=30
   Dim i as integer
   for i=0 to (month-1)
      c=c+mc(i)
   next i
   c=c+day
   DaysValue=c
   goto endlabel:  
   erlabel:
   DaysValue=0
   endlabel:
End Function

Function DayOfWeek(TheDate as string) as integer
   Dim c as integer
   c= DaysValue(TheDate) mod 7
   DayOfWeek = c+1
   '' 1 is Monday
End Function

Function DaysBetween(FutDate as string, PrevDate as string) as Long
   '' not including prevdate
   Dim c as Long
   c=DaysValue(FutDate)-DaysValue(PrevDate)
   if c>0 then DaysBetween=c else DaysBetween=0
End Function

Function WorkDaysBetween(FutDate as string, PrevDate as string) as Long
   Dim c as Long
   Dim i as Long
   Dim j as Long
   Dim w as integer  
   Dim s as Long
   Dim k as Long
   c=DaysValue(FutDate)-DaysValue(PrevDate)
   i=int(c/7)
   j=c mod 7
   w=1+DayOfWeek(PrevDate)
   if w=8 then w=1
   s=0
   for k=1 to j
      if w=1 or w=2 or w=3 or w=4 or w=5 then s=s+1
      w=w+1
      if w=8 then w=1
   next k
   if c>0 then WorkDaysBetween=i*5+s else WorkDaysBetween=0
End Function

Function DaysOfMonth(TheMonth as Integer,TheYear as Integer) as Integer
   dim mc(12) as integer
   mc(0)=0
   mc(1)=31
   if (TheYear-1901) mod 4=3 then mc(2)=29 else mc(2)=28
   mc(3)=31
   mc(4)=30
   mc(5)=31
   mc(6)=30
   mc(7)=31
   mc(8)=31
   mc(9)=30
   mc(10)=31
   mc(11)=30
   mc(12)=31
   DaysOfMonth=mc(TheMonth)
End Function

'' tests

Print "DaysValue(2-25-2005) = ";DaysValue("2-25-2005")
Print "DaysValue(1-1-1901) = ";DaysValue("1-1-1901")
Print "DayOfWeek(2-25-2005) = ";DayOfWeek("2-25-2005")
Print "DaysBetween(3-1-2005,2-25-2005) = ";DaysBetween("3-1-2005","2-25-2005")
Print "WorkDaysBetween(3-1-2005,2-25-2005) = ";WorkDaysBetween("3-1-2005","2-25-2005")
Print "DaysOfMonth(2,2005) = ";DaysOfMonth(2,2005)

sleep

[keeling]

This is too funny. I was looking at doing some of this stuff last night. I was going to do it with Julian dates though.


Cool

[TheBigBasicQ]

nice work dude. I'll test it out and let you know if I find any bugs :lol: