• Print

Author Topic: Date and Time Functions  (Read 235 times)

Code Hunter

  • Newbie
  • *
  • Posts: 18
Date and Time Functions
« on: April 05, 2018, 11:45:13 am »
Here are some Date and Time Functions including:

Date to Epoch and Epoch to Date
Extended Timer (I believe that function is by Bill or Steve)
Full/Partial Date (WeekDay Month, Day Year)
WeekDay and Month Names
Date of Easter
Julian Day

and more....

Code: [Select]
' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' -=- Date & Time Functions -=-
' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-

FUNCTION CurDate$ (Flag AS INTEGER)
DIM TempMonth AS INTEGER

Month = VAL(LEFT$(DATE$, 2))
Day = VAL(MID$(DATE$, 4, 2))
Year = VAL(RIGHT$(DATE$, 4))

SELECT CASE Flag
  ' MM-DD-YYYY
  CASE 0: CurDate = DATE$

    ' MM-DD-YY
  CASE 1: CurDate = LEFT$(DATE$, 6) + RIGHT$(DATE$, 2)

    ' Month Day, YYYY
  CASE 2: CurDate = NameMonth(Month - 1, 0) + STR$(Day) + "," + STR$(Year)

    ' Month Day+Suffix, YYYY
  CASE 3: CurDate = NameMonth(Month - 1, 0) + STR$(Day) + DaySuffix(Day) + ", " + STR$(Year)
END SELECT
END FUNCTION

FUNCTION CurTime$ (Flag AS INTEGER)
DIM Post AS STRING

' Get the Time (This is 24 Hour format)
Hour24 = VAL(LEFT$(TIME$, 2))
Minute = VAL(MID$(TIME$, 4, 2))
Second = VAL(RIGHT$(TIME$, 2))

' Convert the 24 Hour Format to 12 Hour Format
IF Hour24 < 12 THEN
  Post = " AM": Hour12 = Hour24
ELSE
  Post = " PM": Hour12 = Hour24 - 12
END IF

IF Hour12 = 0 THEN Hour12 = 12

IF Flag THEN
  CurTime = LEFT$(TIME$, 2) + MID$(TIME$, 4, 2) + CHR$(32) + "Hours"
ELSE
  CurTime = RIGHT$("0" + STR$(Hour12), 2) + ":" + MID$(TIME$, 4, 2) + Post
END IF
END FUNCTION

FUNCTION NewTimer&& (TimeStr AS STRING)
Hour = VAL(LEFT$(TimeStr, 2))
Minute = VAL(MID$(TimeStr, 4, 2))
Second = VAL(RIGHT$(TimeStr, 2))

NewTimer = 3600 * Hour + 60 * Minute + Second
END FUNCTION

FUNCTION Epoch&& (DateStr AS STRING, TimeStr AS STRING, TimeZone AS INTEGER)
DIM GMT AS _INTEGER64

IF DateStr = "" OR TimeStr = "" THEN
  DateStr = DATE$

  Hour = VAL(LEFT$(TIME$, 2))
  Minute = VAL(MID$(TIME$, 4, 2))
  Second = VAL(RIGHT$(TIME$, 2))
ELSE
  Hour = VAL(LEFT$(TimeStr, 2))
  Minute = VAL(MID$(TimeStr, 4, 2))
  Second = VAL(RIGHT$(TimeStr, 2))
END IF

GMT = 86400 * (DayNumber(DateStr) - DayNumber("01-01-1970")) + 3600 * Hour + 60 * Minute + Second

IF TimeZone < 0 THEN
  Epoch = GMT + ABS(3600 * TimeZone)
ELSE
  Epoch = GMT + 3600 * TimeZone
END IF
END FUNCTION

FUNCTION EpochDate$ (Value AS _INTEGER64, TimeZone AS INTEGER, Flag AS INTEGER)
DIM TestEpoch AS _INTEGER64
DIM TempValue AS _INTEGER64
TempValue = Value

DIM DateStr AS STRING
DIM TimeStr AS STRING

Seconds = TempValue MOD 60: TempValue = TempValue / 60
Minutes = TempValue MOD 60: TempValue = TempValue / 60
Hours = TempValue MOD 24 + TimeZone: TempValue = TempValue / 24

TimeStr = RIGHT$("0" + LTRIM$(STR$(Hours)), 2) + ":"
TimeStr = TimeStr + RIGHT$("0" + LTRIM$(STR$(Minutes)), 2) + ":"
TimeStr = TimeStr + RIGHT$("0" + LTRIM$(STR$(Seconds)), 2)

Month = 1: Day = 1: Year = 1970 + Value \ 365

WHILE TestEpoch <> Value
  DateStr = RIGHT$("0" + LTRIM$(STR$(Month)), 2) + "-"
  DateStr = DateStr + RIGHT$("0" + LTRIM$(STR$(Day)), 2) + "-"
  DateStr = DateStr + LTRIM$(STR$(Year))

  TestEpoch = Epoch(DateStr, TimeStr, 0)

  IF TestEpoch <> Value THEN
    Day = Day + 1: IF Day > DaysInMonth(Month) THEN Day = 1: Month = Month + 1
  END IF
