Code archives/Miscellaneous/Julian Days conversion
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
This is a simple method of converting Blitz dates into "Julian Days". Using this format you can convert any two dates into Julian Days and then simply substract the two resulting numbers to get the number of days between those dates without having to worry about days per month, leap years and all the rest! Can for example be used for calculating trial periods. | |||||
Dim Months$(12) Months(1)="JAN":Months(2)="FEB":Months(3)="MAR":Months(4)="APR":Months(5)="MAY":Months(6)="JUN": Months(7)="JUL": Months(8)="AUG": Months(9)="SEP": Months(10)="OCT": Months(11)="NOV": Months(12)="DEC" Print "Days between today and 23 Aug 2008: " + (JulianDays("23 AUG 2008") - JulianDays(CurrentDate())) Function FindMonth(fm$) For i=1 To 12 If Upper(fm$)=months$(i) Then Return i Next End Function Function JulianDays(txt$) d=Int(Left(txt$,2)) m=Int(FindMonth(Mid(txt$,4,3))) y=Int(Right(txt$,4)) jd=( 1461 * ( y + 4800 + ( m - 14 ) / 12 ) ) / 4 + ( 367 * ( m - 2 - 12 * ( ( m - 14 ) / 12 ) ) ) / 12 - ( 3 * ( ( y + 4900 + ( m - 14 ) / 12 ) / 100 ) ) / 4 + d - 32075 Return jd End Function |
Comments
| ||
The code below is public domain and is used to convert a Blitz date string to MS Excel type date number (1/1/1900 =day 1) and back. Function E2Day$(ed) y%=Floor(ed/365.25) r%=ed-Floor(y*365+Floor((y+3)/4)) Y=Y+1900 m=Int(r/30) If (r-m*30)<1 Then m=m-1 If (y Mod 4) =0 Then ;leap year If r<32 Then Return Str$(r)+" JAN "+Y ElseIf r<61 Return Str$(r-31)+" FEB "+Y ElseIf r<92 Return Str$(r-60)+" MAR "+Y ElseIf r<122 Return Str$(r-91)+" APR "+Y ElseIf r<153 Return Str$(r-121)+" MAY "+Y ElseIf r<183 Return Str$(r-152)+" JUN "+Y ElseIf r<214 Return Str$(r-182)+" JUL "+Y ElseIf r<245 Return Str$(r-213)+" AUG "+Y ElseIf r<275 Return Str$(r-244)+" SEP "+Y ElseIf r<306 Return Str$(r-274)+" OCT "+Y ElseIf r<336 Return Str$(r-305)+" NOV "+Y ElseIf r<367 Return Str$(r-335)+" DEC "+Y Else Return "LERROR" EndIf Else If r<32 Return Str$(r)+" JAN "+Y ElseIf r<60 Return Str$(r-31)+" FEB "+Y ElseIf r<91 Return Str$(r-59)+" MAR "+Y ElseIf r<121 Return Str$(r-90)+" APR "+Y ElseIf r<152 Return Str$(r-120)+" MAY "+Y ElseIf r<182 Return Str$(r-151)+" JUN "+Y ElseIf r<213 Return Str$(r-181)+" JUL "+Y ElseIf r<244 Return Str$(r-212)+" AUG "+Y ElseIf r<274 Return Str$(r-243)+" SEP "+Y ElseIf r<305 Return Str$(r-273)+" OCT "+Y ElseIf r<335 Return Str$(r-304)+" NOV "+Y ElseIf r<366 Return Str$(r-334)+" DEC "+Y Else Stop Return "NLERROR" EndIf EndIf End Function Function EDATE(txt$) ;Calculates a EXCEL type "Julian Date" ;day 1 = 1/1/1900 ;assumes DD_MMM_YYYY d=Int(Left(txt$,2)) m=Int(FindMonth(Mid(txt$,4,3))) y=Int(Right(txt$,4)) If y>1899 Then y=y-1900 ElseIf y>99 Then Return 0 Else Return 0 EndIf ;(y+3)/4 adds leap day r%=d+y*365+Floor((y+3)/4) If (y Mod 4)=0 Then ;extra day if leap year and month is not Feb or Jan If m>2 Then r=r+1 EndIf Select m Case 1 :Return r Case 2 :Return r+31 Case 3 :Return r+59 Case 4 :Return r+90 Case 5 :Return r+120 Case 6 :Return r+151 Case 7 :Return r+181 Case 8 :Return r+212 Case 9 :Return r+243 Case 10 :Return r+273 Case 11 :Return r+304 Case 12 :Return r+334 Default :Return 0 End Select End Function Function FindMonth(fm$) Select Upper$(fm$) Case "JAN": Return 1 Case "FEB": Return 2 Case "MAR": Return 3 Case "APR": Return 4 Case "MAY": Return 5 Case "JUN": Return 6 Case "JUL": Return 7 Case "AUG": Return 8 Case "SEP": Return 9 Case "OCT": Return 10 Case "NOV": Return 11 Case "DEC": Return 12 Default Return 0 End Select End Function |
Code Archives Forum