哪个兄弟知道日期公历转变为农历的算法？(76分)

如题。

大富翁上有的：http://www.delphibbs.com/delphibbs/dispq.asp?lid=1215040

//调用GetLunarHolDay就是了

unit uConcertdate;

interface

uses 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

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

//Êý×égLanarHoliDay´æ·ÅÿÄêµÄ¶þÊ®ËĽÚÆø¶ÔÓ¦µÄÑôÀúÈÕÆÚ
//ÿÄêµÄ¶þÊ®ËĽÚÆø¶ÔÓ¦µÄÑôÀúÈÕÆÚ¼¸ºõ¹Ì¶¨£¬Æ½¾ù·Ö²¼ÓÚÊ®¶þ¸öÔÂÖÐ
// 1ÔÂ 2ÔÂ 3ÔÂ 4ÔÂ 5ÔÂ 6ÔÂ
//Сº® ´óº® Á¢´º ÓêË® ¾ªÕÝ ´º·Ö ÇåÃ÷ ¹ÈÓê Á¢ÏÄ Ð¡Âú âÖÖ ÏÄÖÁ
// 7ÔÂ 8ÔÂ 9ÔÂ 10ÔÂ 11ÔÂ 12ÔÂ
//СÊî ´óÊî Á¢Çï ´¦Êî °×¶ Çï·Ö º®Â¶ ˪½µ Á¢¶¬ Сѩ ´óÑ© ¶¬ÖÁ
{*********************************************************************************
½ÚÆøÎÞÈκÎÈ·¶¨¹æÂÉ,ËùÒÔÖ»ºÃ´æ±í,Òª½ÚÊ¡¿Õ¼ä,ËùÒÔ....
**********************************************************************************}
//Êý¾Ý¸ñʽ˵Ã÷:
//Èç1901ÄêµÄ½ÚÆøΪ
// 1ÔÂ 2ÔÂ 3ÔÂ 4ÔÂ 5ÔÂ 6ÔÂ 7ÔÂ 8ÔÂ 9ÔÂ 10ÔÂ 11ÔÂ 12ÔÂ
// 6, 21, 4, 19, 6, 21, 5, 21, 6,22, 6,22, 8, 23, 8, 24, 8, 24, 8, 24, 8, 23, 8, 22
// 9, 6, 11,4, 9, 6, 10,6, 9,7, 9,7, 7, 8, 7, 9, 7, 9, 7, 9, 7, 8, 7, 15
//ÉÏÃæµÚÒ»ÐÐÊý¾ÝΪÿÔ½ÚÆø¶ÔÓ¦ÈÕÆÚ,15¼õȥÿÔµÚÒ»¸ö½ÚÆø,ÿÔµڶþ¸ö½ÚÆø¼õÈ¥15µÃµÚ¶þÐÐ
// ÕâÑùÿÔÂÁ½¸ö½ÚÆø¶ÔÓ¦Êý¾Ý¶¼Ð¡ÓÚ16,ÿÔÂÓÃÒ»¸ö×Ö½Ú´æ·Å,¸ßλ´æ·ÅµÚÒ»¸ö½ÚÆøÊý¾Ý,µÍλ´æ·Å
//µÚ¶þ¸ö½ÚÆøµÄÊý¾Ý,¿ÉµÃϱí
gLunarHolDay:array[0..1799] of Byte=(
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1901
$96, $A4, $96, $96, $97, $87, $79, $79, $79, $69, $78, $78, //1902
$96, $A5, $87, $96, $87, $87, $79, $69, $69, $69, $78, $78, //1903
$86, $A5, $96, $A5, $96, $97, $88, $78, $78, $79, $78, $87, //1904
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1905
$96, $A4, $96, $96, $97, $97, $79, $79, $79, $69, $78, $78, //1906
$96, $A5, $87, $96, $87, $87, $79, $69, $69, $69, $78, $78, //1907
$86, $A5, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1908
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1909
$96, $A4, $96, $96, $97, $97, $79, $79, $79, $69, $78, $78, //1910
$96, $A5, $87, $96, $87, $87, $79, $69, $69, $69, $78, $78, //1911
$86, $A5, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1912
$95, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1913
$96, $B4, $96, $A6, $97, $97, $79, $79, $79, $69, $78, $78, //1914
$96, $A5, $97, $96, $97, $87, $79, $79, $69, $69, $78, $78, //1915
$96, $A5, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1916
$95, $B4, $96, $A6, $96, $97, $78, $79, $78, $69, $78, $87, //1917
$96, $B4, $96, $A6, $97, $97, $79, $79, $79, $69, $78, $77, //1918
$96, $A5, $97, $96, $97, $87, $79, $79, $69, $69, $78, $78, //1919
$96, $A5, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1920
$95, $B4, $96, $A5, $96, $97, $78, $79, $78, $69, $78, $87, //1921
$96, $B4, $96, $A6, $97, $97, $79, $79, $79, $69, $78, $77, //1922
$96, $A4, $96, $96, $97, $87, $79, $79, $69, $69, $78, $78, //1923
$96, $A5, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1924
$95, $B4, $96, $A5, $96, $97, $78, $79, $78, $69, $78, $87, //1925
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1926
$96, $A4, $96, $96, $97, $87, $79, $79, $79, $69, $78, $78, //1927
$96, $A5, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1928
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1929
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1930
$96, $A4, $96, $96, $97, $87, $79, $79, $79, $69, $78, $78, //1931
$96, $A5, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1932
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1933
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1934
$96, $A4, $96, $96, $97, $97, $79, $79, $79, $69, $78, $78, //1935
$96, $A5, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1936
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1937
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1938
$96, $A4, $96, $96, $97, $97, $79, $79, $79, $69, $78, $78, //1939
$96, $A5, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1940
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1941
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1942
$96, $A4, $96, $96, $97, $97, $79, $79, $79, $69, $78, $78, //1943
$96, $A5, $96, $A5, $A6, $96, $88, $78, $78, $78, $87, $87, //1944
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1945
$95, $B4, $96, $A6, $97, $97, $78, $79, $78, $69, $78, $77, //1946
$96, $B4, $96, $A6, $97, $97, $79, $79, $79, $69, $78, $78, //1947
$96, $A5, $A6, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //1948
$A5, $B4, $96, $A5, $96, $97, $88, $79, $78, $79, $77, $87, //1949
$95, $B4, $96, $A5, $96, $97, $78, $79, $78, $69, $78, $77, //1950
$96, $B4, $96, $A6, $97, $97, $79, $79, $79, $69, $78, $78, //1951
$96, $A5, $A6, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //1952
$A5, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1953
$95, $B4, $96, $A5, $96, $97, $78, $79, $78, $68, $78, $87, //1954
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1955
$96, $A5, $A5, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //1956
$A5, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1957
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1958
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1959
$96, $A4, $A5, $A5, $A6, $96, $88, $88, $88, $78, $87, $87, //1960
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1961
$96, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1962
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1963
$96, $A4, $A5, $A5, $A6, $96, $88, $88, $88, $78, $87, $87, //1964
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1965
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1966
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1967
$96, $A4, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //1968
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1969
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1970
$96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1971
$96, $A4, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //1972
$A5, $B5, $96, $A5, $A6, $96, $88, $78, $78, $78, $87, $87, //1973
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1974
$96, $B4, $96, $A6, $97, $97, $78, $79, $78, $69, $78, $77, //1975
$96, $A4, $A5, $B5, $A6, $A6, $88, $89, $88, $78, $87, $87, //1976
$A5, $B4, $96, $A5, $96, $96, $88, $88, $78, $78, $87, $87, //1977
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $78, $87, //1978
$96, $B4, $96, $A6, $96, $97, $78, $79, $78, $69, $78, $77, //1979
$96, $A4, $A5, $B5, $A6, $A6, $88, $88, $88, $78, $87, $87, //1980
$A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $77, $87, //1981
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1982
$95, $B4, $96, $A5, $96, $97, $78, $79, $78, $69, $78, $77, //1983
$96, $B4, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $87, //1984
$A5, $B4, $A6, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //1985
$A5, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1986
$95, $B4, $96, $A5, $96, $97, $88, $79, $78, $69, $78, $87, //1987
$96, $B4, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //1988
$A5, $B4, $A5, $A5, $A6, $96, $88, $88, $88, $78, $87, $87, //1989
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $79, $77, $87, //1990
$95, $B4, $96, $A5, $86, $97, $88, $78, $78, $69, $78, $87, //1991
$96, $B4, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //1992
$A5, $B3, $A5, $A5, $A6, $96, $88, $88, $88, $78, $87, $87, //1993
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1994
$95, $B4, $96, $A5, $96, $97, $88, $76, $78, $69, $78, $87, //1995
$96, $B4, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //1996
$A5, $B3, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //1997
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1998
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1999
$96, $B4, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //2000
$A5, $B3, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //2001
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //2002
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //2003
$96, $B4, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //2004
$A5, $B3, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //2005
$A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2006
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //2007
$96, $B4, $A5, $B5, $A6, $A6, $87, $88, $87, $78, $87, $86, //2008
$A5, $B3, $A5, $B5, $A6, $A6, $88, $88, $88, $78, $87, $87, //2009
$A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2010
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $78, $87, //2011
$96, $B4, $A5, $B5, $A5, $A6, $87, $88, $87, $78, $87, $86, //2012
$A5, $B3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $87, //2013
$A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2014
$95, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //2015
$95, $B4, $A5, $B4, $A5, $A6, $87, $88, $87, $78, $87, $86, //2016
$A5, $C3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $87, //2017
$A5, $B4, $A6, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2018
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $79, $77, $87, //2019
$95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $78, $87, $86, //2020
$A5, $C3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //2021
$A5, $B4, $A5, $A5, $A6, $96, $88, $88, $88, $78, $87, $87, //2022
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $79, $77, $87, //2023
$95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $78, $87, $96, //2024
$A5, $C3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //2025
$A5, $B3, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //2026
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //2027
$95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $78, $87, $96, //2028
$A5, $C3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //2029
$A5, $B3, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //2030
$A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //2031
$95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $78, $87, $96, //2032
$A5, $C3, $A5, $B5, $A6, $A6, $88, $88, $88, $78, $87, $86, //2033
$A5, $B3, $A5, $A5, $A6, $A6, $88, $78, $88, $78, $87, $87, //2034
$A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2035
$95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $78, $87, $96, //2036
$A5, $C3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //2037
$A5, $B3, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //2038
$A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2039
$95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $78, $87, $96, //2040
$A5, $C3, $A5, $B5, $A5, $A6, $87, $88, $87, $78, $87, $86, //2041
$A5, $B3, $A5, $B5, $A6, $A6, $88, $88, $88, $78, $87, $87, //2042
$A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2043
$95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $88, $87, $96, //2044
$A5, $C3, $A5, $B4, $A5, $A6, $87, $88, $87, $78, $87, $86, //2045
$A5, $B3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $87, //2046
$A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2047
$95, $B4, $A5, $B4, $A5, $A5, $97, $87, $87, $88, $86, $96, //2048
$A4, $C3, $A5, $A5, $A5, $A6, $97, $87, $87, $78, $87, $86, //2049
$A5, $C3, $A5, $B5, $A6, $A6, $87, $88, $78, $78, $87, $87); //2050


