有谁知道农历的计算方法以及与公历的互换算法？

http://www.cn-doc.cn/_soft_delphi_tech_doc/2005_08_18_01/20050818012901338.htm
自己看去吧

这种东西网上一搜一大把。给楼主帖个unit calfunc;interfaceuses SysUtils,Windows;const
  START_YEAR=1901;
  END_YEAR=2050;//返回iYear年iMonth月的天数 1年1月 --- 65535年12月
function MonthDays(iYear,iMonth:Word):Word;//返回阴历iLunarYer年阴历iLunarMonth月的天数，如果iLunarMonth为闰月，
//高字为第二个iLunarMonth月的天数，否则高字为0  1901年1月---2050年12月
function LunarMonthDays(iLunarYear,iLunarMonth:Word):Longword;//返回阴历iLunarYear年的总天数 1901年1月---2050年12月
function LunarYearDays(iLunarYear:Word):Word;//返回阴历iLunarYear年的闰月月份，如没有返回0  1901年1月---2050年12月
function GetLeapMonth(iLunarYear:Word):Word;//把iYear年格式化成天干记年法表示的字符串
procedure FormatLunarYear(iYear:Word;var pBuffer:string);overload;
function FormatLunarYear(iYear:Word):string;overload;//把iMonth格式化成中文字符串
procedure FormatMonth(iMonth:Word;var pBuffer:string;bLunar:Boolean=True);overload;
function FormatMonth(iMonth:Word;bLunar:Boolean=True):string;overload;//把iDay格式化成中文字符串
procedure FormatLunarDay(iDay:Word;var pBuffer:string);overload;
function FormatLunarDay(iDay:Word):string;overload;//计算公历两个日期间相差的天数  1年1月1日 --- 65535年12月31日
function CalcDateDiff(iEndYear,iEndMonth,iEndDay:Word;iStartYear:Word=START_YEAR;iStartMonth:Word=1;iStartDay:Word=1):Longword;overload;
function CalcDateDiff(EndDate,StartDate:TDateTime):Longword;overload;//计算公历iYear年iMonth月iDay日对应的阴历日期,返回对应的阴历节气 0-24
//1901年1月1日---2050年12月31日function GetLunarHolDay(InDate:TDateTime):string;overload;
function GetLunarHolDay(iYear,iMonth,iDay:Word):string;overload;//private function--------------------------------------//计算从1901年1月1日过iSpanDays天后的阴历日期
procedure l_CalcLunarDate(var iYear,iMonth,iDay:Word;iSpanDays:Longword);//计算公历iYear年iMonth月iDay日对应的节气 0-24，0表不是节气
function l_GetLunarHolDay(iYear,iMonth,iDay:Word):Word;implementation

SQL数据库：
CREATE  TABLE  SolarData
(
       yearId  int  not  null,
       data  char(7)  not  null,
       dataInt  int  not  null
)

