Microsoft Small Basic

Program Listing: JQQ629

List Program

' Date Calculator
' Version 0.1
' Copyright © 2016 Nonki Takahashi. The MIT License.
' Last update 2016-06-09
'
GraphicsWindow.Title = "Date Calculator 0.1"
Init()
If "False" Then
Test()
EndIf
Form()
Run()
Sub Test
jd = 2299160.5 ' 1582-10-15
JDToDate()
TextWindow.WriteLine("JDtoDate("+jd+")=" + date)
JDNow()
TextWindow.WriteLine("JDNow()=" + jd)
JDToDate()
TextWindow.WriteLine("JDtoDate(jd)=" + date)
DateToJD()
TextWindow.WriteLine("DatetoJD(date)=" + jd)
jd = jd - 365
TextWindow.WriteLine("jd-365=" + jd)
JDToDate()
TextWindow.WriteLine("JDtoDate(jd)=" + date)
DateToJD()
TextWindow.WriteLine("DatetoJD(date)=" + jd)
testset[1] = "JD=-0.5;Date=4713 BC/01/01;"
testset[2] = "JD=999999.5;Date=1976 BC/11/07;"
testset[3] = "JD=1234566.5;Date=1333 BC/01/23;"
testset[4] = "JD=1999999.5;Date=763/09/14;"
testset[5] = "JD=2299159.5;Date=1582/10/04;"
testset[6] = "JD=2299160.5;Date=1582/10/15;"
testset[7] = "JD=2345677.5;Date=1710/02/23;"
testset[8] = "JD=2400000.5;Date=1858/11/17;"
testset[9] = "JD=2415020.5;Date=1900/01/01;"
testset[10] = "JD=2415385.5;Date=1901/01/01;"
testset[11] = "JD=2451544.5;Date=2000/01/01;"
testset[12] = "JD=2451604.5;Date=2000/03/01;"
testset[13] = "JD=2451910.5;Date=2001/01/01;"
testset[14] = "JD=2451969.5;Date=2001/03/01;"
testset[15] = "JD=2456788.5;Date=2014/05/11;"
testset[16] = "JD=2457023.5;Date=2015/01/01;"
testset[17] = "JD=2457181.5;Date=2015/06/08;"
testset[18] = "JD=2457424.5;Date=2016/02/06;"
testset[19] = "JD=2457547.5;Date=2016/06/08;"
testset[20] = "JD=2457790.5;Date=2017/02/06;"
testset[21] = "JD=2457912.5;Date=2017/06/08;"
testset[22] = "JD=2488069.5;Date=2100/01/01;"
testset[23] = "JD=2488434.5;Date=2101/01/01;"
testset[24] = "JD=2567889.5;Date=2318/07/18;"
testset[25] = "JD=2889835.5;Date=3200/01/01;"
testset[26] = "JD=2999999.5;Date=3501/08/15;"
testset[27] = "JD=3029645.5;Date=3582/10/15;"
testset[28] = "JD=3145505.5;Date=3900/01/01;"
testset[29] = "JD=3145870.5;Date=3901/01/01;"
testset[30] = "JD=3456788.5;Date=4752/04/07;"
testset[31] = "JD=3999999.5;Date=6239/07/12;"
pass = 0
failed = 0
UnitTest()
RandomTest()
If 0 < pass Then
TextWindow.ForegroundColor = "Green"
Else
TextWindow.ForegroundColor = "Gray"
EndIf
TextWindow.WriteLine(pass + " / " + n + " test[s] : PASS.")
If 0 < failed Then
TextWindow.ForegroundColor = "Red"
TextWindow.WriteLine(failed + " test[s] : FAILED.")
EndIf
TextWindow.ForegroundColor = "Gray"
While "True"
TextWindow.Write("JD? ")
jd = TextWindow.Read()
JDToDate()
TextWindow.WriteLine("JDtoDate("+jd+")=" + date)
DateToJD()
TextWindow.WriteLine("DateToJD("+date+")=" + jd)
EndWhile
EndSub
Sub UnitTest
n = Array.GetItemCount(testset)
For i = 1 To n
jd = testset[i]["JD"]
JDToDate()
failure = "False"
If date = testset[i]["Date"] Then
TextWindow.ForegroundColor = "Green"
TextWindow.WriteLine("Test " + i + ": JDToDate(" + jd + ")=" + date + " : PASS")
Else
TextWindow.ForegroundColor = "Red"
TextWindow.WriteLine("Test " + i + ": JDToDate(" + jd + ")=" + date + " : FAILED")
failure = "True"
EndIf
date = testset[i]["Date"]
DateToJD()
If jd = testset[i]["JD"] Then
TextWindow.ForegroundColor = "Green"
TextWindow.WriteLine("Test " + i + ": DateToJD(" + date + ")=" + jd + " : PASS")
Else
TextWindow.ForegroundColor = "Red"
TextWindow.WriteLine("Test " + i + ": DateToJD(" + date + ")=" + jd + " : FAILED")
failure = "True"
EndIf
If failure Then
falied = failed + 1
Else
pass = pass + 1
EndIf
EndFor
EndSub
Sub RandomTest
For i = i To 40
jdSave = Math.GetRandomNumber(4000000) - 0.5
jd = jdSave
JDToDate()
DateToJD()
If jd = jdSave Then
TextWindow.ForegroundColor = "Green"
TextWindow.WriteLine("Test " + i + ": jd=" + jd + " date=" + date + " : PASS")
pass = pass + 1
Else
TextWindow.ForegroundColor = "Red"
TextWindow.WriteLine("Test " + i + ": jd=" + jd + " date=" + date + " : FAILED")
failed = failed + 1
EndIf
EndFor
n = 40
EndSub
Sub Run
While "True"
If buttonClicked Then
date = Controls.GetTextBoxText(tboxDate1)
DateToJD()
jd1 = jd
Controls.SetTextBoxText(tboxJD1, jd1)
date = Controls.GetTextBoxText(tboxDate2)
DateToJD()
jd2 = jd
Controls.SetTextBoxText(tboxJD2, jd2)
days = jd2 - jd1
Controls.SetTextBoxText(tboxDays, days)
buttonClicked = "False"
Else
Program.Delay(200)
EndIf
EndWhile
EndSub
Sub Form
GraphicsWindow.BackgroundColor = "LightGray"
GraphicsWindow.FontName = "Trebuchet MS"
GraphicsWindow.BrushColor = "Black"
GraphicsWindow.DrawText(10, 13, "D1 (YYYY/MM/DD)")
tboxDate1 = Controls.AddTextBox(130, 10)
GraphicsWindow.DrawText(350, 13, "JD1")
tboxJD1 = Controls.AddTextBox(390, 10)
GraphicsWindow.DrawText(10, 43, "D2 (YYYY/MM/DD)")
tboxDate2 = Controls.AddTextBox(130, 40)
GraphicsWindow.DrawText(350, 43, "JD2")
tboxJD2 = Controls.AddTextBox(390, 40)
GraphicsWindow.DrawText(10, 73, "D2 - D1 (days)")
tboxDays = Controls.AddTextBox(130, 70)
Controls.AddButton("Calc", 10, 102)
JDNow()
JDToDate()
Controls.SetTextBoxText(tboxDate2, date)
jd = jd - 365
JDToDate()
Controls.SetTextBoxText(tboxDate1, date)
Controls.ButtonClicked = OnButtonClicked
EndSub
Sub OnButtonClicked
buttonClicked = "True"
EndSub
Sub Init
dom = "1=31;2=28;3=31;4=30;5=31;6=30;7=31;8=31;9=30;10=31;11=30;12=31;"
EndSub
Sub JDNow
jd = Clock.ElapsedMilliseconds / 1000 / 3600 / 24 + 2415020.5
EndSub
Sub DateToJD
' param date - date formatted as YYYY/MM/DD
' return jd - Julian Day [day]
s1 = Text.GetIndexOf(date, "/")
year = Text.ConvertToUpperCase(Text.GetSubText(date, 1, s1 - 1))
bc = Text.GetIndexOf(year, "BC")
If 0 < bc Then
year = Text.GetSubText(year, 1, bc - 1) + Text.GetSubTextToEnd(year, bc + 2)
year = -(year - 1)
EndIf
s2 = Text.GetIndexOf(Text.GetSubTextToEnd(date, s1 + 1), "/") + s1
month = Text.GetSubText(date, s1 + 1, s2 - s1 - 1)
day = Text.GetSubTextToEnd(date, s2 + 1)
jc = "False" ' Julian calendar
If year < 1582 Then
jc = "True"
ElseIf year = 1582 Then
If month < 10 Then
jc = "True"
ElseIf month = 10 Then
If day <= 4 Then
jc = "True"
ElseIf 4 < day And day < 15 Then
TextWindow.WriteLine("ERROR:Invalid date " + date)
EndIf
EndIf
EndIf
If jc Then ' Julian calendar
y4801BC = year + 4800
d4801BC = Math.Ceiling(y4801BC * 365.25)
If Math.Remainder(y4801BC, 4) = 0 Then
dom[2] = 29
Else
dom[2] = 28
EndIf
For mm = 1 To month - 1
d4801BC = d4801BC + dom[mm]
EndFor
d4801BC = d4801BC + day - 1
jd = d4801BC - 32142.5
Else ' Gregorian calendar
y1200 = year - 1200
nol = Math.Ceiling(y1200 / 4) - Math.Ceiling(y1200 / 100) + Math.Ceiling(y1200 / 400) ' number of leap year
d1200 = y1200 * 365 + nol
If Math.Remainder(y1200, 4) = 0 And Math.Remainder(y1200, 100) <> 0 Or Math.Remainder(y1200, 400) = 0 Then
dom[2] = 29
Else
dom[2] = 28
EndIf
For mm = 1 To month - 1
d1200 = d1200 + dom[mm]
EndFor
d1200 = d1200 + day - 1
jd = d1200 + 2159350.5
EndIf
EndSub
Sub JDToDate
' param jd - Julian Day [day] ≧ -32142.5 (-4801 BC/01/01)
' return date - date formatted as YYYY/MM/DD
If jd < 2299160.5 Then ' Julian calendar
d4801BC = Math.Floor(jd + 0.5) - 0.5 + 32142.5
year = (-4800) + Math.Floor(d4801BC / 365.25)
If Math.Remainder(year, 4) = 0 Then
dom[2] = 29
Else
dom[2] = 28
EndIf
day = Math.Floor(Math.Remainder(d4801BC, 365.25))
If year < 1 Then
year = (Math.Abs(year) + 1) + " BC"
EndIF
Else ' Gregorian calendar
d1200 = Math.Floor(jd + 0.5) - 0.5 - 2159350.5
y1200 = Math.Floor(d1200 / 365.2425)
year = 1200 + y1200
If Math.Remainder(year, 4) = 0 And Math.Remainder(year, 100) <> 0 Or Math.Remainder(year, 400) = 0 Then
dom[2] = 29
Else
dom[2] = 28
EndIf
nol = Math.Ceiling(y1200 / 4) - Math.Ceiling(y1200 / 100) + Math.Ceiling(y1200 / 400) ' number of leap year
day = d1200 - nol
day = Math.Floor(Math.Remainder(d1200 - nol, 365))
EndIf
For mm = 1 To 12
If day < dom[mm] Then
month = mm
mm = 12 ' exit For
Else
day = day - dom[mm]
EndIf
EndFor
If month < 10 Then
month = Text.Append(0, month * 1)
EndIf
day = day + 1
If day < 10 Then
day = Text.Append(0, day * 1)
EndIf
date = year + "/" + month + "/" + day
EndSub