function MonthDays(iYear,iMonth:Word):Word;
begin
case iMonth of
1,3,5,7,8,10,12: Result:=31;
4,6,9,11: Result:=30;
2://Èç¹ûÊÇÈòÄê
if IsLeapYear(iYear) then
Result:=29
else
Result:=28
else
Result:=0;
end;
end;

function GetLeapMonth(iLunarYear:Word):Word;
var
Flag:Byte;
begin
Flag:=gLunarMonth[(iLunarYear-START_YEAR) div 2];
if (iLunarYear-START_YEAR) mod 2=0 then
Result:=Flag shr 4
else
Result:=Flag and $0F;
end;

function LunarMonthDays(iLunarYear,iLunarMonth:Word):Longword;
var
Height,Low:Word;
iBit:Integer;
begin
if iLunarYear<START_YEAR then
begin
Result:=30;
Exit;
end;
Height:=0;
Low:=29;
iBit:=16-iLunarMonth;
if (iLunarMonth>GetLeapMonth(iLunarYear)) and (GetLeapMonth(iLunarYear)>0) then
Dec(iBit);
if (gLunarMonthDay[iLunarYear-START_YEAR] and (1 shl iBit))>0 then
Inc(Low);
if iLunarMonth=GetLeapMonth(iLunarYear) then
if (gLunarMonthDay[iLunarYear-START_YEAR] and (1 shl (iBit-1)))>0 then
Height:=30
else
Height:=29;
Result:=MakeLong(Low,Height);
end;