WEND

SELECT CASE Flag
  ' Date and Time
  CASE 0: EpochDate = DateStr + " " + TimeStr

    ' Day of the Week
  CASE 1: EpochDate = NameWeek(Weekday(DateStr), 0)

    ' Month, Day, Year
  CASE 2: EpochDate = LEFT$(DateStr, 2)
  CASE 3: EpochDate = MID$(DateStr, 4, 2)
  CASE 4: EpochDate = RIGHT$(DateStr, 4)

    ' Hour, Minute, Second
  CASE 5: EpochDate = LEFT$(TimeStr, 2)
  CASE 6: EpochDate = MID$(TimeStr, 4, 2)
  CASE 7: EpochDate = RIGHT$(TimeStr, 2)
END SELECT
END FUNCTION

FUNCTION FullDate$
DIM TempStr AS STRING

Month = VAL(LEFT$(DATE$, 2))
Day = VAL(MID$(DATE$, 4, 2))
Year = VAL(RIGHT$(DATE$, 4))

TempStr = NameWeek(Weekday(DATE$), 0) + CHR$(32) + NameMonth(Month - 1, 0)

FullDate = TempStr + STR$(Day) + DaySuffix(Day) + "," + STR$(Year)
END FUNCTION

FUNCTION ExtendedTimer&&
DIM ExtM AS DOUBLE, ExtD AS DOUBLE, ExtY AS DOUBLE
DIM LoopI AS DOUBLE, TempVal AS DOUBLE
DIM TempDate AS STRING

TempDate = DATE$
ExtM = VAL(LEFT$(TempDate, 2))
ExtD = VAL(MID$(TempDate, 4, 2))
ExtY = VAL(RIGHT$(TempDate, 2))

FOR LoopI = 1 TO ExtM
  SELECT CASE LoopI
    CASE 1: ExtD = ExtD
    CASE 2, 4, 6, 8, 9, 11: ExtD = ExtD + 31
    CASE 3: ExtD = ExtD + 28
    CASE 5, 7, 10, 12: ExtD = ExtD + 30
  END SELECT
NEXT

FOR LoopI = 1 TO ExtY: ExtD = ExtD + 365: NEXT

FOR LoopI = 3 TO ExtY STEP 4
  IF ExtM > 2 THEN ExtD = ExtD + 1
NEXT

TempVal = ExtD * 24 * 60 * 60
ExtendedTimer = (TempVal + TIMER) * 100
END FUNCTION

FUNCTION ProgUpTime$
DIM TempTimer&&
DIM UpDay AS STRING, UpHour AS STRING, UpMins AS STRING, UpSecs AS STRING

TempTimer = INT(ExtendedTimer - Startup) \ 100

DayUp = TempTimer \ 86400
TempDay = DayUp * 86400

HourUp = (TempTimer - TempDay) \ 3600
TempHour = HourUp * 3600

MinUp = (TempTimer - TempDay - TempHour) \ 60
SecUp = TempTimer - TempDay - TempHour - MinUp * 60

UpDay = RIGHT$("00" + LTRIM$(STR$(DayUp)), 2)
UpHour = RIGHT$("00" + LTRIM$(STR$(HourUp)), 2)
UpMins = RIGHT$("00" + LTRIM$(STR$(MinUp)), 2)
UpSecs = RIGHT$("00" + LTRIM$(STR$(SecUp)), 2)

ProgUpTime = UpDay + ":" + UpHour + ":" + UpMins + ":" + UpSecs
END FUNCTION

FUNCTION Now$
Now = DATE$ + " " + TIME$
END FUNCTION

FUNCTION LeapYear (Year AS INTEGER)
IF Year MOD 4 = 0 THEN LeapYear = 1
IF Year MOD 100 = 0 THEN LeapYear = 0
IF Year MOD 400 = 0 THEN LeapYear = 1
END FUNCTION

FUNCTION DaysInMonth (Month AS INTEGER)
IF Month = 2 THEN
  DaysInMonth = 28
  IF LeapYear(Year) THEN DaysInMonth = 29
ELSE
  DaysInMonth = 31
  IF INSTR("AprJunSepNov", NameMonth(Month - 1, 1)) THEN DaysInMonth = 30
END IF
END FUNCTION

FUNCTION WeeksInMonth (Month AS INTEGER, Year AS INTEGER)
DIM TempStr AS STRING

TempStr = RIGHT$("0" + LTRIM$(STR$(Month)), 2) + "/01/" + LTRIM$(STR$(Year))
WeeksInMonth = (Weekday(TempStr) + (DaysInMonth(Month) - 1)) \ 7
END FUNCTION

FUNCTION DayNumber&& (DateStr AS STRING)
M = VAL(LEFT$(DateStr, 2))
D = VAL(MID$(DateStr, 4, 2))
Y = VAL(RIGHT$(DateStr, 4))

IF M > 2 THEN M = M + 1 ELSE Y = Y - 1: M = M + 13
DayNumber = Y * 365 + Y \ 4 - Y \ 100 + Y \ 400 + M * 306001 \ 10000 + D
END FUNCTION

