如何实现阴阳历转换
想实现公历到农历的转换，区间为1990-2020之间但是，试了网上的N多代码，结果都不是很正确，与我在万年历上查询的日期都不符，据说微软也提供了相应的函数，听说也不是太灵光，请教各位好的办法或者代码可以实现么？谢谢
[解决办法]
http://www.developerfusion.com/tools/convert/vb-to-csharp/
[解决办法]
Imports System.Runtime.InteropServicesModule Module1 Sub Main() '用公历（阳历）初始化 Dim cc As New ChineseCalendar(DateTime.Today) '用农历（阴历）初始化，润五月（润月用True否则用False)，公历2009年7月8日 'Dim cc As New ChineseCalendar(2009, 5, 16, True) Console.WriteLine(cc.ChineseDateString()) ' Console.WriteLine(cc.ChineseTwentyFourDay()) Console.WriteLine(cc.AnimalString()) Console.WriteLine(cc.Constellation()) Console.WriteLine(cc.WeekDayStr()) Console.WriteLine(cc.GanZhiYearString()) Console.WriteLine(cc.DateString()) Console.WriteLine(cc.DateHoliday()) Console.WriteLine(cc.ChineseCalendarHoliday()) Console.WriteLine(cc.ChineseMonth()) Console.WriteLine(cc.ChineseDay()) End SubEnd Module
[解决办法]
是他代码没贴全.所以肯定不能运行了.
其实根据一楼及三楼的提示，一个完整的C#代码 加上一个在线代码转换的网站
就可以得到完整的代码了.
不要老是等别人给你现成的代码．自己动手才是王道.
[解决办法]
#Region "私有函数"#Region "GetChineseMonthDays" '传回农历 y年m月的总天数 Private Function GetChineseMonthDays(ByVal year As Integer, ByVal month As Integer) As Integer If BitTest32((LunarDateArray(year - MinYear) And &HFFFF), (16 - month)) Then Return 30 Else Return 29 End If End Function#End Region#Region "GetChineseLeapMonth" '传回农历 y年闰哪个月 1-12 , 没闰传回 0 Private Function GetChineseLeapMonth(ByVal year As Integer) As Integer Return LunarDateArray(year - MinYear) And &HF End Function#End Region#Region "GetChineseLeapMonthDays" '传回农历 y年闰月的天数 Private Function GetChineseLeapMonthDays(ByVal year As Integer) As Integer If GetChineseLeapMonth(year) <> 0 Then If (LunarDateArray(year - MinYear) And &H10000) <> 0 Then Return 30 Else Return 29 End If Else Return 0 End If End Function#End Region#Region "GetChineseYearDays" ''' <summary> ''' 取农历年一年的天数 ''' </summary> ''' <param name="year"></param> ''' <returns></returns> Private Function GetChineseYearDays(ByVal year As Integer) As Integer Dim i As Integer, f As Integer, sumDay As Integer, info As Integer sumDay = 348 '29天 X 12个月 i = &H8000 info = LunarDateArray(year - MinYear) And &HFFFF '计算12个月中有多少天为30天 For m As Integer = 0 To 11 f = info And i If f <> 0 Then sumDay += 1 End If i = i >> 1 Next Return sumDay + GetChineseLeapMonthDays(year) End Function#End Region#Region "CheckDateLimit" ''' <summary> ''' 检查公历日期是否符合要求 ''' </summary> ''' <param name="dt"></param> Private Sub CheckDateLimit(ByVal dt As DateTime) If (dt < MinDay) OrElse (dt > MaxDay) Then Throw New ChineseCalendarException("超出可转换的日期") End If End Sub#End Region#Region "CheckChineseDateLimit" ''' <summary> ''' 检查农历日期是否合理 ''' </summary> ''' <param name="year"></param> ''' <param name="month"></param> ''' <param name="day"></param> ''' <param name="leapMonth"></param> Private Sub CheckChineseDateLimit(ByVal year As Integer, ByVal month As Integer, ByVal day As Integer, ByVal leapMonth As Boolean) If (year < MinYear) OrElse (year > MaxYear) Then Throw New ChineseCalendarException("非法农历日期") End If If (month < 1) OrElse (month > 12) Then Throw New ChineseCalendarException("非法农历日期") End If If (day < 1) OrElse (day > 30) Then '中国的月最多30天 Throw New ChineseCalendarException("非法农历日期") End If Dim leap As Integer = GetChineseLeapMonth(year) ' 计算该年应该闰哪个月 If (leapMonth = True) AndAlso (month <> leap) Then Throw New ChineseCalendarException("非法农历日期") End If End Sub#End Region#Region "ConvertNumToChineseNum" ''' <summary> ''' 将0-9转成汉字形式 ''' </summary> ''' <param name="n"></param> ''' <returns></returns> Private Function ConvertNumToChineseNum(ByVal n As Char) As String If (n < "0"c) OrElse (n > "9"c) Then Return "" End If Select Case n Case "0"c Return HZNum(0).ToString() Case "1"c Return HZNum(1).ToString() Case "2"c Return HZNum(2).ToString() Case "3"c Return HZNum(3).ToString() Case "4"c Return HZNum(4).ToString() Case "5"c Return HZNum(5).ToString() Case "6"c Return HZNum(6).ToString() Case "7"c Return HZNum(7).ToString() Case "8"c Return HZNum(8).ToString() Case "9"c Return HZNum(9).ToString() Case Else Return "" End Select End Function#End Region#Region "BitTest32" ''' <summary> ''' 测试某位是否为真 ''' </summary> ''' <param name="num"></param> ''' <param name="bitpostion"></param> ''' <returns></returns> Private Function BitTest32(ByVal num As Integer, ByVal bitpostion As Integer) As Boolean If (bitpostion > 31) OrElse (bitpostion < 0) Then Throw New Exception("Error Param: bitpostion[0-31]:" & bitpostion.ToString()) End If Dim bit As Integer = 1 << bitpostion If (num And bit) = 0 Then Return False Else Return True End If End Function#End Region#Region "ConvertDayOfWeek" ''' <summary> ''' 将星期几转成数字表示 ''' </summary> ''' <param name="dayOfWeek"></param> ''' <returns></returns> Private Function ConvertDayOfWeek(ByVal dayOfWeek As DayOfWeek) As Integer Select Case dayOfWeek Case DayOfWeek.Sunday Return 1 Case DayOfWeek.Monday Return 2 Case DayOfWeek.Tuesday Return 3 Case DayOfWeek.Wednesday Return 4 Case DayOfWeek.Thursday Return 5 Case DayOfWeek.Friday Return 6 Case DayOfWeek.Saturday Return 7 Case Else Return 0 End Select End Function#End Region#Region "CompareWeekDayHoliday" ''' <summary> ''' 比较当天是不是指定的第周几 ''' </summary> ''' <param name="date"></param> ''' <param name="month"></param> ''' <param name="week"></param> ''' <param name="day"></param> ''' <returns></returns> Private Function CompareWeekDayHoliday(ByVal [date] As DateTime, ByVal month As Integer, ByVal week As Integer, ByVal day As Integer) As Boolean Dim ret As Boolean = False If [date].Month = month Then '月份相同 If ConvertDayOfWeek([date].DayOfWeek) = day Then '星期几相同 Dim firstDay As New DateTime([date].Year, [date].Month, 1) '生成当月第一天 Dim i As Integer = ConvertDayOfWeek(firstDay.DayOfWeek) Dim firWeekDays As Integer = 7 - ConvertDayOfWeek(firstDay.DayOfWeek) + 1 '计算第一周剩余天数 If i > day Then If (week - 1) * 7 + day + firWeekDays = [date].Day Then ret = True End If Else If day + firWeekDays + (week - 2) * 7 = [date].Day Then ret = True End If End If End If End If Return ret End Function#End Region
[解决办法]
楼主,帖子只能连续发3次.代码我全部发完了,可以测试一下
[解决办法]
１楼给的C#代码是有两篇的，你把两篇C#代码合在一起.
再去３楼给的在线代码转换网站转换代码
你就可以看见楼上给出的N楼的代码了...．．．．
这篇C#的代码本身没有带太复杂的语法，一般的在线网站都可以转的过来.
[解决办法]
Imports System.LinqModule Module1 Sub Main() Dim d = New DateTime(2011, 11, 16) Dim s = ChineseCalendar.ToLunaDateString(d) Console.WriteLine("{0:yyyy-MM-dd} => {1}", d, s) End Sub Class ChineseCalendar Private Shared LunaData As Integer() = { &H16D28, &H7520, &HEA50, &H164A5, &H64B0, &HA9B0, &H15564, &H56A0, &HB590, &H17522, &H7520, &H1B256, _ &HB250, &HA4B0, &H14AB5, &H2AD0, &H56B0, &HB692, &HDA90, &H1D927, &HE920, &HD250, &H1A4D5, &HA560, _ &H2B60, &H15B54, &H6D40, &HEA90, &H1E922, &HE920, &HD266, &H52B0, &HA570, &H12D65, &HB5A0, &H6D40, _ &HEC93, &H7490, &H16937, &HA930, &H52B0, &HA5B6, &HAAD0, &H56A0, &H1B554, &HBA40, &HB490, &H1A932, _ &HA950, &H152D7, &H5360, &HAAD0, &H15AA5, &H5B20, &HDA50, &H1D4A3, &HD4A0, &HA958, &HA970, &H5560, _ &HAB56, &HAD50, &H6D20, &HEA54, &HEA50, &H64A0, &HC973, &HA9B0, &H155A7, &H56A0, &HB690, &H17525, _ &HB520, &HB250, &H164B4, &HA4B0, &H14AB8, &H2AD0, &H56D0, &HB696, &HDA90, &HD920, &H1D254, &HD250, _ &H1A4DA, &HA560, &H2B60, &H5B56, &H6D50, &HEA90, &H1E925, &HE920, &HD260, &HA563, &HA570, &H14D68, _ &H3AA0, &H6D50, &H16C95, &H7490, &H6930, &H152B4, &H52B0, &HA5B0, &H155A2, &H56A0, &H1B557, &HBA40, _ &HB490, &H1A935, &HA950, &H52D0, &HAAD4, &HAB50, &H15AA9, &H5D20, &HDA50, &H1D4A6, &HD4A0, &HC950, _ &H152E4, &H5560, &HAB50, &H15B22, &H6D20, &HEA56, &H7250, &H64B0, &HC975, &HCAB0, &H55A0, &HAD63, _ &HB690, &H17527, &HB520, &HB250, &H1A4B6, &HA4B0, &H4AB0, &H55B5, &H5AD0, &HB6A0, &H1B522, &HD920, _ &H1D257, &HD250, &HA550, &H14AD5, &H4B60, &H5B50, &HDAA3} Private Shared HanNum As String = "零一二三四五六七八九十" Public Shared Function ToLunaDateString([date] As DateTime) As String If ([date] < New DateTime(1900, 2, 1) Or [date] > New DateTime(2050, 1, 1)) Then _ Return "公历日期必须在1900/2/1到2050/1/1之间" Dim q = LunaData.SelectMany(Function(d, y) _ From m In Enumerable.Range(1, 12 + ((d And 15) + 14) \ 15) _ Let leap = d And 15 _ Select New With { _ Key .year = y + 1900, _ Key .month = If(m > leap And leap > 0, m - 1, m), _ Key .days = 29 + (d >> (m + 3) And 1), _ Key .isLeap = leap > 0 And m = leap + 1 _ }) Dim timespan = ([date] - New DateTime(1900, 1, 31)) Dim days As Integer = 0 Dim luna = q.First(Function(m) days += m.days Return days > timespan.Days End Function) days = timespan.Days - days + luna.days + 1 Dim y2cn As Func(Of Integer, String) = Function(y) New String(y.ToString.Select(Function(c) HanNum(Asc(c) - Asc("0"))).ToArray) Dim m2cn As Func(Of Integer, String) = Function(m) If(m > 1 And m < 11, HanNum(m), "正冬腊"((m - 1) Mod 9)) Dim d2cn As Func(Of Integer, String) = Function(d) If(d Mod 10 = 0, "初二三"((d - 1) \ 10), "初十廿卅"(d \ 10)) & HanNum((d - 1) Mod 10 + 1) Return String.Format("农历{0}年{1}月{2}", y2cn(luna.year), If(luna.isLeap, "闰", "") & m2cn(luna.month), d2cn(days)) End Function End ClassEnd Module
[解决办法]
'计算该月1日是星期几 Public Function GetXingQi(ByVal ac As Integer, ByVal bc As Integer) As Integer Dim C As Integer, Y As Integer, M As Integer, D As Integer, XX As Integer C = CInt(ac.ToString.Substring(0, 2)) Y = CInt(ac.ToString.Substring(2, 2)) M = bc D = 1 If M = 1 Then M = 13 If Y = 0 Then Y = 99 C = C - 1 Else Y = Y - 1 End If End If If M = 2 Then If Y = 0 Then Y = 99 C = C - 1 Else Y = Y - 1 End If M = 14 End If XX = (CInt(C / 4) - 2 * C + Y + CInt(Y / 4) + CInt(26 * (M + 1) / 10) + D - 1) Mod 7 Select Case XX Case 1, -6 GetXingQi = 1 Case 2, -5 GetXingQi = 2 Case 3, -4 GetXingQi = 3 Case 4, -3 GetXingQi = 4 Case 5, -2 GetXingQi = 5 Case 6, -1 GetXingQi = 6 Case 0 GetXingQi = 0 End Select End Function
[解决办法]
有一个泰勒公式：W=[C/4]-2C+Y+[Y/4]+[26（M+1）/10]+D-1
式中：W为所求日期的星期数。如果W大于（小于）7，就减去（加上）7的倍数，直到余数小于7为止。
C为公元年份的前两位数字，Y为后两位数字，M是月数，D是日数。
方括号[]表于对于括号内的数字取整。
特别注意的是：所求的月份如果是1月或2月，则应视为上一年的13月或14月，也就是公式中的M的
取值范围从3到14而不是从1到12。