Date Manipulation - Julian dates

[Mike Doty]

comments for: http://www.powerbasic.com/support/pb...ad.php?t=24500

------------------

[Egbert Zijlema]

Also see: http://zijlema.basicguru.com/gregorian.html

------------------
Egbert Zijlema, journalist and programmer (egbert at egbertzijlema dot nl)
http://zijlema.basicguru.com/
*** Opinions expressed here are not necessarily true ***

[Larry Cooke]

Mike, after reading the link Egbert provided, I concluded that His suggestion is the defacto method to use for a Gregorian date.

One thing I could suggest in your code (if you're looking for critique) is to change your Num2Date to the following:

FUNCTION Num2Date(JulianDate AS LONG) AS STRING  ' 01-01-1980 = Day 1
  DIM JD&,M&,D&,Y&,Q&,R&,S&,T&,U&,V&             ' Declare our local variables.
  JD = JulianDate + 2444239                      ' Add all days before (01-01-1980 =2444240) for QuickPak
  Q = INT((Jd / 36524.25) - 51.12264)
  R = JD + Q - INT(Q / 4) + 1
  S = R + 1524
  T = INT((S / 365.25) - 0.3343)
  U = INT(T * 365.25)
  V = INT((S - U) / 30.61)
  D = S - U - INT(V * 30.61)
  M = (V - 1) + 12 * (V > 13.5)
  Y = T - (M < 2.5) - 4716
  FUNCTION = FORMAT$(M,"00") + "-" + _           ' Return the date string
             FORMAT$(D,"00") + "-" + _           ' using the new values...
             FORMAT$(Y,"0000")                   '   "    "   "     "
END FUNCTION

Note that the above eliminates any String variables, yet it returns the date formatted as before.

Thanks Mike and Egbert! Both of you have helped me find a date routine that actually works. Great job Egbert!

Larry

------------------
You must learn from the mistakes of others. You can't possibly live
long enough to make them all yourself. - Sam Levenson

[Mike Doty]

Egbert Zijlema's link is now broken. Anyone have it?


------------------

[Egbert Zijlema]

Yes, me of course.
The BasicGuru website is definitely down, due to hurricane Charley last year.
I'm busy to rebuild my programming site at www.egbertzijlema.nl (see my sig. below)

------------------
Egbert Zijlema, journalist and programmer (egbert at egbertzijlema dot nl)
http://www.egbertzijlema.nl/programming.html
*** Opinions expressed here are not necessarily untrue ***

[Roy Bauer]

Looking for a function that works like this: Pass a Date as xx.xx.xxxx, and pass a number of days as xxx, and the function will calculate that date in the future. Example: 03/22/2016, 45 days . Returned 05/06/2016

[Steve R Geisler]

Roy,

http://forum.powerbasic.com/forum/us...n-date?t=24500 #2

You could maybe use this to help?

Steve

[Michael Mattias]

This is close... it skips Sat and Sun to calculate WORK days but that's pretty easy to code out of here..


This is close... you'll have to edit out the exclusion of Saturdays and Sundays but that's pretty easy. (This was created to only add WORK DAYS = M-F) because I was calculating inventory availability dates based on "production days."

Oh, and this uses "CCYYMMDD" so you'll have to tinker with the formatting but that's pretty easy, too.

And it's a lot easier if you can count all days. ... you just add (%ONE_FT_DAY * NumDays) to the FILETIME and reformat.. you don't have to go thru that day-of-week loop.

But maybe someone was looking for the "work days" thing anyway.

FWIW, vintage= 2004. A good year, as I recall.

'=== EQUATES AND SUPPORT FOR ADDWORKDAYS AND WORKDAYSDIFFERENCE FUNCTIONS

%ONE_FT_DAY          =   864000000000&&   ' 864,000,000,000

UNION ftUnion
    q  AS QUAD
    ft AS FILETIME
END UNION

' --------------------------------------------------------------------
' INTERNAL FUNCTION TO COMPUTE NEW DATE FROM INPUT DATE and NUMBER OF DAYS
' --------------------------------------------------------------------
' return input date + nDays (which may be signed) as a CCYYMMDD string
' Working OK 4-24-04. always returns a day mon-fri
FUNCTION f_AddWorkDays (CCYYMMDD AS STRING, nDays AS LONG) AS STRING

    LOCAL st AS SYSTEMTIME
    LOCAL ft AS ftunion
    LOCAL nDaysDone AS LONG, E AS LONG

    IF LEN(CCYYMMDD) <> 8 OR ISTRUE(VERIFY(CCYYMMDD,"0123456789")) THEN
        FUNCTION = ""
        EXIT FUNCTION
    END IF

    RESET           st
    st.wyear     =  VAL(MID$(CCYYMMDD, 1,4))
    st.wmonth    =  VAL(MID$(CCYYMMDD, 5,2))
    st.wDay      =  VAL(MID$(CCYYMMDD, 7,2))

    ' convert starting date to filetime and validate date
    E       = SystemTimeToFileTime (st, ft.ft)
    IF ISFALSE E THEN
    '    E = GetLastError
      '  MSGBOX "ST2FT Failed on Error " & STR$(E)
        ' fails on error zero if invalid date
        FUNCTION = ""  ' could be "INVALID" or "BADDATE" or something just as easily
        EXIT FUNCTION
    END IF


    nDaysDone =  0&

    DO UNTIL nDaysDone = nDays
        ' add or subtract a day depending on direction
        IF nDays < 0 THEN
            ft.q  = ft.q - %ONE_FT_DAY
        ELSE
            ft.q  = ft.Q + %ONE_FT_DAY
        END IF
        ' check DOW. If not sat or sun, incr or decr daysdone
         FileTimeToSystemTime  ft.ft, st
         SELECT CASE st.wDayofWeek
            CASE 0??,  6??    ' Sun or Sat
                ' do nothing
            CASE ELSE
                IF nDays > 0 THEN
                   INCR nDaysDone
                ELSE
                   DECR nDaysDone
                END IF
        END SELECT
    LOOP

    ' when we get here, SystemTime contains the ending date, so convert to CCYYMMDD

    FUNCTION = FORMAT$(st.wYear, "0000") & FORMAT$(st.wMonth, "00") & FORMAT$(st.wDay, "00")


END FUNCTION

[Dale Yarker]

My preference would be to use SYSTEMTIME and FILETIME UDTs similar to how Michael showed.

If you have PBWin 10 or PBCC 6, then PowerTime object and methods are another option.

[Pierre Bellisle]

One easy way...

Pierre

#COMPILE EXE '#Win 8.04#
#DIM ALL
#INCLUDE "Win32Api.inc"
 
%NanoSecInDay  = 24 * 60 * 60 * 10000000 '24 hours in portions of 100 nanoseconds
'______________________________________________________________________________
 
FUNCTION PBMAIN() AS LONG
 LOCAL YearMonthDay AS SYSTEMTIME
 LOCAL QuadTime     AS QUAD
 LOCAL DayToAdd     AS DWORD
 
 YearMonthDay.wYear  = 2016 'Year
 YearMonthDay.wMonth = 03   'Month
 YearMonthDay.wDay   = 22   'Day
 
 DayToAdd            = 12   'Day to add
 
 SystemTimeToFileTime(YearMonthDay, BYVAL VARPTR(QuadTime)) 'Convert to a quad
 QuadTime = QuadTime + DayToAdd * %NanoSecInDay             'Add days * NanoSecInDay
 FileTimeToSystemTime(BYVAL VARPTR(QuadTime), YearMonthDay) 'Get result in human readable form
 
 MessageBox(%HWND_DESKTOP, _                                'Show result...
 FORMAT$(YearMonthDay.wYear, "0000") & "-" & _
 FORMAT$(YearMonthDay.wMonth, "00")  & "-" & _
 FORMAT$(YearMonthDay.wDay, "00"), "Day add", %MB_OK)
 
END FUNCTION
'______________________________________________________________________________
'

[Pierre Bellisle]

Here is a little variant to please my friend Gary who love pointers. ;-D
The structure used in api call are the formal SYSTEMTIME and FILETIME,
but the addition or substraction is made via a pointer to a QUAD,
the QUAD pointer beeing in reality a pointer to a FILETIME variable in this particular case.
This is of course easier than to deal with the FILETIME.dwLowDateTime and FILETIME.dwHighDateTime.

#COMPILE EXE '#Win 8.04#
#DIM ALL
#INCLUDE "Win32Api.inc"
 
%NanoSecInDay  = 24 * 60 * 60 * 10000000 '24 hours in portions of 100 nanoseconds
'______________________________________________________________________________
 
FUNCTION PBMAIN() AS LONG
 LOCAL sDateResult  AS STRING
 LOCAL YearMonthDay AS SYSTEMTIME
 LOCAL QuadTime     AS FILETIME
 LOCAL pQuadTime    AS QUAD POINTER
 LOCAL DayToAdd     AS LONG
 
 YearMonthDay.wYear  = 2016 'Year
 YearMonthDay.wMonth = 03   'Month
 YearMonthDay.wDay   = 22   'Day
 
 DayToAdd            = -29  'Day to add
 
 sDateResult = FORMAT$(YearMonthDay.wYear, "0000") & "-" & _  'Record initial values and day to add request
               FORMAT$(YearMonthDay.wMonth, "00") & "-" & _   '-to show it in the message box.
               FORMAT$(YearMonthDay.wDay, "00") & $CRLF  & _
               IIF$(DayToAdd > 0, "adding", "substracting") & STR$(ABS(DayToAdd)) & _ 'Could go in the future or in the past
               IIF$(ABS(DayToAdd) > 1, " days", " day") & $CRLF 'To put a "s" or not?
 
 SystemTimeToFileTime(YearMonthDay, QuadTime)       'Convert to a quad
 pQuadTime = VARPTR(QuadTime)                       'Set the pQuadTime to point to QuadTime
 @pQuadTime = @pQuadTime + DayToAdd * %NanoSecInDay 'Add days * NanoSecInDay using pointers
 FileTimeToSystemTime(QuadTime, YearMonthDay)       'Get result in human readable form yyy-mm-dd
 
 MessageBox(%HWND_DESKTOP, _                        'Show result...
 sDateResult & _
 FORMAT$(YearMonthDay.wYear, "0000") & "-" & _
 FORMAT$(YearMonthDay.wMonth, "00")  & "-" & _
 FORMAT$(YearMonthDay.wDay, "00"), "Back to the future", %MB_OK)
 
END FUNCTION
'______________________________________________________________________________
'