有关万年历的算法问题!(50分)

  • 主题发起人 主题发起人 zhlwyy
  • 开始时间 开始时间
Z

zhlwyy

Unregistered / Unconfirmed
GUEST, unregistred user!
各位大虾:
我想编写一个万年历的 小程序,当然前提是 不用DELPHI提供的组件,要自己写算法的 那一种。
比如说1900年1月1日是星期一,然后我输入随便一个 年份2000年3月5日要能在对应的编辑框显示是什么时候
我想知道的 是判断闰年和星期的 算法
如闰年的判断是可以被四百整除或者可以被四整除但是不能被100整除
星期是除以7余数是多少就是星期几!
麻烦大家告诉我怎么写!
 
swYear:word;
if ((swYear mod 4)=0)and((swYear mod 100)>0)or(swYear mod 400)=0) then
 
const
START_YEAR=1901;
END_YEAR=2050;

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
//返回iYear年iMonth月的天數 1年1月 --- 65535年12月
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;

//返回陰歷iLunarYear年的閏月月份,如沒有返回0 1901年1月---2050年12月
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;

//返回陰歷iLunarYer年陰歷iLunarMonth月的天數,如果iLunarMonth為閏月,
//高字為第二個iLunarMonth月的天數,否則高字為0 1901年1月---2050年12月
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;

//返回陰歷iLunarYear年的總天數 1901年1月---2050年12月
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;

//把iYear年格式化成天干記年法表示的字符串
procedure FormatLunarYear(iYear:word;var pBuffer:string);overload;
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 yeartoyin(yeardata:tdatetime):string;
var
text1,text2,nian:string ;
t1:string;
begin
Text1:='甲乙丙丁戊己庚辛壬癸';
Text2:='子丑寅卯辰巳午未申酉戌亥';
nian:=copy(formatdatetime('yyyy-mm-dd',yeardata),1,4);
t1:=copy(text1,((strtoint(nian)-4) mod 10)*2+1,2);
t1:=t1+copy(text2,((strtoint(nian)-4) mod 12)*2+1,2);
t1:='農歷 '+t1+'年';
nian:=t1;
Result:=nian;
end;

function ShengXiao(YearData:TDateTime):PChar;stdcall;
var
texta,sheng,nian:string;
begin
Texta:='鼠牛虎免龍蛇馬羊猴雞狗豬';
nian:=copy(formatdatetime('yyyy-mm-dd',yeardata),1,4);
sheng:=copy(texta,((strtoint(nian)-4) mod 12)*2+1,2);
result:=StrNew(PChar(sheng));
end;


//把iYear年格式化成天干記年法表示的字符串
function FormatLunarYear(iYear:Word):string;overload;
var
pBuffer:string;
begin
FormatLunarYear(iYear,pBuffer);
Result:=pBuffer;
end;

//把iMonth格式化成中文字符串
procedure FormatMonth(iMonth:Word;var pBuffer:string;bLunar:Boolean);overload;
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;

//把iMonth格式化成中文字符串
function FormatMonth(iMonth:Word;bLunar:Boolean):string;overload;
var
pBuffer:string;
begin
FormatMonth(iMonth,pBuffer,bLunar);
Result:=pBuffer;
end;

//把iDay格式化成中文字符串
procedure FormatLunarDay(iDay:Word;var pBuffer:string);overload;
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;

//把iDay格式化成中文字符串
function FormatLunarDay(iDay:Word):string;overload;
var
pBuffer:string;
begin
FormatLunarDay(iDay,pBuffer);
Result:=pBuffer;
end;

//計算公歷兩個日期間相差的天數 1年1月1日 --- 65535年12月31日
function CalcDateDiff(iEndYear,iEndMonth,iEndDay:Word;iStartYear:Word;iStartMonth:Word;iStartDay:Word):Longword;overload;
begin
Result:=Trunc(EncodeDate(iEndYear,iEndMonth,iEndDay)-EncodeDate(iStartYear,iStartMonth,iStartDay));
end;

//計算公歷兩個日期間相差的天數 1年1月1日 --- 65535年12月31日
function CalcDateDiff(EndDate,StartDate:TDateTime):Longword;overload;
begin
Result:=Trunc(EndDate-StartDate);
end;

//計算從1901年1月1日過iSpanDays天後的陰歷日期
procedure l_CalcLunarDate(var iYear,iMonth,iDay:Word;iSpanDays:Longword);overload;
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;

//計算公歷iYear年iMonth月iDay日對應的節氣 0-24,0表不是節氣
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;

//計算公歷iYear年iMonth月iDay日對應的陰歷日期,返回對應的陰歷節氣 0-24
//1901年1月1日---2050年12月31日
function GetLunarHolDay(InDate:TDateTime):string;overload;
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,True) + FormatLunarDay(iDay));
end;
end;

