討論 - 出題-寫萬年曆程式，不限語言

[wenneng]

如果將 NowDate = Date 改為 NowDate = DateSerial(某年, 某月, 某日) 會得到某年某月某日的月曆
以下是用VB寫的在表單載入的時候會在即時運算視窗印出月曆

Private Sub Form_Load()
   Dim NowDate As Date, L_Date As Date, N_Date As Date
   Dim NowYear As Integer, NowMonth As Integer, NowDay As Integer
   NowDate = Date '取得目前的日期資訊
   NowYear = year(NowDate)   '取出年份
   NowMonth = Month(NowDate) '取出月份
   NowDay = Day(NowDate)     '取出日
 
   L_Date = getLFirstDate(NowYear, NowMonth) '傳入目前的年月取得上個月的第一天
   N_Date = getNFirstDate(NowYear, NowMonth) '傳入目前的年月取得下個月的第一天
   Debug.Print CalendarTable(L_Date)                           '印出上個月的月曆
    Debug.Print CalendarTable(DateSerial(NowYear, NowMonth, 1)) '印出這個月的月曆
    Debug.Print CalendarTable(N_Date)                           '印出下個月的月曆
 
End Sub
 
Private Function CalendarTable(MonthFirstDay As Date) As String '產生月曆的表單
   Dim DayAmount As Integer, DayOfWeek As VbDayOfWeek
   Dim C_Year As Integer, C_Month As Integer, C_Day As Integer
   Dim i As Integer
   Dim TableBuff As String
   C_Year = year(MonthFirstDay)   '取得月曆年份
   C_Month = Month(MonthFirstDay) '取得月曆月份
   C_Day = 1 '設定起始日期為 1 日
   Rem 月曆表頭
   TableBuff = " ---------------------------- " & vbCrLf
   TableBuff = TableBuff & "|     西元 " & C_Year & " 年 "
   If C_Month < 10 Then TableBuff = TableBuff & " "
   TableBuff = TableBuff & C_Month & " 月     |" & vbCrLf
   TableBuff = TableBuff & " ---------------------------- " & vbCrLf
   TableBuff = TableBuff & "| 日  一  二  三  四  五  六 |" & vbCrLf
   TableBuff = TableBuff & " ---------------------------- " & vbCrLf
   TableBuff = TableBuff & "|"
 
   DayOfWeek = Weekday(MonthFirstDay) '取得此月第一天為星期幾
   Rem 填充上一月份的空白日期
   i = vbSunday
   While i < DayOfWeek
       TableBuff = TableBuff & "    "
       i = i + 1
   Wend
   DayAmount = getDayAmount(C_Year, C_Month) '取得此月份的日期數
   Rem 將表單填入全部日期
   While (C_Day <= DayAmount)
       If DayOfWeek = vbSunday Then TableBuff = TableBuff & "|" '每星期行的最前面加上 | 當外框
       If C_Day < 10 Then TableBuff = TableBuff & " "           '當日期小於10時最前面填充一個空白
       TableBuff = TableBuff & " " & C_Day & " "                '填入日期
       C_Day = C_Day + 1
       DayOfWeek = DayOfWeek + 1
       Rem 每星期行的結尾加上 | 當外框
       If DayOfWeek > vbSaturday Then
           DayOfWeek = vbSunday
           TableBuff = TableBuff & "|" & vbCrLf
       End If
   Wend
   Rem 填充下一月份的空白日期
   If DayOfWeek > vbSunday Then '當最後一天不為星期六時填充至星期六
       For i = DayOfWeek To vbSaturday
           TableBuff = TableBuff & "    "
       Next
       TableBuff = TableBuff & "|" & vbCrLf '加上最後的外框
   End If
   TableBuff = TableBuff & " ---------------------------- " & vbCrLf '加上底框
   Rem 回傳產生的表單
   CalendarTable = TableBuff
End Function
Private Function getLFirstDate(NowYear As Integer, NowMonth As Integer) As Date '取得上個月第一天的日期
   Dim L_Year As Integer, L_Month As Integer
   L_Year = NowYear       '年份設為與這個月同年
   L_Month = NowMonth - 1 '月份設為這個月減一個月
   Rem 當月份為上一年的時候要調整月份為 12 月且年份要減 1
   If L_Month < 1 Then
       L_Month = 12
       L_Year = L_Year - 1
   End If
   getLFirstDate = DateSerial(L_Year, L_Month, 1)
End Function
Private Function getNFirstDate(NowYear As Integer, NowMonth As Integer) As Date '取得下個月第一天的日期
   Dim N_Year As Integer, N_Month As Integer
   N_Year = NowYear       '年份設為與這個月同年
   N_Month = NowMonth + 1 '月份設為這個月加一個月
   Rem 當月份為下一年的時候要調整月份為 1 月且年份要加 1
   If N_Month > 12 Then
       N_Month = 1
       N_Year = N_Year + 1
   End If
   getNFirstDate = DateSerial(N_Year, N_Month, 1)
End Function
Private Function getDayAmount(YearVal As Integer, MonthVal As Integer) As Integer '取得某年某月的天數
   If MonthVal = 2 Then
       getDayAmount = 28 + ((((YearVal Mod 4) = 0) And ((YearVal Mod 100) <> 0)) Or ((YearVal Mod 400) = 0) And &H1) '月份為 2 檢查是否為閏年並做調整
   Else
       getDayAmount = 30 + ((((MonthVal And &H1) = &H1) Xor (MonthVal > 7)) And &H1)                               '不為 2 月則天數在 7 月前奇數月為 31 天，在 7 月後偶數月為 31 天
   End If
End Function

輸出結果大概像下面那樣

---------------------------- 
|     西元 2007 年  1 月     |
 ---------------------------- 
| 日  一  二  三  四  五  六 |
 ---------------------------- 
|      1   2   3   4   5   6 |
|  7   8   9  10  11  12  13 |
| 14  15  16  17  18  19  20 |
| 21  22  23  24  25  26  27 |
| 28  29  30  31             |
 ---------------------------- 
---------------------------- 
|     西元 2007 年  2 月     |
 ---------------------------- 
| 日  一  二  三  四  五  六 |
 ---------------------------- 
|                  1   2   3 |
|  4   5   6   7   8   9  10 |
| 11  12  13  14  15  16  17 |
| 18  19  20  21  22  23  24 |
| 25  26  27  28             |
 ---------------------------- 
---------------------------- 
|     西元 2007 年  3 月     |
 ---------------------------- 
| 日  一  二  三  四  五  六 |
 ---------------------------- 
|                  1   2   3 |
|  4   5   6   7   8   9  10 |
| 11  12  13  14  15  16  17 |
| 18  19  20  21  22  23  24 |
| 25  26  27  28  29  30  31 |
 ----------------------------