Paradox Community
Search:

 Welcome |  What is Paradox |  Paradox Folk |  Paradox Solutions |
 Interactive Paradox |  Paradox Programming |  Internet/Intranet Development |
 Support Options |  Classified Ads |  Wish List |  Submissions 


Paradox Programming Articles  |  Beyond Help Articles  |  Tips & Tricks Articles  


Paradox® Date, Time, and DateTime Data Types
Common (Shared) ObjectPAL® Routines
© 2001 Rick Kelly
www.crooit.com

Download the library containing the routines used in this series.

All of the following OPAL routines are referenced by, and support the main methods presented in this series. They are shown below as Proc’s. You may also choose to convert them to methods. In all my commercial products, I use Procs for shared routines so that they are not available to the general library caller. In this way, I have freedom to change them at will (and have done so) without affecting main method calling structures.

Quick links to specific procs (in alphabetical order):
cmAMod
cmArcCoSin
cmArcSin
cmCalcDegrees
cmCalcSunRiseOrSet
cmCeiling
cmClearSummary
cmCos
cmDayOfWeekFromFixed
cmDegreesToRadians
cmEccentricityEarthOrbit
cmEquationOfTime
cmFloor
cmGregorianLeapYear
cmGregorianYearFromFixed
cmHistoryLocation
cmHistorySize
cmJ2000
cmLocalFromUniversal
cmMeanObliquityOfEcliptic
cmMod
cmMomentFromDateTime
cmMomentFromStarDate
cmMomentToDateTime
cmNthWeekDay
cmObliquityCorrection
cmRadiansToDegrees
cmShiftHistory
cmSin
cmSinDegrees
cmSolarApparentLongitude
cmSolarDeclination
cmSolarEquationOfCenter
cmSolarHourAngle
cmSolarMeanAnomaly
cmSolarMeanLongitude
cmSolarTrueLongitude
cmStarDateCenturies
cmStarDateFromMoment
cmSumOneMonth
cmSunRiseOrSetUTC
cmTan
cmTimeFromMoment
cmTimeToMoment
cmWeekDayAfter
cmWeekDayBefore
cmWeekDayNearest
cmWeekDayOnOrAfter
cmWeekDayOnOrBefore

Top of Page
Proc cmGregorianYearFromFixed(liFixedDate LongInt) SmallInt 1 (page 37)
;
; Return Year from internal fixed date
;
; If liFixedDate > 0 then we use normal
; pdx date methods otherwise it is calculated
;
; 146097 represents the last day of a leap year
;    of a 400 year cycle
;
; 1461 represents the last day of a 4 year cycle
;
var
siReturnYear    SmallInt
liCenturies400  LongInt
liCenturies100  LongInt
li4YearCycles   LongInt
liYears         LongInt
nuFixedDate     Number
nuD1            Number
nuD2            Number
nuD3            Number
endVar
;
; Fixed Date < January 1, 0001 (Fixed Date=1)
;
switch
;
; Calculate Year
;
case liFixedDate < 1 :
  nuFixedDate = liFixedDate - 1
;
; Number of Leap Year Centuries
;
  liCenturies400 = longInt(cmFloor(nuFixedDate / 146097))
;
; Number of Centuries
;
  nuD1 = cmMod(146097,nuFixedDate)
  liCenturies100 = longInt(cmFloor(nuD1 / 36524))
  nuD2 = nuD1.mod(36524)
;
; Number of 4 year cycles
;
  li4YearCycles = longInt(cmFloor(nuD2 / 1461))
;
; Number of Years
;
  nuD3 = nuD2.mod(1461)
  liYears = longInt(cmFloor(nuD3 / 365))
  siReturnYear = smallInt(400 *
                          liCenturies400 +
                          100 *
                          liCenturies100 +
                          4 *
                          li4YearCycles +
                          liYears)
  switch
    case liCenturies100 = 4 or liYears = 4 :
    otherwise :
      siReturnYear = siReturnYear + 1
  endSwitch
;
; Use normal pdx date year method
;
otherwise :
  siReturnYear = year(date(liFixedDate))
endSwitch
return siReturnYear
endProc