function LunarYearDays(iLunarYear:Word):Word;
var
Days,i:Word;
tmp:Longword;
begin
Days:=0;
for i:=1 to 12 do
begin
tmp:=LunarMonthDays(iLunarYear,i);
Days:=Days+HiWord(tmp);
Days:=Days+LoWord(tmp);
end;
Result:=Days;
end;

procedure FormatLunarYear(iYear:Word;var pBuffer:string);
var
szText1,szText2,szText3:string;
begin
szText1:='¼×ÒÒ±û¶¡Î켺¸ýÐÁÈɹï';
szText2:='×Ó³óÒúî³½ËÈÎçδÉêÓÏÐ纥';
szText3:='ÊóÅ£»¢ÃâÁúÉßÂíÑòºï¼¦¹·Öí';
pBuffer:=Copy(szText1,((iYear-4) mod 10)*2+1,2);
pBuffer:=pBuffer+Copy(szText2,((iYear-4) mod 12)*2+1,2);
pBuffer:=pBuffer+' ';
pBuffer:=pBuffer+Copy(szText3,((iYear-4) mod 12)*2+1,2);
pBuffer:=pBuffer+'Äê';
end;

function FormatLunarYear(iYear:Word):string;
var
pBuffer:string;
begin
FormatLunarYear(iYear,pBuffer);
Result:=pBuffer;
end;

