Microsoft Small Basic

Program Listing: JQQ629-0
' Date Calculator
' Version 0.2
' Copyright © 2016-2017 Nonki Takahashi. The MIT License.
' Last update 2017-06-30
' Program ID JQQ629-0
'
GraphicsWindow.Title = "Date Calculator 0.2"
doTest = "False"
Clock_Init()
If doTest Then
Test()
EndIf
Form()
Run()

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)
Clock_JDNow()
Clock_JDToDate()
Controls.SetTextBoxText(tboxDate2, date)
jd = jd - 365
Clock_JDToDate()
Controls.SetTextBoxText(tboxDate1, date)
Controls.ButtonClicked = OnButtonClicked
EndSub

Sub OnButtonClicked
buttonClicked = "True"
EndSub

Sub RandomTest
For i = i To 40
jdSave = Math.GetRandomNumber(4000000) - 0.5
jd = jdSave
Clock_JDToDate()
Clock_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)
Clock_DateToJD()
jd1 = jd
Controls.SetTextBoxText(tboxJD1, jd1)
date = Controls.GetTextBoxText(tboxDate2)
Clock_DateToJD()
jd2 = jd
Controls.SetTextBoxText(tboxJD2, jd2)
days = jd2 - jd1
Controls.SetTextBoxText(tboxDays, days)
buttonClicked = "False"
Else
Program.Delay(200)
EndIf
EndWhile
EndSub

Sub Test
jd = 2299160.5 ' 1582-10-15
Clock_JDToDate()
TextWindow.WriteLine("JDtoDate("+jd+")=" + date)
Clock_JDNow()
TextWindow.WriteLine("JDNow()=" + jd)
Clock_JDToDate()
TextWindow.WriteLine("JDtoDate(jd)=" + date)
Clock_DateToJD()
TextWindow.WriteLine("DatetoJD(date)=" + jd)
jd = jd - 365
TextWindow.WriteLine("jd-365=" + jd)
Clock_JDToDate()
TextWindow.WriteLine("JDtoDate(jd)=" + date)
Clock_DateToJD()
TextWindow.WriteLine("DatetoJD(date)=" + jd)
testCase[1] = "JD=-0.5;Date=4713 BC/01/01;"
testCase[2] = "JD=999999.5;Date=1976 BC/11/07;"
testCase[3] = "JD=1234566.5;Date=1333 BC/01/23;"
testCase[4] = "JD=1999999.5;Date=763/09/14;"
testCase[5] = "JD=2299159.5;Date=1582/10/04;"
testCase[6] = "JD=2299160.5;Date=1582/10/15;"
testCase[7] = "JD=2345677.5;Date=1710/02/23;"
testCase[8] = "JD=2400000.5;Date=1858/11/17;"
testCase[9] = "JD=2415020.5;Date=1900/01/01;"
testCase[10] = "JD=2415385.5;Date=1901/01/01;"
testCase[11] = "JD=2451544.5;Date=2000/01/01;"
testCase[12] = "JD=2451604.5;Date=2000/03/01;"
testCase[13] = "JD=2451910.5;Date=2001/01/01;"
testCase[14] = "JD=2451969.5;Date=2001/03/01;"
testCase[15] = "JD=2456788.5;Date=2014/05/11;"
testCase[16] = "JD=2457023.5;Date=2015/01/01;"
testCase[17] = "JD=2457181.5;Date=2015/06/08;"
testCase[18] = "JD=2457424.5;Date=2016/02/06;"
testCase[19] = "JD=2457547.5;Date=2016/06/08;"
testCase[20] = "JD=2457790.5;Date=2017/02/06;"
testCase[21] = "JD=2457912.5;Date=2017/06/08;"
testCase[22] = "JD=2488069.5;Date=2100/01/01;"
testCase[23] = "JD=2488434.5;Date=2101/01/01;"
testCase[24] = "JD=2567889.5;Date=2318/07/18;"
testCase[25] = "JD=2889835.5;Date=3200/01/01;"
testCase[26] = "JD=2999999.5;Date=3501/08/15;"
testCase[27] = "JD=3029645.5;Date=3582/10/15;"
testCase[28] = "JD=3145505.5;Date=3900/01/01;"
testCase[29] = "JD=3145870.5;Date=3901/01/01;"
testCase[30] = "JD=3456788.5;Date=4752/04/07;"
testCase[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()
Clock_JDToDate()
TextWindow.WriteLine("JDtoDate("+jd+")=" + date)
Clock_DateToJD()
TextWindow.WriteLine("DateToJD("+date+")=" + jd)
EndWhile
EndSub

Sub UnitTest
n = Array.GetItemCount(testCase)
For i = 1 To n
jd = testCase[i]["JD"]
Clock_JDToDate()
failure = "False"
If date = testCase[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 = testCase[i]["Date"]
Clock_DateToJD()
If jd = testCase[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 Clock_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 Clock_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

Sub Clock_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 Clock_JDNow
jd = Clock.ElapsedMilliseconds / 1000 / 3600 / 24 + 2415020.5
EndSub