Top of Page
Proc cmGregorianLeapYear(nuYear Number) Logical 1 (page 36)
;
; nuYear is a leap year if evenly divisible
; by 4 and if nuYear is a century year (ends with 00)
; it is also evenly divisible by 400
;
var
loReturn    Logical
endVar
loReturn = False
switch
case cmMod(4,nuYear) <> 0 :
case cmMod(400,nuYear) = 100 or
     cmMod(400,nuYear) = 200 or
     cmMod(400,nuYear) = 300 :
otherwise :
  loReturn = True
endSwitch
return loReturn
endProc

Top of Page
Proc cmNthWeekDay(siNthDay SmallInt, siWeekDay SmallInt, liFixedDate LongInt) LongInt1 (Page 40)
;
; Find the nth occurrence of a weekday based
; on a given base date
;
; siWeekDay Values
;
; Sunday    = 0
; Monday    = 1
; Tuesday   = 2
; Wednesday = 3
; Thursday  = 4
; Friday    = 5
; Saturday  = 6
;
switch
case siNthDay = 0 :
  return liFixedDate
case siNthDay > 0 :
  return 7 * siNthDay + cmWeekDayBefore(liFixedDate,siWeekDay)
otherwise :
  return 7 * siNthDay + cmWeekDayAfter(liFixedDate,siWeekDay)
endSwitch
endProc

Top of Page
Proc cmWeekDayBefore(liFixedDate LongInt, siWeekDay SmallInt) LongInt1 (Page 19)
return cmWeekDayOnOrBefore(liFixedDate - 1,siWeekDay)
endProc

Top of Page
Proc cmWeekDayAfter(liFixedDate LongInt, siWeekDay SmallInt) LongInt1 (Page 19)
return cmWeekDayOnOrBefore(liFixedDate + 7,siWeekDay)
endProc

Top of Page
Proc cmWeekDayNearest(liFixedDate LongInt, siWeekDay SmallInt) LongInt1 (Page 19)
return cmWeekDayOnOrBefore(liFixedDate + 3,siWeekDay)
endProc

Top of Page
Proc cmWeekDayOnOrAfter(liFixedDate LongInt, siWeekDay SmallInt) LongInt1 (Page 19)
return cmWeekDayOnOrBefore(liFixedDate + 6,siWeekDay)
endProc

Top of Page
Proc cmWeekDayOnOrBefore(liFixedDate LongInt, siWeekDay SmallInt) LongInt1 (Page 17)
return liFixedDate - cmDayOfWeekFromFixed(liFixedDate - siWeekDay)
endProc

Top of Page
Proc cmDayOfWeekFromFixed(liFixedDate LongInt) SmallInt1 (Page 17)
;
; Calculate the day of the week
;
; Sun = 0
; Mon = 1
; Tue = 2
; Wed = 3
; Thu = 4
; Fri = 5
; Sat = 6
;
return smallInt(cmMod(7,liFixedDate))
endProc

Top of Page
Proc cmCalcSunRiseOrSet(nuMoment Number,
                        nuLatitude Number,
                        nuLongitude Number,
                        nuTimeOffset Number,
                        nuRiseOrSet Number) Number
;
; Return Sunrise/Sunset time for given
; Star Moment nuMoment
;
; nuTimeOffset is the time zone adjustment in minutes
;
; nuRiseOrSet = +1 for Sunrise
;             = -1 for Sunset
;
; Latitude/Longitude is given in decimal degrees
; and positive for north/west and
; negative for south/east respectively
;
var
nuSunMoment Number
endVar
;
; Star Moment of Sunrise/Sunset is converted
; to local time
;
nuSunMoment = cmLocalFromUniversal(cmSunRiseOrSetUTC(nuMoment,
                                                     nuLatitude,
                                                     nuLongitude,
                                                     nuRiseOrSet),nuTimeOffset)
;
; Check if time adjustment forced a day change
; and if true, re-calculate based on the next day
;
switch
case nuSunMoment.floor() <> nuMoment.floor() :
  nuSunMoment = cmLocalFromUniversal(cmSunRiseOrSetUTC(nuMoment + 1,
                                                       nuLatitude,
                                                       nuLongitude,
                                                       nuRiseOrSet),nuTimeOffset)
endSwitch
return nuSunMoment
endProc