--插入数据
INSERT  INTO
SolarData  SELECT  1900,'0x04bd8',19416  UNION  ALL  SELECT  1901,'0x04ae0',19168
UNION  ALL  SELECT  1902,'0x0a570',42352  UNION  ALL  SELECT  1903,'0x054d5',21717
UNION  ALL  SELECT  1904,'0x0d260',53856  UNION  ALL  SELECT  1905,'0x0d950',55632
UNION  ALL  SELECT  1906,'0x16554',91476  UNION  ALL  SELECT  1907,'0x056a0',22176
UNION  ALL  SELECT  1908,'0x09ad0',39632  UNION  ALL  SELECT  1909,'0x055d2',21970
UNION  ALL  SELECT  1910,'0x04ae0',19168  UNION  ALL  SELECT  1911,'0x0a5b6',42422
UNION  ALL  SELECT  1912,'0x0a4d0',42192  UNION  ALL  SELECT  1913,'0x0d250',53840
UNION  ALL  SELECT  1914,'0x1d255',119381  UNION  ALL  SELECT  1915,'0x0b540',46400
UNION  ALL  SELECT  1916,'0x0d6a0',54944  UNION  ALL  SELECT  1917,'0x0ada2',44450
UNION  ALL  SELECT  1918,'0x095b0',38320  UNION  ALL  SELECT  1919,'0x14977',84343
UNION  ALL  SELECT  1920,'0x04970',18800  UNION  ALL  SELECT  1921,'0x0a4b0',42160
UNION  ALL  SELECT  1922,'0x0b4b5',46261  UNION  ALL  SELECT  1923,'0x06a50',27216
UNION  ALL  SELECT  1924,'0x06d40',27968  UNION  ALL  SELECT  1925,'0x1ab54',109396
UNION  ALL  SELECT  1926,'0x02b60',11104  UNION  ALL  SELECT  1927,'0x09570',38256
UNION  ALL  SELECT  1928,'0x052f2',21234  UNION  ALL  SELECT  1929,'0x04970',18800
UNION  ALL  SELECT  1930,'0x06566',25958  UNION  ALL  SELECT  1931,'0x0d4a0',54432
UNION  ALL  SELECT  1932,'0x0ea50',59984  UNION  ALL  SELECT  1933,'0x06e95',28309
UNION  ALL  SELECT  1934,'0x05ad0',23248  UNION  ALL  SELECT  1935,'0x02b60',11104
UNION  ALL  SELECT  1936,'0x186e3',100067  UNION  ALL  SELECT  1937,'0x092e0',37600
UNION  ALL  SELECT  1938,'0x1c8d7',116951  UNION  ALL  SELECT  1939,'0x0c950',51536
UNION  ALL  SELECT  1940,'0x0d4a0',54432  UNION  ALL  SELECT  1941,'0x1d8a6',120998
UNION  ALL  SELECT  1942,'0x0b550',46416  UNION  ALL  SELECT  1943,'0x056a0',22176
UNION  ALL  SELECT  1944,'0x1a5b4',107956  UNION  ALL  SELECT  1945,'0x025d0',9680
UNION  ALL  SELECT  1946,'0x092d0',37584  UNION  ALL  SELECT  1947,'0x0d2b2',53938
UNION  ALL  SELECT  1948,'0x0a950',43344  UNION  ALL  SELECT  1949,'0x0b557',46423
UNION  ALL  SELECT  1950,'0x06ca0',27808  UNION  ALL  SELECT  1951,'0x0b550',46416
UNION  ALL  SELECT  1952,'0x15355',86869  UNION  ALL  SELECT  1953,'0x04da0',19872
UNION  ALL  SELECT  1954,'0x0a5d0',42448  UNION  ALL  SELECT  1955,'0x14573',83315
UNION  ALL  SELECT  1956,'0x052d0',21200  UNION  ALL  SELECT  1957,'0x0a9a8',43432
UNION  ALL  SELECT  1958,'0x0e950',59728  UNION  ALL  SELECT  1959,'0x06aa0',27296
UNION  ALL  SELECT  1960,'0x0aea6',44710  UNION  ALL  SELECT  1961,'0x0ab50',43856
UNION  ALL  SELECT  1962,'0x04b60',19296  UNION  ALL  SELECT  1963,'0x0aae4',43748
UNION  ALL  SELECT  1964,'0x0a570',42352  UNION  ALL  SELECT  1965,'0x05260',21088
UNION  ALL  SELECT  1966,'0x0f263',62051  UNION  ALL  SELECT  1967,'0x0d950',55632
UNION  ALL  SELECT  1968,'0x05b57',23383  UNION  ALL  SELECT  1969,'0x056a0',22176
UNION  ALL  SELECT  1970,'0x096d0',38608  UNION  ALL  SELECT  1971,'0x04dd5',19925
UNION  ALL  SELECT  1972,'0x04ad0',19152  UNION  ALL  SELECT  1973,'0x0a4d0',42192
UNION  ALL  SELECT  1974,'0x0d4d4',54484  UNION  ALL  SELECT  1975,'0x0d250',53840
UNION  ALL  SELECT  1976,'0x0d558',54616  UNION  ALL  SELECT  1977,'0x0b540',46400
UNION  ALL  SELECT  1978,'0x0b5a0',46496  UNION  ALL  SELECT  1979,'0x195a6',103846
UNION  ALL  SELECT  1980,'0x095b0',38320  UNION  ALL  SELECT  1981,'0x049b0',18864
UNION  ALL  SELECT  1982,'0x0a974',43380  UNION  ALL  SELECT  1983,'0x0a4b0',42160
UNION  ALL  SELECT  1984,'0x0b27a',45690  UNION  ALL  SELECT  1985,'0x06a50',27216
UNION  ALL  SELECT  1986,'0x06d40',27968  UNION  ALL  SELECT  1987,'0x0af46',44870
UNION  ALL  SELECT  1988,'0x0ab60',43872  UNION  ALL  SELECT  1989,'0x09570',38256
UNION  ALL  SELECT  1990,'0x04af5',19189  UNION  ALL  SELECT  1991,'0x04970',18800
UNION  ALL  SELECT  1992,'0x064b0',25776  UNION  ALL  SELECT  1993,'0x074a3',29859
UNION  ALL  SELECT  1994,'0x0ea50',59984  UNION  ALL  SELECT  1995,'0x06b58',27480
UNION  ALL  SELECT  1996,'0x055c0',21952  UNION  ALL  SELECT  1997,'0x0ab60',43872
UNION  ALL  SELECT  1998,'0x096d5',38613  UNION  ALL  SELECT  1999,'0x092e0',37600
UNION  ALL  SELECT  2000,'0x0c960',51552  UNION  ALL  SELECT  2001,'0x0d954',55636
UNION  ALL  SELECT  2002,'0x0d4a0',54432  UNION  ALL  SELECT  2003,'0x0da50',55888
UNION  ALL  SELECT  2004,'0x07552',30034  UNION  ALL  SELECT  2005,'0x056a0',22176
UNION  ALL  SELECT  2006,'0x0abb7',43959  UNION  ALL  SELECT  2007,'0x025d0',9680
UNION  ALL  SELECT  2008,'0x092d0',37584  UNION  ALL  SELECT  2009,'0x0cab5',51893
UNION  ALL  SELECT  2010,'0x0a950',43344  UNION  ALL  SELECT  2011,'0x0b4a0',46240
UNION  ALL  SELECT  2012,'0x0baa4',47780  UNION  ALL  SELECT  2013,'0x0ad50',44368
UNION  ALL  SELECT  2014,'0x055d9',21977  UNION  ALL  SELECT  2015,'0x04ba0',19360
UNION  ALL  SELECT  2016,'0x0a5b0',42416  UNION  ALL  SELECT  2017,'0x15176',86390
UNION  ALL  SELECT  2018,'0x052b0',21168  UNION  ALL  SELECT  2019,'0x0a930',43312
UNION  ALL  SELECT  2020,'0x07954',31060  UNION  ALL  SELECT  2021,'0x06aa0',27296
UNION  ALL  SELECT  2022,'0x0ad50',44368  UNION  ALL  SELECT  2023,'0x05b52',23378
UNION  ALL  SELECT  2024,'0x04b60',19296  UNION  ALL  SELECT  2025,'0x0a6e6',42726
UNION  ALL  SELECT  2026,'0x0a4e0',42208  UNION  ALL  SELECT  2027,'0x0d260',53856
UNION  ALL  SELECT  2028,'0x0ea65',60005  UNION  ALL  SELECT  2029,'0x0d530',54576
UNION  ALL  SELECT  2030,'0x05aa0',23200  UNION  ALL  SELECT  2031,'0x076a3',30371
UNION  ALL  SELECT  2032,'0x096d0',38608  UNION  ALL  SELECT  2033,'0x04bd7',19415
UNION  ALL  SELECT  2034,'0x04ad0',19152  UNION  ALL  SELECT  2035,'0x0a4d0',42192
UNION  ALL  SELECT  2036,'0x1d0b6',118966  UNION  ALL  SELECT  2037,'0x0d250',53840
UNION  ALL  SELECT  2038,'0x0d520',54560  UNION  ALL  SELECT  2039,'0x0dd45',56645
UNION  ALL  SELECT  2040,'0x0b5a0',46496  UNION  ALL  SELECT  2041,'0x056d0',22224
UNION  ALL  SELECT  2042,'0x055b2',21938  UNION  ALL  SELECT  2043,'0x049b0',18864
UNION  ALL  SELECT  2044,'0x0a577',42359  UNION  ALL  SELECT  2045,'0x0a4b0',42160
UNION  ALL  SELECT  2046,'0x0aa50',43600  UNION  ALL  SELECT  2047,'0x1b255',111189
UNION  ALL  SELECT  2048,'0x06d20',27936  UNION  ALL  SELECT  2049,'0x0ada0',44448

