用vb编写万年历小程序

发布网友 发布时间：2022-04-29 04:23

我来回答

共1个回答

热心网友 时间：2022-05-19 02:28

用VB做万年历，非常关键点就是农历写法，参考代码如下：

#Region " 返回农历 "
'返回农历
'cCalendar.MaxSupportedDateTime 返回支持的最大日期，即2101-1-28
'cCalendar.MinSupportedDateTime 返回支持的最小日期，即190－2-19
Private cCalendar As New System.Globalization.ChineseLunisolarCalendar
Public Function PubFunGet_CNDate(ByVal sDateTime As Date) As String
cCalendar = New System.Globalization.ChineseLunisolarCalendar
Dim lyear As Integer = cCalendar.GetYear(sDateTime)
Dim lmonth As Integer = cCalendar.GetMonth(sDateTime)
Dim lday As Integer = cCalendar.GetDayOfMonth(sDateTime)
Dim lweek As Integer = cCalendar.GetDayOfWeek(sDateTime)

'获取闰月， 0 则表示没有闰月
Dim leapMonth As Integer = cCalendar.GetLeapMonth(lyear)
Dim isleap As Boolean = False

If (leapMonth > 0) Then
If (leapMonth = lmonth) Then
'闰月
isleap = True
lmonth = lmonth - 1
ElseIf (lmonth > leapMonth) Then
lmonth = lmonth - 1
End If
End If

Return String.Concat(GetLunisolarYear(lyear), IIf(isleap = True, "闰年", "年"), GetLunisolarMonth(lmonth), "月", GetLunisolarDay(lday))
End Function

'十天干
Private tiangan As String() = {"甲", "乙", "丙", "丁", "戊", "己", "庚", "辛", "壬", "癸"}
'十二地支
Private di As String() = {"子", "丑", "寅", "卯", "辰", "巳", "午", "未", "申", "酉", "戌", "亥"}
'十二生肖
Private shengxiao As String() = {"鼠", "牛", "虎", "免", "龙", "蛇", "马", "羊", "猴", "鸡", "狗", "猪"}
'农历月
Private months As String() = {"正", "二", "三", "四", "五", "六", "七", "八", "九", "十", "十一", "十二(腊)"}
'农历日
Private days1 As String() = {"初", "十", "廿", "三"}
Private days As String() = {"一", "二", "三", "四", "五", "六", "七", "八", "九", "十"}
'返回农历年（天干 地支 生肖）
Private Function GetLunisolarYear(ByVal year As Integer) As String
GetLunisolarYear = ""
If (year > 3) Then
Dim tgIndex As Integer = (year - 4) Mod 10
Dim dzIndex As Integer = (year - 4) Mod 12
Return tiangan(tgIndex) & di(dzIndex) & "[" & shengxiao(dzIndex) & "]"
End If
'无效的年份!
End Function

'返回生肖
Private Function GetShengXiao(ByVal sDateTime As Date) As String
Return shengxiao(cCalendar.GetTerrestrialBranch(cCalendar.GetSexagenaryYear(sDateTime)) - 1)
End Function

'返回农历月
Private Function GetLunisolarMonth(ByVal month As Integer) As String
GetLunisolarMonth = ""
If (month < 13 AndAlso month > 0) Then
Return months(month - 1)
End If
'无效的月份!
End Function

'返回农历日
Private Function GetLunisolarDay(ByVal day As Integer) As String
GetLunisolarDay = ""
If (day > 0 AndAlso day < 32) Then
If (day <> 20 AndAlso day <> 30) Then
Return String.Concat(days1((day - 1) \ 10), days((day - 1) Mod 10))
Else
Return String.Concat(days((day - 1) \ 10), days1(1))
End If
End If
'无效的日!
End Function
#End Region