Microsoft Small Basic

Program Listing: MTW971-0
' CAL - Calendar
' Copyright © 1986-2015 Nonki Takahashi. The MIT License.

' History:
' 0.5 2015-12-27 Rewrote for Small Basic Blog schedule. (MTW971-0)
' 0.4 2015-12-27 Supported quoter, removed Goto, bug fixed.
' 0.3 2012-07-28 Rewrote for Sundial. (123 lines, published as MTW971)
' 0.2 2011-05-03 Rewrote for Edo clock. (123 lines)
' 0.1 2010-02-08 Converted to Small Basic Program. (107 lines)
' 0.0 1986-??-?? Created as F-BASIC program.

' Reference:
' [1] H.SASAKI: IBM-JX 1st. step ペーパーソフトの楽しみ方 (学研, 1985)

' Main
GraphicsWindow.Title = "CAL - Calendar 0.5"
Not = "True=False;False=True;"
AMP = "&"
CRLF = Text.GetCharacter(13) + Text.GetCharacter(10)
LT = "<"
WQ = Text.GetCharacter(34)
Form()
Cal_Init()
buttonClicked = "False"
Controls.ButtonClicked = OnButtonClicked
While "True"
If buttonClicked Then
CheckInput()
If error Then
GraphicsWindow.ShowMessage(msg, "Error")
Else
doy = 0 ' days of year
nom = 1 ' number of month
buf = ""
For m = m0 To m1
While nom < m
doy = doy + dom[nom]
nom = nom + 1
EndWhile
If Controls.LastClickedButton = btnText Then
Cal_PrintMonth()
Else
Cal_HTMLMonth()
EndIf
EndFor
Controls.SetTextBoxText(tboxCal, buf)
EndIf
buttonClicked = "False"
EndIf
EndWhile
' Subroutines
Sub CheckInput
error = "False"
' check year
year = Controls.GetTextBoxText(tboxYear)
if year = "" Or year < 1 Then
msg = "Illeagal Year (" + year + ")"
error = "True"
Endif
If Not[error] Then
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.Floor((year - 1) / 4) - Math.Floor((year - 1) / 100) + Math.Floor((year - 1) / 400) ' number of leap year
woy = Math.Remainder((year + nol), 7) ' week of year
' check quoter
month = Controls.GetTextBoxText(tboxMonth)
If Text.StartsWith(Text.ConvertToLowerCase(month), "q") Then
quoter = Text.GetSubTextToEnd(month, 2)
m0 = (quoter - 1) * 3 + 1
m1 = (quoter - 1) * 3 + 3
ElseIf Controls.LastClickedButton = btnHTML Then
msg = "Enter Q1-Q4 for HTML"
error = "True"
Else
' check month
If month = "" Then
m0 = 1
m1 = 12
Else
If month < 1 Or month > 12 Then
msg = "Illeagal Month (" + month + ")"
error = "True"
EndIf
m0 = month
m1 = month
EndIf
EndIf
EndIf
EndSub
Sub Form
gw = 598
gh = 428
GraphicsWindow.Width = gw
GraphicsWindow.Height = gh
GraphicsWindow.BackgroundColor = "LightGray"
GraphicsWindow.BrushColor = "Black"
GraphicsWindow.DrawText(7, 9, "Year")
tboxYear = Controls.AddTextBox(56, 5)
Controls.SetSize(tboxYear, 50, 22)
GraphicsWindow.DrawText(7, 37, "Month")
tboxMonth = Controls.AddTextBox(56, 32)
Controls.SetSize(tboxMonth, 50, 22)
btnText = Controls.AddButton("Text", 120, 3)
btnHTML = Controls.AddButton("HTML", 170, 3)
GraphicsWindow.FontName = "Courier New"
tboxCal = Controls.AddMultiLineTextBox(5, 59)
Controls.SetSize(tboxCal, gw - 10, gh - 64)
EndSub
Sub OnButtonClicked
buttonClicked = "True"
EndSub
Sub Cal_HTMLMonth
' Calender | Print month
' param year - year
' param quoter - quoter
' param m - month
' param m0, m1 - start and end of quoter
' param doy - days of year
' param woy - week of year
If buf = "" Then
' header
buf = sp[8] + LT + "h1>" + LT + "a name="+ WQ + "Schedule_"
buf = buf + "Q" + quoter + "_" + Text.GetSubTextToEnd(year, 3)
buf = buf + WQ + ">" + LT + "/a>Next Schedule (" + name[m0]
buf = buf + "-" + name[m1] + " " + year + ")" + LT
buf = buf + "/h1>" + CRLF
buf = buf + sp[8] + LT + "p>All scheduled authors are subject "
buf = buf + "to change." + LT + "/p>" + CRLF
buf = buf + sp[8] + LT + "table width=" + WQ + "95%" + WQ
buf = buf + " line-height: 18.83px; margin-left: 1px;"
buf = buf + " border-collapse: collapse; border=" + WQ + "0" + WQ
buf = buf + " cellspacing=" + WQ + "0" + WQ
buf = buf + " cellpadding=" + WQ + "0" + WQ + ">" + CRLF
buf = buf + sp[12] + LT + "tbody>" + CRLF
buf = buf + sp[16] + LT + "tr>" + CRLF
buf = buf + sp[20] + LT + "td valign=" + WQ + "top" + WQ
buf = buf + " style=" + WQ + "padding: 0in 5.4pt; border: 1pt solid"
buf = buf + " windowtext; width: " + c1w + "pt; background-color:"
buf = buf + " silver;" + WQ + ">" + CRLF
buf = buf + sp[20] + LT + "strong>Dates:" + LT + "/strong>" + LT
buf = buf + "/td>" + CRLF
For i = 1 To 7
buf = buf + sp[20] + LT + "td valign=" + WQ + "top" + WQ
buf = buf + " style=" + WQ + "border-color: windowtext windowtext"
buf = buf + " windowtext silver; padding: 0in 5.4pt; width:"
buf = buf + " " + cw[Math.Remainder(i, 7)] + "pt;"
buf = buf + " border-top-width: 1pt; border-right-width: 1pt;"
buf = buf + " border-bottom-width: 1pt; border-top-style: solid;"
buf = buf + " border-right-style: solid; border-bottom-style:"
buf = buf + " solid; background-color: silver;" + WQ + ">" + CRLF
buf = buf + sp[20] + LT + "strong>" + week[Math.Remainder(i, 7)]
buf = buf + LT + "/strong>" + LT + "/td>" + CRLF
EndFor
buf = buf + sp[16] + LT + "/tr>" + CRLF
EndIf
w = Math.Remainder((doy + woy), 7)
d1 = Math.Remainder(8 - w, 7) + 1
For day = d1 To dom[m] Step 7
m2 = m
day2 = day + 6
If dom[m] < day2 Then
m2 = m + 1
If 12 < m2 Then
m2 = 1
EndIf
day2 = day2 - dom[m]
EndIf
buf = buf + sp[16] + LT + "tr>" + CRLF
buf = buf + sp[20] + LT + "td valign=" + WQ + "top" + WQ
buf = buf + " style=" + WQ + "border-color: silver windowtext"
buf = buf + " windowtext; padding: 0in 5.4pt; width: " + c1w + "pt;"
buf = buf + " border-right-width: 1pt; border-bottom-width: 1pt;"
buf = buf + " border-left-width: 1pt; border-right-style: solid;"
buf = buf + " border-bottom-style: solid; border-left-style:"
buf = buf + " solid;" + WQ + ">" + CRLF
buf = buf + sp[20] + m + "/" + day + " - " + m2 + "/" + day2
buf = buf + LT + "/td>" + CRLF
For i = 1 To 7
buf = buf + sp[20] + LT + "td valign=" + WQ + "top" + WQ
buf = buf + " style=" + WQ + "border-color: silver windowtext"
buf = buf + " windowtext silver; padding: 0in 5.4pt; width:"
buf = buf + " " + cw[Math.Remainder(i, 7)] + "pt;"
buf = buf + " border-right-width: 1pt; border-bottom-width: 1pt;"
buf = buf + " border-right-style: solid; border-bottom-style:"
buf = buf + " solid;" + WQ + ">" + CRLF
buf = buf + sp[20] + AMP + "nbsp;" + LT + "/td>" + CRLF
EndFor
buf = buf + sp[16] + LT + "/tr>" + CRLF
EndFor
If m = m1 Then
' footer
buf = buf + sp[12] + LT + "/tbody>" + CRLF
buf = buf + sp[8] + LT + "/table>" + CRLF
buf = buf + sp[8] + LT + "br>" + CRLF
EndIf
EndSub
Sub Cal_Init
' Calender | Initialize days of month
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;"
name = "1=January;2=February;3=March;4=April;5=May;6=June;7=July;"
name = name + "8=August;9=September;10=October;11=November;12=December;"
week = "0=Sunday;1=Monday;2=Tuesday;3=Wednesday;4=Thursday;5=Friday;"
week = week + "6=Saturday;"
c1w = 52
c1w = 58.8
' column width [pt] for days of week
cw = "1=80;2=71.85;3=82.2;4=80.8;5=88.05;6=70.15;0=53.3;"
cw = "1=44.35;2=48.3;3=61.05;4=46.8;5=37.05;6=49.8;0=40.8;"
For n = 8 To 20 Step 4
sp[n] = Text.GetSubText(" ", 1, n)
EndFor
EndSub
Sub Cal_PrintMonth
' Calender | Print month
' param year - year
' param m - month
' param doy - days of year
' param woy - week of year
w = Math.Remainder((doy + woy), 7)
buf = buf + " "
If year < 10 Then
buf = Text.Append(buf + " ", year)
ElseIf year < 100 Then
buf = Text.Append(buf + " ", year)
ElseIf year < 1000 Then
buf = Text.Append(buf + " ", year)
Else
buf = Text.Append(buf, year)
EndIf
buf = Text.Append(buf, " ")
If m < 10 Then
buf = Text.Append(buf + " ", m) + CRLF
Else
buf = Text.Append(buf, m) + CRLF
EndIf
buf = buf + CRLF
buf = buf + "SUN MON TUE WED THU FRI SAT" + CRLF
wom = 0
While wom < w
buf = buf + " "
wom = wom + 1
EndWhile
For day = 1 To dom[m]
If day < 10 Then
buf = buf + " " + day + " "
Else
buf = buf + " " + day + " "
EndIf
If Math.Remainder(wom, 7) = 6 Then
buf = buf + CRLF
EndIf
wom = wom + 1
EndFor
If Math.Remainder(wom, 7) > 0 Then
buf = buf + CRLF
EndIf
buf = buf + CRLF
EndSub