//計算公歷iYear年iMonth月iDay日對應的陰歷日期,返回對應的陰歷節氣 0-24
//1901年1月1日---2050年12月31日
function GetLunarHolDay(iYear,iMonth,iDay:Word):string;overload;
begin
Result:=GetLunarHolDay(EncodeDate(iYear,iMonth,iDay));
end;

function getweek(rqdate:tdatetime):string;
var
weekstr:string;
dow:integer;
begin
dow:=dayofweek(rqdate);
case DOW of
1:weekstr:='星期天';
2:weekstr:='星期一';
3:weekstr:='星期二';
4:weekstr:='星期三';
5:weekstr:='星期四';
6:weekstr:='星期五';
7:weekstr:='星期六';
end;
result:=' '+weekstr;
end;

////////////陽歷到陰歷的轉換
function YangtoYin(yangdate:tdatetime):Pchar;stdcall;
var
ty1:string;
begin
ty1:= yeartoyin(yangdate);
ty1:=ty1+GetLunarHolDay(yangdate);
ty1:=ty1+getweek(yangdate);
result:=StrNew(PChar(ty1));
end;
 
我有资料,但在家里.
 
多謝lixin38,的方法..
 
不用客氣。。
 
那就麻烦 上面的 老大给我一份了
E-mail:zhlwyy1984@163.com
分不够可以再加!
谢谢!
 
下载delphi超级猛料2003里就有
http://www.tommstudio.com/newclub30/d_excellents.asp
 
去看看谢谢老大!
 
能不能找到一直到2080年的闰年数据,我见过有人用的
 
哪里可以找到
还请指点!
 


1. 求星期公式
星期=[5+A(实际天数)] mod 7

2. 干支计算公式
六十甲子干支序号,从1-> 59-> 0。
六十甲子干支序号=[23+A(实际天数)] mod 60

3. 二十八宿计算公式
二十八宿序号=[23+A(实际天数)] mod 28

4. 实际天数A的计算
A=B(基本天数)+C(闰日天数)
B=(计算年-1)*365+(要计算到年的月日天数)
例:1984年2月1日的基本天数B=(1984-1)*365+(31+1)=723827(天),
其中,31是1月为31天,1为2月1日为1天。
公元308年8月28日的基本天数
B=(308-1)*365+(31+28+31+30+31+30+31+27)=112055+239=112294(天)
这里的(要计算到年的月日天数),用的是公历,月日天数的规则我好
象小学就学过了。哈哈……

C=(计算年-1) div 4 -误差修正值 + fixValue2
fixValue2为0或者1。常值为0,当年数为闰年(公历闰年法)之中的3月
1日之后的为1。

误差修正值推算:
公元元年1月1日至1582年10月14日为0。
1582年10月15日至1699年12月31日为10。
从1701年1月1日起每增加一个世纪累加1,但能被400除尽的世纪不累
加1。此方法推算即可。
--有一个问题,1700年这一年的修正值应为多少呢?算法中正好没有
讲到,但看来应该是10。

例1701年1月1日起误差值为11,而1801年1月1日起误差修正值为12,
而1901年1月1日起误差修正值为13,
但2001年误差修正值仍为13,因为2000年能被400整除,故不累加。而
2101年1月1日起误差修正值为14。

5. 实例:1998.3.15的星期、干支与二十八宿
B=(1998-1)*365+(31+28+15)=728979
C=(1998-1) div 4 - 13 + 0 = 486
A=B+C=728979+486=729465
星期序号=(5+729465) mod 7=0,即为星期日
干支序号=(13+729465) mod 60=58,即为辛酉
二十八宿序号=(23+729465) mod 28=4,即为房

===================================================
好可怕!还有一些其它公式……但好象有些参数不知道怎么得到:

二十四节交节日算法:
用已知年的交接时辰加上22个小时35分,超过24要减去24,分数足60
进1个小时,即得到8年后的各节交节时辰。
如2000年雨水交节时辰为16时22分,则2008年雨水交节时辰为14时52
分。
因为16时22分+22时35分=38时57分。38-24=14时。
谁知道公元元年到公元八年的交节日,这个算法就可以实现了。--好
象逆算法可以解决这个问题。谁试试?

农历闰月算法:
农历中,二十四节气(十二节气和十二中气)的中气落在月末的话,下
个月就没有中气。农历将这种有节(节气)无气(中气)的月份规定为闰
月。平均计算,19年有七个闰月。
但二十四个节气的十二节气和十二中气是怎么分的呢?我没有资料,
估记应该是一节气一中气这样交叉。 :(

unit CNYear


interface
uses sysutils

type TCNDate = Cardinal

function DecodeGregToCNDate(dtGreg:TDateTime):TCNDate

function
GetGregDateFromCN(cnYear,cnMonth,cnDay:word;bLeap:Boolean=Fal
se):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=Fal
se):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.
 
多人接受答案了。
 
后退
顶部