有 VB 万年历源代码的人举手！

没别的意思！只是想研究一下而已！谢谢！

解决方案 »

  1.   

    用MonthView控件即可，不用写一行代码部件：Microsoft Windows Common Controls-2 6.0
      

  2.   

    一个关于VB的农历算法
    '日期数据定义方法如下
    '前12个字节代表1-12月为大月或是小月，1为大月30天，0为小月29天，
    '第13位为闰月的情况，1为大月30天，0为小月29天，第14位为闰月的月
    '份，如果不是闰月为0，否则给出月份，10、11、12分别用A、B、C来表
    '示，即使用16进制。最后4位为当年家农历新年-即农历1月1日所在公历
    '的日期，如0131代表1月31日。
    'GetYLDate函数使用方式如下tYear为要输入的年，tMonth为月，tDay为
    '日期，YLyear是返回值，返加农历的年份，如甲子年，YLShuXing返回
    '的是属象，如鼠。IsGetGl是设置是不是通过农历取公历值，如果是，
    '前三个返回相应的公历日期，而且返回值是一个公历日期。Function GetYLDate(tYear As Integer, tMonth As Integer, tDay As Integer, _
    YLyear As String, YLShuXing As String, _
    Optional IsGetGl As Boolean) As StringOn Error Resume Next
    Dim daList(1900 To 2011) As String * 18
    Dim conDate As Date, setDate As Date
    Dim AddMonth As Integer, AddDay As Integer, AddYear As Integer, getDay As Integer
    Dim RunYue As Boolean
    If tYear > 2010 Or tYear < 1901 Then Exit Function '如果不是有效有日期，退出
    '1900 to 1909
    daList(1900) = "010010110110180131"
    daList(1901) = "010010101110000219"
    daList(1902) = "101001010111000208"
    daList(1903) = "010100100110150129"
    daList(1904) = "110100100110000216"
    daList(1905) = "110110010101000204"
    daList(1906) = "011010101010140125"
    daList(1907) = "010101101010000213"
    daList(1908) = "100110101101000202"
    daList(1909) = "010010101110120122"
    daList(1910) = "010010101110000210"
    daList(1911) = "101001001101160130"
    daList(1912) = "101001001101000218"
    daList(1913) = "110100100101000206"
    daList(1914) = "110101010100150126"
    daList(1915) = "101101010101000214"
    daList(1916) = "010101101010000204"
    daList(1917) = "100101101101020123"
    daList(1918) = "100101011011000211"
    daList(1919) = "010010011011170201"
    daList(1920) = "010010011011000220"
    daList(1921) = "101001001011000208"
    daList(1922) = "101100100101150128"
    daList(1923) = "011010100101000216"
    daList(1924) = "011011010100000205"
    daList(1925) = "101011011010140124"
    daList(1926) = "001010110110000213"
    daList(1927) = "100101010111000202"
    daList(1928) = "010010010111120123"
    daList(1929) = "010010010111000210"
    daList(1930) = "011001001011060130"
    daList(1931) = "110101001010000217"
    daList(1932) = "111010100101000206"
    daList(1933) = "011011010100150126"
    daList(1934) = "010110101101000214"
    daList(1935) = "001010110110000204"
    daList(1936) = "100100110111030124"
    daList(1937) = "100100101110000211"
    daList(1938) = "110010010110170131"
    daList(1939) = "110010010101000219"
    daList(1940) = "110101001010000208"
    daList(1941) = "110110100101060127"
    daList(1942) = "101101010101000215"
    daList(1943) = "010101101010000205"
    daList(1944) = "101010101101140125"
    daList(1945) = "001001011101000213"
    daList(1946) = "100100101101000202"
    daList(1947) = "110010010101120122"
    daList(1948) = "101010010101000210"
    daList(1949) = "101101001010170129"
    daList(1950) = "011011001010000217"
    daList(1951) = "101101010101000206"
    daList(1952) = "010101011010150127"
    daList(1953) = "010011011010000214"
    daList(1954) = "101001011011000203"
    daList(1955) = "010100101011130124"
    daList(1956) = "010100101011000212"
    daList(1957) = "101010010101080131"
    daList(1958) = "111010010101000218"
    daList(1959) = "011010101010000208"
    daList(1960) = "101011010101060128"
    daList(1961) = "101010110101000215"
    daList(1962) = "010010110110000205"
    daList(1963) = "101001010111040125"
    daList(1964) = "101001010111000213"
    daList(1965) = "010100100110000202"
    daList(1966) = "111010010011030121"
    daList(1967) = "110110010101000209"
    daList(1968) = "010110101010170130"
    daList(1969) = "010101101010000217"
    daList(1970) = "100101101101000206"
    daList(1971) = "010010101110150127"
    daList(1972) = "010010101101000215"
    daList(1973) = "101001001101000203"
    daList(1974) = "110100100110140123"
    daList(1975) = "110100100101000211"
    daList(1976) = "110101010010180131"
    daList(1977) = "101101010100000218"
    daList(1978) = "101101101010000207"
    daList(1979) = "100101101101060128"
    daList(1980) = "100101011011000216"
    daList(1981) = "010010011011000205"
    daList(1982) = "101001001011140125"
    daList(1983) = "101001001011000213"
    daList(1984) = "1011001001011A0202"
    daList(1985) = "011010100101000220"
    daList(1986) = "011011010100000209"
    daList(1987) = "101011011010060129"
    daList(1988) = "101010110110000217"
    daList(1989) = "100100110111000206"
    daList(1990) = "010010010111150127"
    daList(1991) = "010010010111000215"
    daList(1992) = "011001001011000204"
    daList(1993) = "011010100101030123"
    daList(1994) = "111010100101000210"
    daList(1995) = "011010110010180131"
    daList(1996) = "010110101100000219"
    daList(1997) = "101010110110000207"
    daList(1998) = "100100110110150128"
    daList(1999) = "100100101110000216"
    daList(2000) = "110010010110000205"
    daList(2001) = "110101001010140124"
    daList(2002) = "110101001010000212"
    daList(2003) = "110110100101000201"
    daList(2004) = "010110101010120122"
    daList(2005) = "010101101010000209"
    daList(2006) = "101010101101170129"
    daList(2007) = "001001011101000218"
    daList(2008) = "100100101101000207"
    daList(2009) = "110010010101150126"
    daList(2010) = "101010010101000214"
    daList(2011) = "101101001010000214"
    AddYear = tYear
    RunYue = FalseIf IsGetGl Then
    AddMonth = Val(Mid(daList(AddYear), 15, 2))
    AddDay = Val(Mid(daList(AddYear), 17, 2))
    conDate = DateSerial(AddYear, AddMonth, AddDay)
    AddDay = tDay
    For i = 1 To tMonth - 1
    AddDay = AddDay + 29 + Val(Mid(daList(tYear), i, 1))
    Next i
    'MsgBox DateDiff("d", conDate, Date)
    setDate = DateAdd("d", AddDay - 1, conDate)
    GetYLDate = setDate
    tYear = Year(setDate)
    tMonth = Month(setDate)
    tDay = Day(setDate)
    Exit Function
    End If
    CHUSHIHUA:
    AddMonth = Val(Mid(daList(AddYear), 15, 2))
    AddDay = Val(Mid(daList(AddYear), 17, 2))
    conDate = DateSerial(AddYear, AddMonth, AddDay)
    setDate = DateSerial(tYear, tMonth, tDay)
    getDay = DateDiff("d", conDate, setDate)
    If getDay < 0 Then AddYear = AddYear - 1: GoTo CHUSHIHUA
    ' addday = NearDay
    AddDay = 1: AddMonth = 1
    For i = 1 To getDay
    AddDay = AddDay + 1
    If AddDay = 30 + Mid(daList(AddYear), AddMonth, 1) Or (RunYue And AddDay = 30 + Mid(daList(AddYear), 13, 1)) Then
    If RunYue = False And AddMonth = Val("&H" & Mid(daList(AddYear), 14, 1)) Then
    RunYue = True
    Else
    RunYue = False
    AddMonth = AddMonth + 1
    End If
    AddDay = 1
    End IfNextmd$ = "初一初二初三初四初五初六初七初八初九初十十一十二十三十四十五十六十七十八十九二十廿一廿二廿三廿四廿五廿六廿七廿八廿九三十"
    dd$ = Mid(md$, (AddDay - 1) * 2 + 1, 2)
    mm$ = Mid("正二三四五六七八九十寒腊", AddMonth, 1) + "月"
    YouGetDate = DateSerial(AddYear, AddMonth, AddDay)
    tiangan$ = "甲乙丙丁戊已庚辛壬癸"
    dizhi$ = "子丑寅卯辰巳午未申酉戌亥"
    Dim ganzhi(0 To 59) As String * 2
    For i = 0 To 59
    ganzhi(i) = Mid(tiangan$, (i Mod 10) + 1, 1) + Mid(dizhi$, (i Mod 12) + 1, 1)
    'ff$ = ff$ + ganzhi(i)
    Next i
    'MsgBox ff$, , Len(ff$)
    YLyear = ganzhi((AddYear - 4) Mod 60)
    shu$ = "鼠牛虎兔龙蛇马羊猴鸡狗猪"
    YLShuXing = Mid(shu$, ((AddYear - 4) Mod 12) + 1, 1)
    If RunYue Then mm$ = "闰" + mm$GetYLDate = mm$ + dd$End Function
      

  3.   

    还有一个:
    Option Explicit 
    Dim WeekName(7), MonthAdd(11), NongliData(99), TianGan(9), DiZhi(11), ShuXia 
    ng(11), DayName(30), MonName(12) 
    Dim curTime, curYear, curMonth, curDay, curWeekday 
    Dim GongliStr, WeekdayStr, NongliStr, NongliDayStr 
    Dim i, m, n, k, isEnd, bit, TheDate 
    Private Sub Form_Load() 
    '获取当前系统时间 
    curTime = Now() 
    '星期名 
    WeekName(0) = " * " 
    WeekName(1) = "星期日" 
    WeekName(2) = "星期一" 
    WeekName(3) = "星期二" 
    WeekName(4) = "星期三" 
    WeekName(5) = "星期四" 
    WeekName(6) = "星期五" 
    WeekName(7) = "星期六" 
    '天干名称 
    TianGan(0) = "甲" 
    TianGan(1) = "乙" 
    TianGan(2) = "丙" 
    TianGan(3) = "丁" 
    TianGan(4) = "戊" 
    TianGan(5) = "己" 
    TianGan(6) = "庚" 
    TianGan(7) = "辛" 
    TianGan(8) = "壬" 
    TianGan(9) = "癸" 
    '地支名称 
    DiZhi(0) = "子" 
    DiZhi(1) = "丑" 
    DiZhi(2) = "寅" 
    DiZhi(3) = "卯" 
    DiZhi(4) = "辰" 
    DiZhi(5) = "巳" 
    DiZhi(6) = "午" 
    DiZhi(7) = "未" 
    DiZhi(8) = "申" 
    DiZhi(9) = "酉" 
    DiZhi(10) = "戌" 
    DiZhi(11) = "亥" 
    '属相名称 
    ShuXiang(0) = "鼠" 
    ShuXiang(1) = "牛" 
    ShuXiang(2) = "虎" 
    ShuXiang(3) = "兔" 
    ShuXiang(4) = "龙" 
    ShuXiang(5) = "蛇" 
    ShuXiang(6) = "马" 
    ShuXiang(7) = "羊" 
    ShuXiang(8) = "猴" 
    ShuXiang(9) = "鸡" 
    ShuXiang(10) = "狗" 
    ShuXiang(11) = "猪" 
    '农历日期名 
    DayName(0) = "*" 
    DayName(1) = "初一" 
    DayName(2) = "初二" 
    DayName(3) = "初三" 
    DayName(4) = "初四" 
    DayName(5) = "初五" 
    DayName(6) = "初六" 
    DayName(7) = "初七" 
    DayName(8) = "初八" 
    DayName(9) = "初九" 
    DayName(10) = "初十" 
    DayName(11) = "十一" 
    DayName(12) = "十二" 
    DayName(13) = "十三" 
    DayName(14) = "十四" 
    DayName(15) = "十五" 
    DayName(16) = "十六" 
    DayName(17) = "十七" 
    DayName(18) = "十八" 
    DayName(19) = "十九" 
    DayName(20) = "二十" 
    DayName(21) = "廿一" 
    DayName(22) = "廿二" 
    DayName(23) = "廿三" 
    DayName(24) = "廿四" 
    DayName(25) = "廿五" 
    DayName(26) = "廿六" 
    DayName(27) = "廿七" 
    DayName(28) = "廿八" 
    DayName(29) = "廿九" 
    DayName(30) = "三十" 
    '农历月份名 
    MonName(0) = "*" 
    MonName(1) = "正" 
    MonName(2) = "二" 
    MonName(3) = "三" 
    MonName(4) = "四" 
    MonName(5) = "五" 
    MonName(6) = "六" 
    MonName(7) = "七" 
    MonName(8) = "八" 
    MonName(9) = "九" 
    MonName(10) = "十" 
    MonName(11) = "十一" 
    MonName(12) = "腊" 
    '公历每月前面的天数 
    MonthAdd(0) = 0 
    MonthAdd(1) = 31 
    MonthAdd(2) = 59 
    MonthAdd(3) = 90 
    MonthAdd(4) = 120 
    MonthAdd(5) = 151 
    MonthAdd(6) = 181 
    MonthAdd(7) = 212 
    MonthAdd(8) = 243 
    MonthAdd(9) = 273 
    MonthAdd(10) = 304 
    MonthAdd(11) = 334 
    '农历数据 
    NongliData(0) = 2635 
    NongliData(1) = 333387 
    NongliData(2) = 1701 
    NongliData(3) = 1748 
    NongliData(4) = 267701 
    NongliData(5) = 694 
    NongliData(6) = 2391 
    NongliData(7) = 133423 
    NongliData(8) = 1175 
    NongliData(9) = 396438 
    NongliData(10) = 3402 
    NongliData(11) = 3749 
    NongliData(12) = 331177 
    NongliData(13) = 1453 
    NongliData(14) = 694 
    NongliData(15) = 201326 
    NongliData(16) = 2350 
    NongliData(17) = 465197 
    NongliData(18) = 3221 
    NongliData(19) = 3402 
    NongliData(20) = 400202 
    NongliData(21) = 2901 
    NongliData(22) = 1386 
    NongliData(23) = 267611 
    NongliData(24) = 605 
    NongliData(25) = 2349 
    NongliData(26) = 137515 
    NongliData(27) = 2709 
    NongliData(28) = 464533 
    NongliData(29) = 1738 
    NongliData(30) = 2901 
    NongliData(31) = 330421 
    NongliData(32) = 1242 
    NongliData(33) = 2651 
    NongliData(34) = 199255 
    NongliData(35) = 1323 
    NongliData(36) = 529706 
    NongliData(37) = 3733 
    NongliData(38) = 1706 
    NongliData(39) = 398762 
    NongliData(40) = 2741 
    NongliData(41) = 1206 
    NongliData(42) = 267438 
    NongliData(43) = 2647 
    NongliData(44) = 1318 
    NongliData(45) = 204070 
    NongliData(46) = 3477 
    NongliData(47) = 461653 
    NongliData(48) = 1386 
    NongliData(49) = 2413 
    NongliData(50) = 330077 
    NongliData(51) = 1197 
    NongliData(52) = 2637 
    NongliData(53) = 268877 
    NongliData(54) = 3365 
    NongliData(55) = 531109 
    NongliData(56) = 2900 
    NongliData(57) = 2922 
    NongliData(58) = 398042 
    NongliData(59) = 2395 
    NongliData(60) = 1179 
    NongliData(61) = 267415 
    NongliData(62) = 2635 
    NongliData(63) = 661067 
    NongliData(64) = 1701 
    NongliData(65) = 1748 
    NongliData(66) = 398772 
    NongliData(67) = 2742 
    NongliData(68) = 2391 
    NongliData(69) = 330031 
    NongliData(70) = 1175 
    NongliData(71) = 1611 
    NongliData(72) = 200010 
    NongliData(73) = 3749 
    NongliData(74) = 527717 
    NongliData(75) = 1452 
    NongliData(76) = 2742 
    NongliData(77) = 332397 
    NongliData(78) = 2350 
    NongliData(79) = 3222 
    NongliData(80) = 268949 
    NongliData(81) = 3402 
    NongliData(82) = 3493 
    NongliData(83) = 133973 
    NongliData(84) = 1386 
    NongliData(85) = 464219 
    NongliData(86) = 605 
    NongliData(87) = 2349 
    NongliData(88) = 334123 
    NongliData(89) = 2709 
    NongliData(90) = 2890 
    NongliData(91) = 267946 
    NongliData(92) = 2773 
    NongliData(93) = 592565 
    NongliData(94) = 1210 
    NongliData(95) = 2651 
    NongliData(96) = 395863 
    NongliData(97) = 1323 
    NongliData(98) = 2707 
    NongliData(99) = 265877 
    '生成当前公历年、月、日 ==> GongliStr 
    curYear = Year(curTime) 
    curMonth = Month(curTime) 
    curDay = Day(curTime) 
    GongliStr = curYear & "年" 
    If (curMonth < 10) Then 
        GongliStr = GongliStr & "0" & curMonth & "月" 
    Else 
        GongliStr = GongliStr & curMonth & "月" 
    End If 
    If (curDay < 10) Then 
        GongliStr = GongliStr & "0" & curDay & "日" 
    Else 
        GongliStr = GongliStr & curDay & "日" 
    End If 
    '生成当前公历星期 ==> WeekdayStr 
    curWeekday = Weekday(curTime) 
    WeekdayStr = WeekName(curWeekday) 
    '计算到初始时间1921年2月8日的天数：1921-2-8(正月初一) 
    TheDate = (curYear - 1921) * 365 + Int((curYear - 1921) / 4) + curDay + Mont 
    hAdd(curMonth - 1) - 38 
    If ((curYear Mod 4) = 0 And curMonth > 2) Then 
        TheDate = TheDate + 1 
    End If 
    '计算农历天干、地支、月、日 
    isEnd = 0 
    m = 0 
    Do 
        If (NongliData(m) < 4095) Then 
            k = 11 
        Else 
            k = 12 
        End If 
        n = k 
        Do 
            If (n < 0) Then 
                Exit Do 
            End If 
        '获取NongliData(m)的第n个二进制位的值 
        bit = NongliData(m) 
        For i = 1 To n Step 1 
            bit = Int(bit / 2) 
        Next 
        bit = bit Mod 2 
        If (TheDate <= 29 + bit) Then 
            isEnd = 1 
            Exit Do 
        End If 
        TheDate = TheDate - 29 - bit 
        n = n - 1 
      Loop 
      If (isEnd = 1) Then 
          Exit Do 
      End If 
      m = m + 1 
    Loop 
    curYear = 1921 + m 
    curMonth = k - n + 1 
    curDay = TheDate 
    If (k = 12) Then 
        If (curMonth = (Int(NongliData(m) / 65536) + 1)) Then 
            curMonth = 1 - curMonth 
        ElseIf (curMonth > (Int(NongliData(m) / 65536) + 1)) Then 
            curMonth = curMonth - 1 
        End If 
    End If 
    '生成农历天干、地支、属相 ==> NongliStr 
    NongliStr = "农历" & TianGan(((curYear - 4) Mod 60) Mod 10) & DiZhi(((curYea 
    r - 4) Mod 60) Mod 12) & "年" 
    NongliStr = NongliStr & "(" & ShuXiang(((curYear - 4) Mod 60) Mod 12) & ")" 
    '生成农历月、日 ==> NongliDayStr 
    If (curMonth < 1) Then 
        NongliDayStr = "闰" & MonName(-1 * curMonth) 
    Else 
        NongliDayStr = MonName(curMonth) 
    End If 
    NongliDayStr = NongliDayStr & "月" 
    NongliDayStr = NongliDayStr & DayName(curDay) 
    MsgBox NongliStr & NongliDayStr 
    End Sub
      

  4.   

    luda!你真是个高手啊，我一直想编一个农历的万年历，但是我又有知道农历的历法。所以写不出算法。于是，我想建立一个万年历的数据库，但这样又太不值了。这下好了，先拿回去试试看，真的是很感谢啊！！！（我在编一个算命的软件，用的是正统的四柱预测学！）编出来了送一个给你！