Top of Page
Proc cmLocalFromUniversal(nuLocalTime Number, nuZone Number) Number1 (Page 143)
;
; Convert Universal Time to Local Time
;
; nuZone is in minutes (1440 minutes in day)
;
return nuLocalTime + (nuZone / 1440)
endProc

Top of Page
Proc cmSunRiseOrSetUTC(nuMoment Number,
                       nuLatitude Number,
                       nuLongitude Number,
                       nuSetOrRise Number) Number
;
; Calculate UTC Sunrise or Sunset on nuMoment
;
; nuSetOrRise = 1 for sunrise, -1 for sunset
;
var
nuEOT           Number
nuDeclination   Number
nuHourAngle     Number
nuDelta         Number
nuTimeDiff      Number
nuTimeUTC       Number
nuNewTime       Number
nuStarDate      Number
nuCenturies     Number
endVar
;
; Calculate Star Date
;
nuStarDate = cmStarDateFromMoment(nuMoment)
;
; Calculate Star Date Centuries
;
nuCenturies = cmStarDateCenturies(nuStarDate)
;
; Equation of Time in Minutes
;
nuEOT = cmEquationOfTime(nuStarDate) * 1440.0
;
; Solar Declination
;
nuDeclination = cmSolarDeclination(nuCenturies)
;
; Solar Hour Angle (Right Ascension)
;
nuHourAngle = cmSolarHourAngle(nuLatitude, nuDeclination, nuSetOrRise)
;
; Convert Hour Angle to Longitude
;
nuDelta = nuLongitude - (180.0 * nuHourAngle / cnPI)
;
; Adjust time based on longitude and Equation of Time
;
nuTimeDiff = nuDelta * 4.0
nuTimeUTC = 720.0 + nuTimeDiff - nuEOT
nuNewTime = nuStarDate + (nuTimeUTC / 1440.0)
;
; Recalculate based on adjusted time
;
nuEOT = cmEquationOfTime(nuNewTime) * 1440
nuCenturies = cmStarDateCenturies(nuNewTime)
nuDeclination = cmSolarDeclination(nuCenturies)
nuHourAngle = cmSolarHourAngle(nuLatitude, nuDeclination, nuSetOrRise)
nuDelta = nuLongitude - (180.0 * nuHourAngle / cnPI)
nuTimeDiff = nuDelta * 4.0
nuTimeUTC = 720.0 + nuTimeDiff - nuEOT
switch
case nuTimeUTC < 0 :
  nuTimeUTC = cmMod(1440,nuTimeUTC)/1440.0 + nuMoment - 1
otherwise :
  nuTimeUTC = nuTimeUTC / 1440.0 + nuMoment
endSwitch
return nuTimeUTC
endProc

Top of Page
Proc cmSolarHourAngle(nuLatitude Number, nuDeclination Number, nuSetOrRise Number) Number
var
nuLatRad    Number
nuDecRad    Number
endVar

nuLatRad = cnPI * nuLatitude / 180.0
nuDecRad = cnPI * nuDeclination / 180.0
return (cmArcCoSin(cmCos(cnPI * 90.833 / 180.0) /
                   (cmCos(nuLatRad) *
                    cmCos(nuDecRad)) -
                   cmTan(nuLatRad) *
                   cmTan(nuDecRad))) * nuSetOrRise
endProc

Top of Page
Proc cmSolarDeclination(nuCenturies Number) Number
var
nuObliquity Number
nuLongitude Number
nuSint      Number
endVar

nuObliquity = cmObliquityCorrection(nuCenturies)
nuLongitude = cmSolarApparentLongitude(nuCenturies)
nuSint = cmSinDegrees(nuObliquity) * cmSinDegrees(nuLongitude)
return 180.0 * cmArcSin(nuSint) / cnPI
endProc

Top of Page
Proc cmObliquityCorrection(nuCenturies Number) Number 2 (Page 144)
var
nuOmega Number
endVar
nuOmega = 125.04452 -
          (1934.136261 * nuCenturies) +
          (.0020708 * nuCenturies.pow(2)) +
          (nuCenturies.pow(3) / 450000)
return cmMeanObliquityOfEcliptic(nuCenturies) + .00256 * cmCos(cnPI * nuOmega / 180.0)
endProc

