VB计算农历的算法

原创 2002年05月17日 17:11:00

'下面是一个关于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 String

    On 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 = False
   
    If 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 If
       
    Next
 
    md$ = "初一初二初三初四初五初六初七初八初九初十十一十二十三十四十五十六十七十八十九二十廿一廿二廿三廿四廿五廿六廿七廿八廿九三十"
    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

算法系列之二十:计算中国农历(二)

(接上篇)        所谓的“天文算法”,就是利用经典力学定律推导行星运转轨道,对任意时刻的行星位置进行精确计算,从而获得某种天文现象发生时的时间,比如日月合朔这一天文现象就是太阳和月亮的地心黄经...
  • orbit
  • orbit
  • 2013年07月15日 23:36
  • 21807

算法系列之二十:计算中国农历(一)

世界各国的日历都是以天为最小单位,但是关于年和月的算法却各不相同,大致可以分为三类: 阳历--以天文年作为日历的主要周期,例如:中国公历(格里历)阴历--以天文月作为日历的主要周期,例如:伊斯兰历阴阳...
  • orbit
  • orbit
  • 2013年07月01日 00:18
  • 54024

Android 农历日历算法

import java.text.ParseException; import java.text.SimpleDateFormat; import java.util.ArrayList; i...
  • rvncds
  • rvncds
  • 2014年08月18日 13:30
  • 2235

农历、节气、节日算法

[java] view plain copy /**   * @(#)Lunar.java 2008-4-5 2:06:22   */   package luoz...
  • qq_18944923
  • qq_18944923
  • 2016年09月21日 16:32
  • 811

中国农历算法java实现(转自Herong Yang)

/** * ChineseCalendarGB.java * Copyright (c) 1997-2002 by Dr. Herong Yang * 中国农历算法 - 实用于公历 1901 年至 2...
  • jeensung
  • jeensung
  • 2006年02月07日 19:35
  • 7813

关于C#的农历算法

 // 下面是一个关于C#的农历算法// 日期数据定义方法如下// 前12个字节代表1-12月为大月或是小月,1为大月30天,0为小月29天,// 第13位为闰月的情况,1为大月30天,0为小月29天...
  • cwwong
  • cwwong
  • 2007年06月12日 10:47
  • 419

常用函数集农历函数

常用函数集农历函数原来是vb代码,重新整理为VB.NET版的,并在VS2003中编译通过Imports System.MathPublic Class UCnCalendar    Private S...
  • 21aspnet
  • 21aspnet
  • 2004年11月04日 11:05
  • 3917

农历的算法

********************************************************************************************建一个类,类名为...
  • cdbqss1
  • cdbqss1
  • 2006年11月23日 01:30
  • 961

农历算法碉堡了

using System; using System.Collections.Generic; using System.Text; namespace calendar { clas...
  • yongyinmg
  • yongyinmg
  • 2013年03月14日 15:44
  • 1945

写日历的程序员,你必须弄懂的中国农历算法。

写日历的程序员,你必须弄懂的中国农历算法。 NANSHAN即时通讯,我们知道农历通过置闰月的方式协调农历年和回归年长度不相等的问题,也知道了置闰的方法是“中气置闰”法,那么到底什么是“中气”,又是如...
  • i_like_cpp
  • i_like_cpp
  • 2013年07月02日 11:11
  • 1872
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:VB计算农历的算法
举报原因:
原因补充:

(最多只允许输入30个字)