procedure FormatMonth(iMonth:Word;var pBuffer:string;bLunar:Boolean);
var
szText:string;
begin
if (not bLunar) and (iMonth=1) then
begin
pBuffer:=' Ò»ÔÂ';
Exit;
end;
szText:='Õý¶þÈýËÄÎåÁùÆ߰˾ÅÊ®';
if iMonth<=10 then
begin
pBuffer:=' ';
pBuffer:=pBuffer+Copy(szText,(iMonth-1)*2+1,2);
pBuffer:=pBuffer+'ÔÂ';
Exit;
end;
if iMonth=11 then
pBuffer:='ʮһ'
else
pBuffer:='Ê®¶þ';
pBuffer:=pBuffer+'ÔÂ';
end;

function FormatMonth(iMonth:Word;bLunar:Boolean):string;
var
pBuffer:string;
begin
FormatMonth(iMonth,pBuffer,bLunar);
Result:=pBuffer;
end;

procedure FormatLunarDay(iDay:Word;var pBuffer:string);
var
szText1,szText2:string;
begin
szText1:='³õʮإÈý';
szText2:='Ò»¶þÈýËÄÎåÁùÆ߰˾ÅÊ®';
if (iDay<>20) and (iDay<>30) then
begin
pBuffer:=Copy(szText1,((iDay-1) div 10)*2+1,2);
pBuffer:=pBuffer+Copy(szText2,((iDay-1) mod 10)*2+1,2);
end
else
begin
pBuffer:=Copy(szText1,(iDay div 10)*2+1,2);
pBuffer:=pBuffer+'Ê®';
end;
end;

function FormatLunarDay(iDay:Word):string;
var
pBuffer:string;
begin
FormatLunarDay(iDay,pBuffer);
Result:=pBuffer;
end;

function CalcDateDiff(iEndYear,iEndMonth,iEndDay:Word;iStartYear:Word;iStartMonth:Word;iStartDay:Word):Longword;
begin
Result:=Trunc(EncodeDate(iEndYear,iEndMonth,iEndDay)-EncodeDate(iStartYear,iStartMonth,iStartDay));
end;

function CalcDateDiff(EndDate,StartDate:TDateTime):Longword;
begin
Result:=Trunc(EndDate-StartDate);
end;