Top of Page
Proc cmMeanObliquityOfEcliptic(nuCenturies Number) Number 2 (Page 147)
var
nuSeconds   Number
endVar
nuSeconds = 21.448 - nuCenturies * (46.8150 + nuCenturies * (.00059 - nuCenturies * (.001813)))
return 23.0 + (26.0 + (nuSeconds / 60.0)) / 60.0
endProc

Top of Page
Proc cmSolarApparentLongitude(nuCenturies Number) Number 2 (Page 164)
var
nuOmega Number
endVar
nuOmega = 125.04 - 1934.136 * nuCenturies
return cmSolarTrueLongitude(nuCenturies) - .00569 - .00478 * cmSin(cnPI * nuOmega / 180.0)
endProc

Top of Page
Proc cmSolarTrueLongitude(nuCenturies Number) Number 2 (Page 164)
return cmSolarMeanLongitude(nuCenturies) + cmSolarEquationOfCenter(nuCenturies)
endProc

Top of Page
Proc cmSolarMeanLongitude(nuCenturies Number) Number 2 (Page 183)
;
; Geometric Mean Longitude of the Sun
;
return cmCalcDegrees(280.4664567 +
                     (36000.76982779 * nuCenturies) +
                     (.3032028 * nuCenturies.pow(2)) +
                     (nuCenturies.pow(3) / 4993.1) -
                     (nuCenturies.pow(4) / 1530) -
                     (nuCenturies.pow(5) / 200000))
endProc

Top of Page
Proc cmSolarEquationOfCenter(nuCenturies Number) Number 2 (Page 164)
;
; Equation of Center for the Sun
;
var
nuMeanAnomaly  Number
nuSinM         Number
nuSin2M        Number
nuSin3M        Number
endVar
nuMeanAnomaly = (cnPI * cmSolarMeanAnomaly(nuCenturies)) / 180.0
nuSinM = cmSin(nuMeanAnomaly)
nuSin2M = cmSin(nuMeanAnomaly + nuMeanAnomaly)
nuSin3M = cmSin(nuMeanAnomaly + nuMeanAnomaly + nuMeanAnomaly)
return nuSinM * (1.914602 - nuCenturies * (.004817 + .000014 * nuCenturies)) +
       nuSin2M * (.019993 - .000101 * nuCenturies) +
       nuSin3M * .000289
endProc

Top of Page
Proc cmSolarMeanAnomaly(nuCenturies Number) Number 2 (Page 163)
;
; Geometric Mean Anomaly of the Sun
;
return 357.52911 + nuCenturies * (35999.05029 - .0001537 * nuCenturies)
endProc

Top of Page
Proc cmEccentricityEarthOrbit(nuCenturies Number) Number 2 (Page 163)
;
; Eccentricity of Earth's orbit
;
return .016708634 - nuCenturies * (.000042037 + .0000001267 * nuCenturies)
endProc

Top of Page
Proc cmEquationOfTime(nuStarDate Number) Number2 (Page 185)
var
nuCenturies     Number  ; Star Date Centuries
nuEpsilon       Number
nuMeanLongitude Number
nuMeanAnomaly   Number
nuSin210        Number
nuSinM          Number
nuCos210        Number
nuSin410        Number
nuSin2m         Number
nuY             Number
nuAnomaly       Number
nuEccentricity  Number
nuTimeAdjust    Number
endVar
nuCenturies = cmStarDateCenturies(nuStarDate)
nuEpsilon = cmObliquityCorrection(nuCenturies)
nuMeanLongitude = cmSolarMeanLongitude(nuCenturies)
nuEccentricity = cmEccentricityEarthOrbit(nuCenturies)
nuAnomaly = cmSolarMeanAnomaly(nuCenturies)
nuY = cmTan((cnPI * nuEpsilon / 180.0) / 2.0)
nuY = nuY * nuY
nuSin210 = cmSin((cnPI * nuMeanLongitude / 180) * 2.0)
nuSinM = cmSin(cnPI * nuAnomaly / 180)
nuCos210 = cmCos((cnPI * nuMeanLongitude / 180.0) * 2.0)
nuSin410 = cmSin((cnPI * nuMeanLongitude / 180.0) * 4.0)
nuSin2m = cmSin((cnPI * nuAnomaly / 180.0) * 2.0)
nuTimeAdjust = nuY *
               nuSin210 -
               2.0 *
               nuEccentricity *
               nuSinM +
               4.0 *
               nuEccentricity *
               nuY *
               nuSinM *
               nuCos210 -
               .5 *
               nuY *
               nuY *
               nuSin410 -
               1.25 *
               nuEccentricity *
               nuEccentricity *
               nuSin2m