--===============================================================--然后就可以用这个函数来取农历日期了
GO
CREATE  FUNCTION  fn_GetLunar(@solarDay  DATETIME)
RETURNS  datetime

AS
BEGIN
   DECLARE  @solData  int
   DECLARE  @offset  int
   DECLARE  @iLunar  int
   DECLARE  @i  INT
   DECLARE  @j  INT
   DECLARE  @yDays  int
   DECLARE  @mDays  int
   DECLARE  @mLeap  int
   DECLARE  @mLeapNum  int
   DECLARE  @bLeap  smallint
   DECLARE  @temp  int

   DECLARE  @YEAR  INT
   DECLARE  @MONTH  INT
   DECLARE  @DAY  INT

   DECLARE  @OUTPUTDATE  DATETIME

   --保证传进来的日期是不带时间
   SET  @solarDay=cast(@solarDay  AS  char(10))
   SET  @offset=CAST(@solarDay-'1900-01-30'  AS  INT)


   --确定农历年开始
   SET  @i=1900
   --SET  @offset=@solData
   WHILE  @i<2050  AND  @offset>0
   BEGIN
       SET  @yDays=348
       SET  @mLeapNum=0
       SELECT  @iLunar=dataInt  FROM  SolarData  WHERE  yearId=@i

       --传回农历年的总天数
       SET  @j=32768
       WHILE  @j>8
       BEGIN
           IF  @iLunar  &  @j  >0
               SET  @yDays=@yDays+1
           SET  @j=@j/2
       END

       --传回农历年闰哪个月  1-12  ,  没闰传回  0
       SET  @mLeap  =  @iLunar  &  15

       --传回农历年闰月的天数  ,加在年的总天数上
       IF  @mLeap  >  0
       BEGIN
           IF  @iLunar  &  65536  >  0
               SET  @mLeapNum=30
           ELSE
               SET  @mLeapNum=29

           SET  @yDays=@yDays+@mLeapNum
       END

       SET  @offset=@offset-@yDays
       SET  @i=@i+1
   END

   IF  @offset  <=  0
   BEGIN
       SET  @offset=@offset+@yDays
       SET  @i=@i-1
   END
   --确定农历年结束
   SET  @YEAR=@i

   --确定农历月开始
   SET  @i  =  1
   SELECT  @iLunar=dataInt  FROM  SolarData  WHERE  yearId=@YEAR

   --判断那个月是润月
   SET  @mLeap  =  @iLunar  &  15
   SET  @bLeap  =  0

   WHILE  @i  <  13  AND  @offset  >  0
   BEGIN
       --判断润月
       SET  @mDays=0
       IF  (@mLeap  >  0  AND  @i  =  (@mLeap+1)  AND  @bLeap=0)
       BEGIN--是润月
           SET  @i=@i-1
           SET  @bLeap=1
           --传回农历年闰月的天数
           IF  @iLunar  &  65536  >  0
               SET  @mDays  =  30
           ELSE
               SET  @mDays  =  29
       END
       ELSE
       --不是润月
       BEGIN
           SET  @j=1
           SET  @temp  =  65536
           WHILE  @j<=@i
           BEGIN
               SET  @temp=@temp/2
               SET  @j=@j+1
           END

           IF  @iLunar  &  @temp  >  0
               SET  @mDays  =  30
           ELSE
               SET  @mDays  =  29
       END

       --解除闰月
       IF  @bLeap=1  AND  @i=  (@mLeap+1)
           SET  @bLeap=0

       SET  @offset=@offset-@mDays
       SET  @i=@i+1
   END

   IF  @offset  <=  0
   BEGIN
       SET  @offset=@offset+@mDays
       SET  @i=@i-1
   END

   --确定农历月结束
   SET  @MONTH=@i

   --确定农历日结束
   SET  @DAY=@offset

   SET  @OUTPUTDATE=CAST((CAST(@YEAR  AS  VARCHAR(4))+'-'+CAST(@MONTH  AS  VARCHAR(2))+'-'+CAST(@DAY  AS  VARCHAR(2)))  AS  DATETIME)
   RETURN  @OUTPUTDATE