procedure l_CalcLunarDate(var iYear,iMonth,iDay:Word;iSpanDays:Longword);
var
tmp:Longword;
begin
//ÑôÀú1901Äê2ÔÂ19ÈÕΪÒõÀú1901ÄêÕýÔ³õÒ»
//ÑôÀú1901Äê1ÔÂ1ÈÕµ½2ÔÂ19ÈÕ¹²ÓÐ49Ìì
if iSpanDays<49 then
begin
iYear:=START_YEAR-1;
if iSpanDays<19 then
begin
iMonth:=11;
iDay:=11+Word(iSpanDays);
end
else
begin
iMonth:=12;
iDay:=Word(iSpanDays)-18;
end;
Exit;
end;
//ÏÂÃæ´ÓÒõÀú1901ÄêÕýÔ³õÒ»ËãÆð
iSpanDays:=iSpanDays-49;
iYear:=START_YEAR;
iMonth:=1;
iDay:=1;
//¼ÆËãÄê
tmp:=LunarYearDays(iYear);
while iSpanDays>=tmp do
begin
iSpanDays:=iSpanDays-tmp;
Inc(iYear);
tmp:=LunarYearDays(iYear);
end;
//¼ÆËãÔÂ
tmp:=LoWord(LunarMonthDays(iYear,iMonth));
while iSpanDays>=tmp do
begin
iSpanDays:=iSpanDays-tmp;
if iMonth=GetLeapMonth(iYear) then
begin
tmp:=HiWord(LunarMonthDays(iYear,iMonth));
if iSpanDays<tmp then Break;
iSpanDays:=iSpanDays-tmp;
end;
Inc(iMonth);
tmp:=LoWord(LunarMonthDays(iYear,iMonth));
end;
//¼ÆËãÈÕ
iDay:=iDay+Word(iSpanDays);
end;

function l_GetLunarHolDay(iYear,iMonth,iDay:Word):Word;
var
Flag:Byte;
Day:Word;
begin
Flag:=gLunarHolDay[(iYear-START_YEAR)*12+iMonth-1];
if iDay<15 then
Day:=15-((Flag shr 4) and $0f)
else
Day:=(Flag and $0f)+15;
if iDay=Day then
if iDay>15 then
Result:=(iMonth-1)*2+2
else
Result:=(iMonth-1)*2+1
else
Result:= 0;
end;

function GetLunarHolDay(InDate:TDateTime):string;
var
i,iYear,iMonth,iDay:Word;
begin
DecodeDate(InDate,iYear,iMonth,iDay);
i:=l_GetLunarHolDay(iYear,iMonth,iDay);
case i of
1:Result:='С º®';
2:Result:='´ó º®';
3:Result:='Á¢ ´º';
4:Result:='Óê Ë®';
5:Result:='¾ª ÕÝ';
6:Result:='´º ·Ö';
7:Result:='Çå Ã÷';
8:Result:='¹È Óê';
9:Result:='Á¢ ÏÄ';
10:Result:='С Âú';
11:Result:='â ÖÖ';
12:Result:='ÏÄ ÖÁ';
13:Result:='С Êî';
14:Result:='´ó Êî';
15:Result:='Á¢ Çï';
16:Result:='´¦ Êî';
17:Result:='°× ¶';
18:Result:='Çï ·Ö';
19:Result:='º® ¶';
20:Result:='˪ ½µ';
21:Result:='Á¢ ¶¬';
22:Result:='С ѩ';
23:Result:='´ó Ñ©';
24:Result:='¶¬ ÖÁ';
else
l_CalcLunarDate(iYear,iMonth,iDay,CalcDateDiff(InDate,EncodeDate(START_YEAR,1,1)));
Result := trim(FormatMonth(iMonth) + FormatLunarDay(iDay));
end;
end;

function GetLunarHolDay(iYear,iMonth,iDay:Word):string;
begin
Result:=GetLunarHolDay(EncodeDate(iYear,iMonth,iDay));
end;
end.

ok

////////unit Lunar;
unit Lunar;

interface
uses SysUtils;


procedure Solar2Lunar(SYear, SMonth, SDay : Integer; Var LYear, LMonth, LDay : Integer);
procedure Lunar2Solar(LYear, LMonth, LDay : Integer; Var SYear, SMonth, SDay : Integer);
function YearName(LYear : integer) : string;
function DaysPerLunarMonth(LYear, LMonth : Integer) : Integer;

implementation
const
SMDay : array[1..12] of integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
c1 : array[1..10] of string[2] = ('甲', '乙', '丙', '丁', '戊', '己', '庚', '辛', '壬', '癸');
c2 : array[1..12] of string[2] = ('子', '丑', '寅', '卯', '辰', '巳', '午', '未', '申', '酉', '戌', '亥');