; Fraction of Solar Day
return ((180.0 * nuTimeAdjust / cnPI) * 4.0 / 1440.0)
endProc

Top of Page
Proc cmJ2000() Number 1  (Page 140)
;
; Star Date representing noon, Jan 1, 2000. (2451545.0)
;
return cmStarDateFromMoment(emFixedFromGregorian(date(1,1,2000)) + .5)
endProc

Top of Page
Proc cmStarDateCenturies(nuStarDate Number) Number 2 (Page 163)
;
; Number of Julian centuries before or
; after noon, Jan 1, 2000.
;
return (nuStarDate - cmJ2000()) / 36525.0
endProc

Top of Page
Proc cmSinDegrees(nuAny Number) Number
;
; Convert Degrees to Radians and return the sine
;
return cmSin(cmDegreesToRadians(nuAny))
endProc

Top of Page
Proc cmCos(nuAny Number) Number
;
;Wrapper for PDX cos() method
;
return nuAny.cos()
endProc

Top of Page
Proc cmSin(nuAny Number) Number
;
;Wrapper for PDX sin() method
;
return nuAny.sin()
endProc

Top of Page
Proc cmArcSin(nuAny Number) Number
;
;Wrapper for PDX asin() method
;
return nuAny.asin()
endProc

Top of Page
Proc cmArcCoSin(nuAny Number) Number
;
;Wrapper for PDX acos() method
;
return nuAny.acos()
endProc

Top of Page
Proc cmTan(nuAny Number) Number
;
;Wrapper for PDX tan() method
;
return nuAny.tan()
endProc

Top of Page
Proc cmDegreesToRadians(nuAny Number) Number
;
; Convert Degrees to Radians
;
return cmCalcDegrees(nuAny) * cnPI * (1.0 / 180.0)
endProc

Top of Page
Proc cmRadiansToDegrees(nuAny Number) Number
;
; Convert Radians to Degrees
;
return cmCalcDegrees(nuAny / cnPI / (1.0 / 180.0))
endProc

Top of Page
Proc cmCalcDegrees(nuAny Number) Number
;
; Normalize degrees within 0-360
;
return cmMod(360,nuAny)
endProc

Top of Page
Proc cmMomentFromDateTime(daAny Date,tiAny Time) Number
;
; Given Date and Time Types, return a Moment
;
return number(emFixedFromGregorian(daAny)) + cmTimeToMoment(tiAny)
endProc

Top of Page
Proc cmMomentToDateTime(nuMoment Number) DateTime
;
; Given a Moment, return Date and Time
;
return emDateTime(emGregorianFromFixed(longInt(cmFloor(nuMoment))), cmTimeFromMoment(nuMoment))
endProc

Top of Page
Proc cmMomentFromStarDate(nuStarDateAny Number) Number
;
; Return Moment from Star Date
;
return nuStarDateAny + cnStarDateStart
endProc

Top of Page
Proc cmStarDateFromMoment(nuMoment Number) Number
;
; Return Star Date from Moment
;
return nuMoment - cnStarDateStart
endProc

Top of Page
Proc cmTimeFromMoment(nuMoment Number) Time
;
; Convert the fractional portion of a solar day to PDX
; time format - each day has 86,400,000 milliseconds
;
return time(nuMoment.fraction() * cnOneDay)
endProc

Top of Page
Proc cmTimeToMoment(tiAny Time) Number
;
; Convert PDX time to fractional portion of a solar day
;
return number(tiAny) / cnOneDay
endProc

Top of Page
Proc cmAMod(nuBaseMultiple Number, nuBaseNumber Number) Number1 (Pages 15, 234)
;
; Variation of normal mod adjusted so that the modulus
; of a multiple of the divisor is the divisor itself
; rather than zero
;
var
nuNormalizedNumber    Number
endVar
nuNormalizedNumber = cmMod(nuBaseMultiple,nuBaseNumber)
switch
case nuNormalizedNumber = 0 :
  nuNormalizedNumber = nuBaseMultiple