END

GO
----------------------------------------------------------------------
--调用方法
select  dbo.fn_GetLunar(getdate())

var
//数组gLunarDay存入阴历1901年到2100年每年中的月天数信息，
//阴历每月只能是29或30天，一年用12（或13）个二进制位表示，对应位为1表30天，否则为29天
  gLunarMonthDay:array[0..149] of Word=(
    //测试数据只有1901.1.1 --2050.12.31
    $4ae0, $a570, $5268, $d260, $d950, $6aa8, $56a0, $9ad0, $4ae8, $4ae0,   //1910
    $a4d8, $a4d0, $d250, $d548, $b550, $56a0, $96d0, $95b0, $49b8, $49b0,   //1920
    $a4b0, $b258, $6a50, $6d40, $ada8, $2b60, $9570, $4978, $4970, $64b0,   //1930
    $d4a0, $ea50, $6d48, $5ad0, $2b60, $9370, $92e0, $c968, $c950, $d4a0,   //1940
    $da50, $b550, $56a0, $aad8, $25d0, $92d0, $c958, $a950, $b4a8, $6ca0,   //1950
    $b550, $55a8, $4da0, $a5b0, $52b8, $52b0, $a950, $e950, $6aa0, $ad50,   //1960
    $ab50, $4b60, $a570, $a570, $5260, $e930, $d950, $5aa8, $56a0, $96d0,   //1970
    $4ae8, $4ad0, $a4d0, $d268, $d250, $d528, $b540, $b6a0, $96d0, $95b0,   //1980
    $49b0, $a4b8, $a4b0, $b258, $6a50, $6d40, $ada0, $ab60, $9370, $4978,   //1990
    $4970, $64b0, $6a50, $ea50, $6b28, $5ac0, $ab60, $9368, $92e0, $c960,   //2000
    $d4a8, $d4a0, $da50, $5aa8, $56a0, $aad8, $25d0, $92d0, $c958, $a950,   //2010
    $b4a0, $b550, $b550, $55a8, $4ba0, $a5b0, $52b8, $52b0, $a930, $74a8,   //2020
    $6aa0, $ad50, $4da8, $4b60, $9570, $a4e0, $d260, $e930, $d530, $5aa0,   //2030
    $6b50, $96d0, $4ae8, $4ad0, $a4d0, $d258, $d250, $d520, $daa0, $b5a0,   //2040
    $56d0, $4ad8, $49b0, $a4b8, $a4b0, $aa50, $b528, $6d20, $ada0, $55b0);  //2050//数组gLanarMonth存放阴历1901年到2050年闰月的月份，如没有则为0，每字节存两年
  gLunarMonth:array[0..74] of Byte=(
    $00, $50, $04, $00, $20,   //1910
    $60, $05, $00, $20, $70,   //1920
    $05, $00, $40, $02, $06,   //1930
    $00, $50, $03, $07, $00,   //1940
    $60, $04, $00, $20, $70,   //1950
    $05, $00, $30, $80, $06,   //1960
    $00, $40, $03, $07, $00,   //1970
    $50, $04, $08, $00, $60,   //1980
    $04, $0a, $00, $60, $05,   //1990
    $00, $30, $80, $05, $00,   //2000
    $40, $02, $07, $00, $50,   //2010
    $04, $09, $00, $60, $04,   //2020
    $00, $20, $60, $05, $00,   //2030
    $30, $b0, $06, $00, $50,   //2040
    $02, $07, $00, $50, $03);  //2050

调试易

有谁知道农历的计算方法以及与公历的互换算法？

解决方案 »