// Magic String :
LongLife : array[1..100] of string[9] = (
'132637048', '133365036', '053365225', '132900044', '131386034', '022778122', //6
'132395041', '071175231', '131175050', '132635038', '052891127', '131701046', //12
'131748035', '042741223', '130694043', '132391032', '021327122', '131175040', //18
'061623129', '133402047', '133402036', '051769125', '131453044', '130694034', //24
'032158223', '132350041', '073213230', '133221049', '133402038', '063466226', //30
'132901045', '131130035', '042651224', '130605043', '132349032', '023371121', //36
'132709040', '072901128', '131738047', '132901036', '051333226', '131210044', //42
'132651033', '031111223', '131323042', '082714130', '133733048', '131706038', //48
'062794127', '132741045', '131206035', '042734124', '132647043', '131318032', //54
'033878120', '133477039', '071461129', '131386047', '132413036', '051245126', //60
'131197045', '132637033', '043405122', '133365041', '083413130', '132900048', //66
'132922037', '062394227', '132395046', '131179035', '042711124', '132635043', //72
'102855132', '131701050', '131748039', '062804128', '132742047', '132359036', //78
'051199126', '131175045', '131611034', '031866122', '133749040', '081717130', //84
'131452049', '132742037', '052413127', '132350046', '133222035', '043477123', //90
'133402042', '133493031', '021877121', '131386039', '072747128', '130605048', //96
'132349037', '053243125', '132709044', '132890033' );

var
LMDay : array[1..13] of integer;
InterMonth, InterMonthDays, SLRangeDay : integer;


function IsLeapYear(AYear: Integer): Boolean;
begin
Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or (AYear mod 400 = 0));
end;

function YearName(LYear : integer) : string;
var
x, y, ya : integer;
begin
ya := LYear;
if ya < 1 then
ya := ya + 1;
if ya < 12 then
ya := ya + 60;
x := (ya + 8 - ((ya + 7) div 10) * 10);
y := (ya - ((ya-1) div 12) * 12);
result := c1[x]+c2[y];
end;

procedure CovertLunarMonth(magicno : integer);
var
i, size, m : integer;
begin
m := magicno;
for i := 12 downto 1 do begin
size := m mod 2;
if size = 0 then
LMDay := 29
else
LMDay := 30;
m := m div 2;
end;
end;

procedure ProcessMagicStr(yy : integer);
var
magicstr : string;
dsize, LunarMonth, LunarYear : integer;
begin
LunarYear := StrToInt(Copy(IntToStr(yy), 3, 2));
magicstr := LongLife[LunarYear];
InterMonth := StrToInt(Copy(magicstr, 1, 2));
LunarMonth := StrToInt(copy(magicstr, 3, 4));
CovertLunarMonth(LunarMonth);
dsize := StrToInt(Copy(magicstr, 7, 1));
case dsize of
0 : InterMonthDays := 0;
1 : InterMonthDays := 29;
2 : InterMonthDays := 30;
end;
SLRangeDay := StrToInt(Copy(Magicstr, 8, 2));
end;

function DaysPerLunarMonth(LYear, LMonth : Integer) : Integer;
begin
ProcessMagicStr(LYear);
if LMonth < 0 then
Result := InterMonthDays
else
Result := LMDay[LMonth];
end;

procedure Solar2Lunar(SYear, SMonth, SDay : integer; var LYear, LMonth, LDay : integer);
var
i, day : integer;
begin
day := 0;
if isLeapYear(SYear) then //+
SMDay[2] := 29;
ProcessMagicStr(SYear);
if SMonth = 1 then
day := SDay
else begin
for i := 1 to SMonth-1 do
day := day + SMDay;
day := day + SDay;
end;
if day <= SLRangeDay then begin
day := day - SLRangeDay;
processmagicstr(SYear-1);
for i := 12 downto 1 do begin
day := day + LMDay;
if day > 0 then
break;
end;
LYear := SYear - 1;
LMonth := i;
LDay := day;
end else begin
day := day - SLRangeDay;
for i := 1 to InterMonth-1 do begin
day := day - LMDay;
if day <= 0 then
break;
end;
if day <= 0 then begin
LYear := SYear;
LMonth := i;
LDay := day + LMDay;
end else begin
day := day - LMDay[InterMonth];
if day <= 0 then begin
LYear := SYear;
LMonth := InterMonth;
LDay := day + LMDay[InterMonth];
end else begin
LMDay[InterMonth] := InterMonthDays;
for i := InterMonth to 12 do begin
day := day - LMDay;
if day <= 0 then
break;
end;
if i = InterMonth then
LMonth := 0 - InterMonth
else
LMonth := i;
LYear := SYear;
LDay := day + LMDay;
end;
end;
end;
end;