endSwitch
return nuNormalizedNumber
endProc

Top of Page
Proc cmFloor(nuFloorNumber Number) Number
;
; Wrapper for pdx floor() method
;
return nuFloorNumber.floor()
endProc

Top of Page
Proc cmMod(nuBaseMultiple Number,nuBaseNumber Number) Number
;
; Variation of normal mod to handle numbers less than zero
;
var
nuNormalizedNumber  Number
endVar
nuNormalizedNumber = nuBaseNumber.mod(nuBaseMultiple)
switch
case nuNormalizedNumber < 0 :
  nuNormalizedNumber = nuNormalizedNumber + nuBaseMultiple
endSwitch
return nuNormalizedNumber
endProc

Top of Page
Proc cmCeiling(nuAny Number) Number
;
; Round up to the nearest whole number
;
return nuAny.ceil()
endProc

Top of Page
Proc cmShiftHistory(var siHistoryMonth SmallInt, var arHistory arHistoryMonths)
;
; Save and Clear Current History
;
var
siMonthSize     SmallInt
siMonthStart    SmallInt
siCurrentMonth  SmallInt
siIndex         SmallInt
endVar
;
; Calculate size of one months history
;
siMonthSize = cmHistorySize(arHistory)

;
; Calculate beginning array location for month
;
siMonthStart = cmHistoryLocation(siHistoryMonth, siMonthSize)
;
; Calculate beginning array location for
; current month's history
;
siCurrentMonth = cmHistoryLocation(13, siMonthSize)
;
; Move and Clear Current History
;
for siIndex from siMonthStart to siMonthStart+siMonthSize-1
  arHistory[siIndex] = arHistory[siCurrentMonth]
  arHistory[siCurrentMonth] = 0
  siCurrentMonth = siCurrentMonth + 1
endFor
endProc

Top of Page
Proc cmHistoryLocation(siMonth SmallInt, siMonthSize SmallInt) SmallInt
;
; Calculate beginning history array for siMonth
;
return (siMonth * siMonthSize) - siMonthSize + 1
endProc

Top of Page
Proc cmHistorySize(var arHistory arHistoryMonths) SmallInt
;
; Calculate the size or number of fields of
; one months history
;
return smallInt(arHistory.size() / 13)
endProc

Top of Page
Proc cmSumOneMonth(siMonth SmallInt,
                   var arHistory arHistoryMonths,
                   var arSummary arHistorySummary)
;
; Add the siMonth values from arHistory to arSummary
;
var
siIndex             SmallInt
siHistoryIndex      SmallInt
endVar
siHistoryIndex = cmHistoryLocation(siMonth, arSummary.size())
for siIndex from 1 to arSummary.size()
  arSummary[siIndex] = arSummary[siIndex] + arHistory[siHistoryIndex]
  siHistoryIndex = siHistoryIndex + 1
endFor
endProc

Top of Page
Proc cmClearSummary(var arHistory arHistoryMonths, var arSummary arHistorySummary)
;
; Calculate size of one months history
; and initialize summary totals
;
var
siIndex     SmallInt
endVar
arSummary.empty()
arSummary.grow(cmHistorySize(arHistory))
for siIndex from 1 to arSummary.size()
  arSummary[siIndex] = 0
endFor
endProc

Paradox Date, Time, and DateTime Data Types articles:
Introduction and Internal Formats
B.C. Date Adjustments
Calculations Using Date Types
Basic Astronomy and Time Types
More B.C. Date Tips and Tricks
Odds and Ends - Fiscal Periods
Odds and Ends - Thirteen Month Rolling Histories
Odds and Ends - Thirteen Month Rolling History Summary Calculations

References


Discussion of this article


 Feedback |  Paradox Day |  Who Uses Paradox |  I Use Paradox |  Downloads 


 The information provided on this Web site is not in any way sponsored or endorsed by Corel Corporation.
 Paradox is a registered trademark of Corel Corporation.


 Modified: 09 Jun 2004
 Terms of Use / Legal Disclaimer


 Copyright © 2001- 2004 Paradox Community. All rights reserved. 
 Company and product names are trademarks or registered trademarks of their respective companies. 
 Authors hold the copyrights to their own works. Please contact the author of any article for details.