[AccessD] Countdown

Gustav Brock Gustav at cactus.dk
Sun May 11 01:43:58 CDT 2008


Hi Max

Unless just for a "fun" web site countdown function, this is slightly more complicated than so.

You should be able to modify the function FormatYearDayHourMinuteSecondDiff below to return the values ByRef.
And it won't cost you a dollar ...

/gustav

Public Function FormatYearDayHourMinuteSecondDiff( _
  ByVal datTimeStart As Date, _
  ByVal datTimeEnd As Date, _
  Optional ByVal strSeparatorDate As String = " ", _
  Optional ByVal strSeparatorTime As String = ":") _
  As String
  
' Returns count of years, days, hours, minutes and seconds of difference
' between datTimeStart and datTimeEnd converted to
' years, days, hours and minutes and seconds as a formatted string
' with an optional choice of date and/or time separator.
'
' Should return correct output for a negative time span but
' this is not fully tested.
'
' Example:
'   datTimeStart: #2006-05-24 10:03:02#
'   datTimeEnd  : #2009-04-17 20:01:18#
'   returns     : 2 328 09:58:16
'
' 2007-11-06. Cactus Data ApS, CPH.
  
  Const cintSecondsHour As Integer = 60& * 60&
  
  Dim intYears      As Integer
  Dim intDays       As Integer
  Dim intSeconds    As Integer
  Dim intHours      As Integer
  Dim datTime       As Date
  Dim strDatePart   As String
  Dim strTimePart   As String
  Dim strYDHMS      As String
  
  intYears = Years(datTimeStart, datTimeEnd)
  datTimeStart = DateAdd("yyyy", intYears, datTimeStart)
  intDays = Days(datTimeStart, datTimeEnd)
  datTimeStart = DateAdd("d", intDays, datTimeStart)
  intHours = DateDiff("h", datTimeStart, datTimeEnd)
  datTimeStart = DateAdd("h", intHours, datTimeStart)
  intSeconds = DateDiff("s", datTimeStart, datTimeEnd)
  
  ' Format year and day part.
  strDatePart = CStr(intYears) & strSeparatorDate & CStr(intDays)
  datTime = TimeSerial(intHours, 0, intSeconds Mod cintSecondsHour)
  ' Format hour, minute and second part.
  strTimePart = Format(datTime, "hh\" & strSeparatorTime & "nn\" & strSeparatorTime & "ss")
  strYDHMS = strDatePart & " " & IIf(datTime < 0, "-", "") & strTimePart
  
  FormatYearDayHourMinuteSecondDiff = strYDHMS
  
End Function

Public Function Years( _
  ByVal datDOB As Date, _
  ByVal datNow As Date, _
  Optional ByVal booLinear As Boolean) _
  As Integer

' Returns the difference in full years between datDOB and datNow.
'
' Calculates correctly for:
'   negative differences
'   leap years
'   dates of 29. February
'   date/time values with embedded time values
'   negative date/time values (prior to 1899-12-29)
'
' Optionally returns negative counts rounded down to provide a
' linear sequence of year counts.
' For a given datDOB, if datNow is decreased step wise one year from
' returning a positive count to returning a negative count, one or two
' occurrences of count zero will be returned.
' If booLinear is False, the sequence will be:
'   3, 2, 1, 0,  0, -1, -2
' If booLinear is True, the sequence will be:
'   3, 2, 1, 0, -1, -2, -3
'
' If booLinear is False, reversing datDOB and datNow will return
' results of same absolute value, only the sign will change.
' This behaviour mimics that of Fix().
' If booLinear is True, reversing datDOB and datNow will return
' results where the negative count is offset by -1.
' This behaviour mimics that of Int().

' DateAdd() is used for check for month end of February as it correctly
' returns Feb. 28. when adding a count of years to dates of Feb. 29.
' when the resulting year is a common year.
'
' 2000-11-03. Cactus Data ApS, CPH.
' 2000-12-16. Leap year correction modified to be symmetrical.
'             Calculation of intDaysDiff simplified.
'             Renamed from YearsDiff() to Years().
' 2000-12-18. Introduced cbytMonthDaysMax.
' 2007-06-22. Version 2. Complete rewrite.
'             Check for month end of February performed with DateAdd()
'             after idea of Markus G. Fischer.
' 2008-04-27. Version 2.1.
'             Correction for calculation of linear age from Feb. 29th.
'             to Feb. 28th of a previous non-leap year as documented
'             by Lester Hui.
'
'             Example:
'               DOB: 2000-02-29, Today: 1999-02-28, Age linear: -1.
'
'             Parameters renamed to stress that for age calculations
'             first parameter must be Date of Birth as documented
'             by Markus G. Fischer.
' 2008-04-27. Version 2.2
'             Rewrite to correct negative years count bug.

  Dim intSign   As Integer
  Dim intYears  As Integer
  
  ' Find difference in calendar years.
  intYears = DateDiff("yyyy", datDOB, datNow)
  ' For positive resp. negative intervals, check if the second date
  ' falls before, on, or after the crossing date for a full 12 months period
  ' while at the same time correcting for February 29. of leap years.
  
  If DateDiff("d", datDOB, datNow) > 0 Then
    If DateDiff("d", DateAdd("yyyy", intYears, datDOB), datNow) < 0 Then
      ' The last year is not a full year.
      ' Reduce year count by one.
      intYears = intYears - 1
    End If
  Else
    intSign = Sgn(DateDiff("d", DateAdd("yyyy", -intYears, datNow), datDOB))
    If intSign <> 0 Then
      If intSign < 0 Then
        ' The last year is not a full year.
        ' Reduce negative year count by one.
        intYears = intYears + 1
      End If
      If booLinear Then
        ' Offset negative count of years to continuous sequence if requested.
        If DateDiff("d", DateAdd("yyyy", intYears, datDOB), datNow) < 0 Then
          ' Time interval includes a partial year.
          ' Increase negative year count by one.
          intYears = intYears - 1
        End If
      End If
    End If
    
  End If
  
  ' Return count of years as count of full 12 months periods.
  Years = intYears
  
End Function

Public Function Days( _
  ByVal datDateFirst As Date, _
  ByVal datDateLast As Date) _
  As Long

' Returns the difference in full days from datDateFirst to datDateLast.
' 2007-06-27. Cactus Data ApS, CPH.

  Dim lngDays As Long
    
  lngDays = DateDiff("d", datDateFirst, datDateLast)
  If lngDays > 0 Then
    ' Decrease by 1 if time of first date is later than time of last date.
    If DateDiff("s", datDateLast, DateAdd("d", lngDays, datDateFirst)) > 0 Then
      lngDays = lngDays - 1
    End If
  End If
  
  Days = lngDays
  
End Function

/gustav

>>> max.wanadoo at gmail.com 10-05-2008 16:43 >>>
Hi,
Has anybody any code that would do a count down in years,days,hrs,mins,sec
from a given date to now()
Ie, pass the function the future (or past) date and it updates given values
which are passed by Ref.

Thanks
Max




More information about the AccessD mailing list