procedure Lunar2Solar(LYear, LMonth, LDay : integer; var SYear, SMonth, SDay : integer);
var
i, day : integer;
begin
day := 0;
SYear := LYear;
if isLeapYear(SYear) then
SMDay[2] := 29;
processmagicstr(SYear);
if LMonth < 0 then
day := LMDay[InterMonth];
if LMonth <> 1 then
for i := 1 to LMonth-1 do
day := day + LMDay;
day := day + LDay + SLRangeDay;
if (InterMonth <> 13) and (InterMonth < LMonth) then
day := day + InterMonthDays;
for i := 1 to 12 do begin
day := day - SMDay;
if day <= 0 then
break;
end;
if day > 0 then begin
SYear := SYear + 1;
if isLeapYear(SYear) then
SMDay[2] := 29;
for i := 1 to 12 do begin
day := day - SMDay;
if day <= 0 then
break;
end;
end;
//i := i - 1;
day := day + SMDay;
//if i = 0 then begin
// i := 12;
// SYear := SYear - 1;
// day := day + 31;
//end;// else
//day := day + SMDay;
SMonth := i;
SDay := day;
end;
end.


//////////////////////////////////
procedure TForm1.Button1Click(Sender: TObject);
var
Y, M, D: Integer;
begin
Solar2Lunar(StrToInt(Copy(Edit1.Text,1,4)), StrToInt(Copy(Edit1.Text,5,2)),
StrToInt(Copy(Edit1.Text,7,2)), Y, M, D);
edit2.Text := IntToStr(Y) + IntToStr(M) + IntToStr(D);
end;

0

眼晕

unit CNYear;

interface
uses sysutils;
type TCNDate = Cardinal;
function DecodeGregToCNDate(dtGreg:TDateTime):TCNDate;
function GetGregDateFromCN(cnYear,cnMonth,cnDay:word;bLeap:Boolean=False):TDateTime;
function GregDateToCNStr(dtGreg:TDateTime):String;
function isCNLeap(cnDate:TCNDate):boolean;
implementation
const cstDateOrg:Integer=32900; //公历1990-01-27的TDateTime表示 对应农历1990-01-01
const cstCNYearOrg=1990;
const cstCNTable:array[cstCNYearOrg..cstCNYearOrg + 60] of WORD=( // unsigned 16-bit
24402, 3730, 3366, 13614, 2647, 35542, 858, 1749, //1997
23401, 1865, 1683, 19099, 1323, 2651, 10926, 1386, //2005
32213, 2980, 2889, 23891, 2709, 1325, 17757, 2741, //2013
39850, 1490, 3493, 61098, 3402, 3221, 19102, 1366, //2021
2773, 10970, 1746, 26469, 1829, 1611, 22103, 3243, //2029
1370, 13678, 2902, 48978, 2898, 2853, 60715, 2635, //2037
1195, 21179, 1453, 2922, 11690, 3474, 32421, 3365, //2045
2645, 55901, 1206, 1461, 14038); //2050
//建表方法：
// 0101 111101010010 高四位是闰月位置,后12位表示大小月,大月30天,小月29天,
//闰月一般算小月,但是有三个特例2017/06,2036/06,2047/05
//对于特例则高四位的闰月位置表示法中的最高为设置为1 特殊处理用wLeapNormal变量
// //2017/06 28330->61098 2036/06 27947->60715 2047/05 23133->55901