FUNCTION DaysInYear
DaysInYear = INT(DayNumber(DATE$)) - INT(DayNumber("01-01-" + STR$(Year))) + 1
END FUNCTION

FUNCTION DaySuffix$ (Day AS INTEGER)
DaySuffix = "th"
IF Day MOD 10 = 1 THEN DaySuffix = "st"
IF Day MOD 10 = 2 THEN DaySuffix = "nd"
IF Day MOD 10 = 3 THEN DaySuffix = "rd"

IF Day > 10 AND Day < 14 THEN DaySuffix = "th"
END FUNCTION

FUNCTION Weekday (DateStr AS STRING)
M = VAL(LEFT$(DateStr, 2))
D = VAL(MID$(DateStr, 4, 2))
Y = VAL(RIGHT$(DateStr, 4))

IF M < 3 THEN M = M + 12: Y = Y - 1
Weekday = ((13 * M + 3) \ 5 + D + Y + Y \ 4 - Y \ 100 + Y \ 400 + 1) MOD 7
END FUNCTION

FUNCTION Easter$ (Year AS INTEGER)
DIM C AS INTEGER, D AS INTEGER, G AS INTEGER
DIM I AS INTEGER, K AS INTEGER, M AS INTEGER

C = Year \ 100
G = Year MOD 19
K = (C - 17) \ 25

I = (C - (C \ 4) - (C - K) \ 3 + (19 * G) + 15) MOD 30
I = I - (I \ 28) * (1 - (I \ 28) * (29 \ (I + 1)) * ((21 - G) \ 11))
I = I - (Year + Year \ 4 + I + 2 - C + C \ 4) MOD 7

M = 3 + (I + 40) \ 44
D = I + 28 - 31 * (M \ 4)

Easter = LTRIM$(STR$(M)) + "/" + LTRIM$(STR$(D)) + "/" + LTRIM$(STR$(Year))
END FUNCTION

FUNCTION JulianDay&& (M AS INTEGER, D AS INTEGER, Y AS INTEGER, Flag AS INTEGER)
DIM F AS DOUBLE, J AS DOUBLE, J1 AS DOUBLE

IF Flag = 1 THEN J1 = -INT((INT((INT(Y + SGN(M - 9) * INT(ABS(M - 9) / 7))) / 100) + 1) * 3 / 4)

J = (-INT(7 * (INT((M + 9) / 12) + Y) / 4)) + (INT(275 * M / 9) + INT(D) + Flag * J1) + 1721027 + 2 * Flag + 367 * Y

F = (D - INT(D) - 0.5): IF F >= 0 THEN JulianDay = J + 1 ELSE F = F + 1: JulianDay = J
END FUNCTION

FUNCTION NameWeek$ (Value AS INTEGER, Flag AS INTEGER)
DIM TempStr AS STRING

DIM WeekNames AS STRING
WeekNames = "Sunday   Monday   Tuesday  WednesdayThursday Friday   Saturday "

TempStr = RTRIM$(MID$(WeekNames, 9 * Value + 1, 9))
IF Flag THEN NameWeek = LEFT$(TempStr, 3) ELSE NameWeek = TempStr
END FUNCTION

FUNCTION NameMonth$ (Value AS INTEGER, Flag AS INTEGER)
DIM TempStr AS STRING

DIM MonthNames AS STRING
MonthNames = "January  February March    April    May      June     July     August   SeptemberOctober  November December"

TempStr = RTRIM$(MID$(MonthNames, 9 * Value + 1, 9))
IF Flag THEN NameMonth = LEFT$(TempStr, 3) ELSE NameMonth = TempStr
END FUNCTION

RhoSigma

  • Sr. Member
  • ****
  • Posts: 377
  • Out of Time !!
Re: Date and Time Functions
« Reply #1 on: April 05, 2018, 10:24:36 pm »
Nice work Code Hunter,

some of this is also available here: http://www.qb64.net/forum/index.php?topic=10822.msg90572#msg90572

of course, there's nothing special like calculating the Easter Date, its more a pure date/time formatting function. In fact a wrapper to the strftime() C/C++ standard library function (http://www.cplusplus.com/reference/ctime/strftime/?kw=strftime).

euklides

  • Newbie
  • *
  • Posts: 36
Re: Date and Time Functions
« Reply #2 on: April 06, 2018, 12:33:03 am »
Nice, but classical.
You could also add the season's beginning date (day and hour) [moon equations].
I have such a program written in Visual Basic...
Julian is usefull for the calculation of the number of days between two dates.

 :)



Code Hunter

  • Newbie
  • *
  • Posts: 18
Re: Date and Time Functions
« Reply #3 on: April 06, 2018, 01:52:58 am »
RhoSigma: I don't know about your Date/Time functions, but I did these in DOS back when I was working mainly on my ASCII 'Time Bot' program.  I converted them for use in Qb64 and added some requested extras like the Epoch to Date function.

Thank you euklides. I did use the function to calculate the current Moon Phase and would display an ascii moon in that phase.
« Last Edit: April 06, 2018, 02:17:52 am by Code Hunter »

  • Print