//如果希望用汇编,这里有一条信息:农历不会滞后公历2个月.
//将公历转换为农历
//返回:12位年份+4位月份+5位日期
function DecodeGregToCNDate(dtGreg:TDateTime):TCNDate;
var
iDayLeave:Integer;
wYear,wMonth,wDay:WORD;
i,j:integer;
wBigSmallDist,wLeap,wCount,wLeapShift:WORD;
label OK;
begin
result := 0;
iDayLeave := Trunc(dtGreg) - cstDateOrg;
DecodeDate(IncMonth(dtGreg,-1),wYear,wMonth,wDay);
if (iDayLeave < 0) or (iDayLeave > 22295 )then Exit;
//Raise Exception.Create('目前只能算1990-01-27以后的');
//Raise Exception.Create('目前只能算2051-02-11以前的');
for i:=Low(cstCNTable) to High(cstCNTable) do begin
wBigSmallDist := cstCNTable;
wLeap := wBigSmallDist shr 12;
if wLeap > 12 then begin
wLeap := wLeap and 7;
wLeapShift := 1;
end else
wLeapShift := 0;
for j:=1 to 12 do begin
wCount:=(wBigSmallDist and 1) + 29;
if j=wLeap then wCount := wCount - wLeapShift;
if iDayLeave < wCount then begin
Result := (i shl 9) + (j shl 5) + iDayLeave + 1;
Exit;
end;
iDayLeave := iDayLeave - wCount;
if j=wLeap then begin
wCount:=29 + wLeapShift;
if iDayLeave < wCount then begin
Result := (i shl 9) + (j shl 5) + iDayLeave + 1 + (1 shl 21);
Exit;
end;
iDayLeave := iDayLeave - wCount;
end;
wBigSmallDist := wBigSmallDist shr 1;
end;
end;
//返回值:
// 1位闰月标志 + 12位年份+4位月份+5位日期 (共22位)
end;
function isCNLeap(cnDate:TCNDate):boolean;
begin
result := (cnDate and $200000) <> 0;
end;
function GetGregDateFromCN(cnYear,cnMonth,cnDay:word;bLeap:Boolean=False):TDateTime;
var
i,j:integer;
DayCount:integer;
wBigSmallDist,wLeap,wLeapShift:WORD;
begin
// 0101 010010101111 高四位是闰月位置,后12位表示大小月,大月30天,小月29天,
DayCount := 0;
if (cnYear < 1990) or (cnYear >2050) then begin
Result := 0;
Exit;
end;
for i:= cstCNYearOrg to cnYear-1 do begin
wBigSmallDist := cstCNTable;
if (wBIgSmallDist and $F000) <> 0 then DayCount := DayCount + 29;
DayCount := DayCount + 12 * 29;
for j:= 1 to 12 do begin
DayCount := DayCount + wBigSmallDist and 1;
wBigSmallDist := wBigSmallDist shr 1;
end;
end;
wBigSmallDist := cstCNTable[cnYear];
wLeap := wBigSmallDist shr 12;
if wLeap > 12 then begin
wLeap := wLeap and 7;
wLeapShift := 1; //大月在闰月.
end else
wLeapShift := 0;
for j:= 1 to cnMonth-1 do begin
DayCount:=DayCount + (wBigSmallDist and 1) + 29;
if j=wLeap then DayCount := DayCount + 29;
wBigSmallDist := wBigSmallDist shr 1;
end;
if bLeap and (cnMonth = wLeap) then //是要闰月的吗?
DayCount := DayCount + 30 - wLeapShift;
result := cstDateOrg + DayCount + cnDay - 1;
end;

//将日期显示成农历字符串.
function GregDateToCNStr(dtGreg:TDateTime):String;
const hzNumber:array[0..10] of string=('零','一','二','三','四','五','六','七','八','九','十');
function ConvertYMD(Number:Word;YMD:Word):string;
var
wTmp:word;
begin
result := '';
if YMD = 1 then begin //年份
while Number > 0 do begin
result := hzNumber[Number Mod 10] + result;
Number := Number DIV 10;
end;
Exit;
end;
if Number<=10 then begin //可只用1位
if YMD = 2 then //月份
result := hzNumber[Number]
else //天
result := '初' + hzNumber[Number];
Exit;
end;
wTmp := Number Mod 10; //个位
if wTmp <> 0 then result := hzNumber[wTmp];
wTmp := Number Div 10; //十位
result:='十'+result;
if wTmp > 1 then result := hzNumber[wTmp] + result;
end;
var
cnYear,cnMonth,cnDay:word;
cnDate:TCNDate;
strLeap:string;
begin
cnDate:= DecodeGregToCNDate(dtGreg);
if cnDate = 0 then begin
result := '输入越界';
Exit;
end;
cnDay := cnDate and $1F;
cnMonth := (cnDate shr 5) and $F;
cnYear := (cnDate shr 9) and $FFF;
//测试第22位,为1表示闰月
if isCNLeap(cnDate) then strLeap:='(闰)' else strLeap := '';
result := '农历' + ConvertYMD(cnYear,1) + '年' + ConvertYMD(cnMonth,2) + '月'
+ strLeap + ConvertYMD(cnDay,3) ;
end;
end.

我用第3方控件实现