Const
Start_Year = 1901;
End_year = 2050;
/ / Return Iyear Year IMONTH month of 1 January --- 6 5535 December
Function Monthdays (Iyear, IMONTH: WORD): Word;
// Return the number of lunar calendar iLunaryer years, if ilunarmonth is the month,
// High-character is the second iLunarmonTH day, otherwise high words are 0 1901 - December 2050
Function Lunarmonthdays (Ilunaryear, Ilunarmonth: Word): longword;
// Return the total number of days in the lunar calendar Ilunaryear, January 1901 - December 2050
Function LunaryEardAys (ILunaryear: Word): Word;
// Return the lunar month of the 阴 历 i 年e, if there is no return 0 from January 1901 - December 2050
Function Getleapmonth (Ilunaryear: Word): Word;
// Format the Iyear Year into the string representation
Procedure FormatLunaryear (Iyear: Word; Var PBuffer: String); OVERLOAD;
Function FormatLunaryear (Iyear: Word): String; Overload;
// Format IMONTH into Chinese string
Procedure Formatmonth (IMONTH: Word; Var PBuffer: String; Blunar: Boolean = true); overload;
Function FormatMonth (IMONTH: WORD; Blunar: Boolean = true): string; overload;
// Format iDay into Chinese string
Procedure Formatlunarday (iDay: Word; Var PBuffer: String); OVERLOAD;
Function FormatLunarday (iDay: Word): String; Overload;
// Calculate the number of days during the two days of the question, January 1, 1 year --- 61 December 31, 65535
Function Calcdatediff (Iendyear, IENDMONTH, IENDDAY: WORD; ISTARTYEAR: WORD = Start_Year; iStartMonth: Word = 1; iStartDay: Word = 1): Longword; Overload;
Function Calcdatediff (Enddate, StartDate: tdatetime): longload;
// Calculate the Qian calendar IDAY IMONTH Mon Value Date, return to the corresponding lunar fan 0-24
// January 1, 1901 - December 31, 2050
Function Getlunarholday (Indiate: tdatetime): string; overload;
Function Getlunarholday (Iyear, IMONTH, IDAY: WORD; overload;
// Private function --------------------------------------
// Calculate the valence date from ISPANDAYS in January 1, 1901
Procedure l_calclunardate (var Iyear, IMONTH, IDAY: WORD; ispandays: longword);
// Computational Gregorian Iyear Year IMONTH Month Iday Day corresponding to the throttle 0-24,0 table is not the throttle
Function L_GetlunarholdAy (Iyear, IMONTH, IDAY: WORD): Word;
IMPLEMENTATION
VAR
// A number of glunarday deposits the number of monthly months of the annual monthly calendar from 1901 to 2100, // The lunar calendar can only be 29 or 30 days per month, with 12 (or 13) binary positions, corresponding to 1 table 30 days, otherwise 29 days
Glunarmonthday: array [0..149] of word =
// Test data is only 1901.1.1 --2050.12.31
$ 4AE0, $ A570, $ 5268, $ D260, $ 56A0, $ 9AD0, $ 4AE8, $ 4AE0, / / 1910
$ A4D8, $ A4D0, $ D250, $ D548, $ 550, $ 56A0, $ 96D0, $ 95B0, $ 49B8, $ 49B0, / / 1920
$ A4B0, $ B258, $ 6A50, $ 2B60, $ 9570, $ 4978, $ 4970, $ 64B0, / / 1930
$ D4A0, $ EA50, $ 6D48, $ 5AD0, $ 2B60, $ 9370, $ 92E0, $ C968, $ C950, $ D4A0, / / 1940
$ DA50, $ B550, $ 25D0, $ 92D0, $ C958, $ A950, $ B4A8, $ 6CA0, / / 1950
$ B550, $ 55A8, $ 4DA0, $ A5B0, $ 52B8, $ 52B0, $ A950, $ E950, $ 6AA0, $ AD50, / / 1960
$ AB50, $ 4B60, $ A570, $ A570, $ 5260, $ E930, $ 56A0, $ 96D0, / / 1970
$ 4AE8, $ 4AD0, $ A4D0, $ D268, $ D250, $ D528, $ 540, $ B6A0, $ 96D0, $ 95B0, / / 1980
$ 49B0, $ A4B8, $ 6A50, $ 6D40, $ ADA0, $ AB60, $ 9370, $ 4978, //990
$ 4970, $ 80, $ 6B28, $ 5AC0, $ AB60, $ 9368, $ 92E0, $ C960, / / 2000
$ D4A8, $ D4A0, $ DA50, $ 5AA8, $ 56A0, $ 25D0, $ 92D0, $ C958, $ A950, / / 2010
$ B4A0, $ 550, $ 4BA0, $ A5B0, $ 52B8, $ 52B0, $ A930, $ 74A8, / / 2020
$ 6AA0, $ 4B60, $ 9570, $ A4E0, $ D260, $ E930, $ D530, $ 5AA0, / / 2030
$ 4AE8, $ 4AD0, $ A4D0, $ D258, $ D250, $ D520, $ DAA0, $ B5A0, / / 2040
$ 56D0, $ 4AD8, $ 49B0, $ AA50, $ B528, $ 6D20, $ ADA0, $ 55B0); // 2050
// A number of Glanarmonth stores the month of the lunar calendar from 1901 to 2050, if it is 0, two years for each word
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, $ 00, //970 $ 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
// A number of Glanarholiday stores the twenty-four hollow calendar
/ / The number of twenty-four hollow cautions per year is almost fixed, and the average is distributed in 12 months.
// January 200 1 April April June
// Small cold, cold, spring, rain, thrilling, Spring, clear, Ying, Yue, Xia, Xiaomang, summer
// July August September, Octobermber December
// Xiaoshu Da Summer Autumn Summer White Lu Autumn Different Cold Cream Forte Winter Snow Snow Winter
{********************************************************** ***************************************
There is no determination law without any determination, so there is a good memory, save space, so ....
*********************************************************** ***************************************}
// Data format Description:
/ /, Such as the throttle of 1901
// January 200. April August 2009, September September, October 11
//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
/ / The first line of data above is the monthly hollow corresponding date, 15 minus the first holiday, and the second holiday will be reduced 15 second line.
// This monthly two flying corresponding data is less than 16, stored in one byte every month, store the first throttle data, low storage
// Second, the second hollow data can be obtained
GlunarholdAy: array [0..1799] of byte =
$ 96, $ 97, $ 97, $ 78, $ 79, $ 79, $ 69, $ 78, $ 77, // 1901
$ 96, $ A4, $ 87, $ 79, $ 79, $ 79, $ 69, $ 78, $ 78, // 1902
$ 96, $ A57, $ 87, $ 79, $ 69, $ 69, $ 69, $ 78, $ 78, // 1903
$ 86, $ A5, $ 97, $ 88, $ 78, $ 78, $ 79, $ 78, $ 87, // 1904
$ 96, $ 97, $ 97, $ 78, $ 79, $ 79, $ 69, $ 78, $ 77, // 1905
$ 96, $ A4, $ 97, $ 79, $ 79, $ 79, $ 69, $ 78, $ 78, // 1906
$ 96, $ A57, $ 87, $ 79, $ 69, $ 69, $ 69, $ 78, $ 78, // 1907
$ 86, $ 96, $ 97, $ 88, $ 87, //908 $ 96, $ 97, $ 78, $ 79, $ 79, $ 69 $ 78, $ 77, // 1909
$ 96, $ A4, $ 97, $ 79, $ 79, $ 79, $ 69, $ 78, $ 78, // 1910
$ 96, $ A57, $ 87, $ 79, $ 69, $ 69, $ 69, $ 78, $ 78, // 1911
$ 86, $ 96, $ 97, $ 88, $ 78, $ 78, $ 69, $ 78, $ 87, // 1912
$ 95,97, $ 97, $ 78, $ 79, $ 79, $ 69, $ 78, $ 77, // 1913
$ 96, $ 97, $ 97, $ 79, $ 79, $ 79, $ 69, $ 78, $ 78, // 1914
$ 96, $ 97, $ 87, $ 79, $ 79, $ 69, $ 69, $ 78, $ 78, // 1915
$ 96, $ 96, $ 97, $ 88, $ 78, $ 78, $ 79, $ 77, $ 87, // 1916
$ 95, $ 96, $ 97, $ 78, $ 79, $ 78, $ 69, $ 78, $ 87, // 1917
$ 96, $ 97, $ 97, $ 79, $ 79, $ 79, $ 69, $ 78, $ 77, // 1918
$ 96, $ A5, $ 87, $ 79, $ 79, $ 69, $ 69, $ 78, $ 78, // 1919
$ 96, $ A5, $ 97, $ 88, $ 78, $ 78, $ 79, $ 77, $ 87, // 1920
$ 95, $ 96, $ 97, $ 78, $ 79, $ 78, $ 69, $ 78, $ 87, // 1921
$ 96, $ 97, $ 97, $ 79, $ 79, $ 79, $ 69, $ 78, $ 77, // 1922
$ 96, $ 97, $ 87, $ 79, $ 79, $ 69, $ 69, $ 78, $ 78, // 1923
$ 96, $ A5, $ 97, $ 88, $ 78, $ 78, $ 79, $ 77, $ 87, // 1924
$ 95, $ 96, $ 97, $ 78, $ 79, $ 78, $ 69, $ 78, $ 87, // 1925
$ 96, $ 97, $ 97, $ 78, $ 79, $ 79, $ 69, $ 78, $ 77, // 1926
$ 96, $ 97, $ 87, $ 79, $ 79, $ 79, $ 69, $ 78, $ 78, // 1927
$ 96, $ 96, $ 96, $ 88, $ 78, $ 78, $ 78, $ 87, $ 87, // 1928
$ 95, $ 96, $ 97, $ 88, $ 78, $ 78, $ 79, $ 77, $ 87, // 1929
$ 96, $ 97, $ 97, $ 78, $ 79, $ 79, $ 69, $ 78, $ 77, // 1930
$ 96, $ A4, $ 87, $ 79, $ 79, $ 79, $ 69, $ 78, $ 78, // 1931
$ 96, $ 96, $ 96, $ 88, $ 78, $ 78, $ 78, $ 87, $ 87, // 1932
$ 95, $ 9. $ 97, $ 88, $ 78, $ 78, $ 96, $ 57, $ 78, $ 79, $ 79, $ 69 $ 78, $ 77, // 1934
$ 96, $ A4, $ 97, $ 79, $ 79, $ 79, $ 69, $ 78, $ 78, // 1935
$ 96, $ 96, $ 96, $ 88, $ 78, $ 78, $ 78, $ 87, $ 87, // 1936
$ 95, $ 96, $ 97, $ 88, $ 78, $ 78, $ 69, $ 78, $ 87, // 1937
$ 96, $ 97, $ 97, $ 78, $ 79, $ 79, $ 69, $ 78, $ 77, // 1938
$ 96, $ A4, $ 97, $ 79, $ 79, $ 79, $ 69, $ 78, $ 78, // 1939
$ 96, $ 96, $ 96, $ 88, $ 78, $ 78, $ 78, $ 87, $ 87, // 1940
$ 95, $ 96, $ 97, $ 88, $ 78, $ 78, $ 69, $ 78, $ 87, // 1941
$ 96, $ 97, $ 97, $ 78, $ 79, $ 79, $ 69, $ 78, $ 77, // 1942
$ 96, $ A4, $ 97, $ 79, $ 79, $ 79, $ 69, $ 78, $ 78, // 1943
$ 96, $ A6, $ 96, $ 88, $ 78, $ 78, $ 78, $ 87, $ 87, // 1944
$ 95, $ 96, $ 97, $ 88, $ 78, $ 78, $ 79, $ 77, $ 87, // 1945
$ 95, $ 97, $ 97, $ 78, $ 79, $ 78, $ 69, $ 78, $ 77, // 1946
$ 96, $ 97, $ 97, $ 79, $ 79, $ 79, $ 69, $ 78, $ 78, // 1947
$ 96, $ A6, $ 96, $ 88, $ 88, $ 78, $ 78, $ 87, $ 87, // 1948
$ A5, $ B4, $ 97, $ 88, $ 79, $ 78, $ 79, $ 77, $ 87, // 1949
$ 95, $ 96, $ 97, $ 78, $ 79, $ 78, $ 69, $ 78, $ 77, // 1950
$ 96, $ 97, $ 97, $ 79, $ 79, $ 79, $ 69, $ 78, $ 78, // 1951
$ 96, $ A6, $ 96, $ 88, $ 88, $ 78, $ 78, $ 87, $ 87, // 1952
$ A5, $ 96, $ 97, $ 88, $ 78, $ 78, $ 79, $ 77, $ 87, // 1953
$ 95,96, $ 97, $ 78, $ 79, $ 78, $ 68, $ 78, $ 87, // 1954
$ 96, $ 97, $ 97, $ 78, $ 79, $ 79, $ 69, $ 78, $ 77, // 1955
$ 96, $ A6, $ 96, $ 88, $ 88, $ 78, $ 78, $ 87, $ 87, // 1956
$ A5, $ B4, $ 97, $ 88, $ 78, $ 78, $ 79, $ 77, $ 87, // 1957
$ 95,96, $ 97, $ 88,97, $ 7888 $ 96, $ 97, $ 78, $ 79, $ 79, $ 69 $ 78, $ 77, // 1959
$ 96, $ A6, $ 96, $ 88, $ 88, $ 88, $ 78, $ 87, $ 87, // 1960
$ A5, $ B4, $ 96, $ 88, $ 78, $ 78, $ 78, $ 87, $ 87, // 1961
$ 96, $ 96, $ 97, $ 88, $ 78, $ 78, $ 69, $ 78, $ 87, // 1962
$ 96, $ 97, $ 97, $ 78, $ 79, $ 79, $ 69, $ 78, $ 77, // 1963
$ 96, $ A6, $ 96, $ 88, $ 88, $ 88, $ 78, $ 87, $ 87, // 1964
$ A5, $ B4, $ 96, $ 88, $ 78, $ 78, $ 78, $ 87, $ 87, // 1965
$ 95, $ 96, $ 97, $ 88, $ 78, $ 78, $ 69, $ 78, $ 87, // 1966
$ 96, $ 97, $ 97, $ 78, $ 79, $ 79, $ 69, $ 78, $ 77, // 1967
$ 96, $ A6, $ A6, $ 88, $ 88, $ 88, $ 78, $ 87, $ 87, // 1968
$ A5, $ B4, $ 96, $ 88, $ 78, $ 78, $ 78, $ 87, $ 87, // 1969
$ 95, $ 96, $ 97, $ 88, $ 78, $ 78, $ 69, $ 78, $ 87, // 1970
$ 96, $ 97, $ 97, $ 78, $ 79, $ 79, $ 69, $ 78, $ 77, // 1971
$ 96, $ A6, $ A6, $ 88, $ 88, $ 88, $ 78, $ 87, $ 87, // 1972
$ A5, $ B5, $ 96, $ 88, $ 78, $ 78, $ 78, $ 87, $ 87, // 1973
$ 95, $ 96, $ 97, $ 88, $ 78, $ 78, $ 69, $ 78, $ 87, // 1974
$ 96, $ 97, $ 97, $ 78, $ 79, $ 78, $ 69, $ 78, $ 77, // 1975
$ 96, $ A6, $ A6, $ 88, $ 89, $ 88, $ 78, $ 87, $ 87, // 1976
$ A5, $ B4, $ 96, $ 88, $ 88, $ 78, $ 78, $ 87, $ 87, // 1977
$ 95, $ 96, $ 97, $ 88, $ 78, $ 78, $ 79, $ 78, $ 87, // 1978
$ 96, $ 96, $ 97, $ 78, $ 79, $ 78, $ 69, $ 78, $ 77, // 1979
$ 96, $ A6, $ A6, $ 88, $ 88, $ 88, $ 78, $ 87, $ 87, // 1980
$ A5, $ B4, $ 96, $ 88, $ 88, $ 78, $ 78, $ 77, $ 87, // 1981
$ 95, $ 96, $ 97, $ 88, $ 78, $ 78, $ 79, $ 77, $ 87, // 1982
$ 95,96, $ 97, $ 78, $ 778, $ 69,96, # b4, $ a5, $ b5, $ a6, $ A6, $ 87, $ 88, $ 88, $ 78, $ 87, $ 87, // 1984
$ A5, $ A6, $ 96, $ 88, $ 88, $ 78, $ 78, $ 87, $ 87, // 1985
$ A5, $ B4, $ 97, $ 88, $ 78, $ 78, $ 79, $ 77, $ 87, // 1986
$ 95, $ 96, $ 97, $ 88, $ 79, $ 78, $ 69, $ 78, $ 87, // 1987
$ 96, $ A6, $ A6, $ 87, $ 88, $ 88, $ 78, $ 87, $ 86, // 1988
$ A5, $ B4, $ 96, $ 88, $ 88, $ 88, $ 78, $ 87, $ 87, // 1989
$ A5, $ B4, $ 96, $ 88, $ 78, $ 78, $ 79, $ 77, $ 87, // 1990
$ 95, $ B4, $ 97, $ 88, $ 78, $ 78, $ 69, $ 78, $ 87, // 1991
$ 96, $ A6, $ A6, $ 87, $ 88, $ 88, $ 78, $ 87, $ 86, // 1992
$ A5, $ A6, $ 96, $ 88, $ 88, $ 88, $ 78, $ 87, $ 87, // 1993
$ A5, $ B4, $ 96, $ 88, $ 78, $ 78, $ 78, $ 87, $ 87, // 1994
$ 95,96, $ 97, $ 88, $ 76, $ 78, $ 69, $ 78, $ 87, // 1995
$ 96, $ A6, $ A6, $ 87, $ 88, $ 88, $ 78, $ 87, $ 86, // 1996
$ A5, $ B3, $ A6, $ 88, $ 88, $ 88, $ 78, $ 87, $ 87, // 1997
$ A5, $ 96, $ 96, $ 88, $ 78, $ 78, $ 78, $ 87, $ 87, // 1998
$ 95, $ 96, $ 97, $ 88, $ 78, $ 78, $ 69, $ 78, $ 87, // 1999
$ 96, $ A6, $ A6, $ 87, $ 88, $ 88, $ 78, $ 87, $ 86, // 2000
$ A5, $ A6, $ A6, $ 88, $ 88, $ 88, $ 78, $ 87, $ 87, // 2001
$ A5, $ B4, $ 96, $ 88, $ 78, $ 78, $ 78, $ 87, $ 87, // 2002
$ 95,96, $ 97, $ 88, $ 78, $ 78, $ 69, $ 78, $ 87, // 2003
$ 96, $ A6, $ A6, $ 87, $ 88, $ 88, $ 78, $ 87, $ 86, // 2004
$ A5, $ A6, $ A6, $ 88, $ 88, $ 88, $ 78, $ 87, $ 87, // 2005
$ A5, $ B4, $ 96, $ 88, $ 88, $ 78, $ 78, $ 87, $ 87, // 2006
$ 95,96, $ 97, $ 88, $ 78, $ 78, $ 69, $ 78, $ 87, // 2007
$ 96, $ A6, $ A6, $ 87, $ 86, $ 87, $ A5, $ B3, $ A5, $ B5, $ A6, $ A6, $ 88, $ 88, $ 88, $ 78, $ 87, $ 87, // 2009
$ A5, $ B4, $ 96, $ 88, $ 88, $ 78, $ 78, $ 87, $ 87, // 2010
$ 95,96, $ 97, $ 88, $ 78, $ 78, $ 79, $ 78, $ 87, // 2011
$ 96, $ A5, $ A6, $ 87, $ 88, $ 87, $ 78, $ 87, $ 86, // 2012
$ A5, $ B3, $ A6, $ 87, $ 88, $ 88, $ 78, $ 87, $ 87, // 2013
$ A5, $ B4, $ 96, $ 88, $ 88, $ 78, $ 78, $ 87, $ 87, // 2014
$ 95,96, $ 97, $ 88, $ 78, $ 78, $ 79, $ 77, $ 87, // 2015
$ 95, $ A5, $ A6, $ 87, $ 88, $ 87, $ 78, $ 87, $ 86, // 2016
$ A5, $ C3, $ A6, $ 87, $ 88, $ 88, $ 78, $ 87, $ 87, // 2017
$ A5, $ B4, $ 96, $ 88, $ 88, $ 78, $ 78, $ 87, $ 87, // 2018
$ A5, $ B4, $ 96, $ 88, $ 78, $ 78, $ 79, $ 77, $ 87, // 2019
$ 95, $ A5, $ A6, $ 97, $ 87, $ 87, $ 78, $ 87, $ 86, // 2020
$ A5, $ C3, $ A6, $ 87, $ 88, $ 88, $ 78, $ 87, $ 86, // 2021
$ A5, $ A6, $ 96, $ 88, $ 88, $ 88, $ 78, $ 87, $ 87, // 2022
$ A5, $ B4, $ 96, $ 88, $ 78, $ 78, $ 79, $ 77, $ 87, // 2023
$ 95, $ B4, $ A6, $ 97, $ 87, $ 87, $ 78, $ 87, $ 96, // 2024
$ A5, $ C3, $ A6, $ 87, $ 88, $ 88, $ 78, $ 87, $ 86, // 2025
$ A5, $ A6, $ A6, $ 88, $ 88, $ 88, $ 78, $ 87, $ 87, // 2026
$ A5, $ B4, $ 96, $ 88, $ 78, $ 78, $ 78, $ 87, $ 87, // 2027
$ 95, $ A5, $ A6, $ 97, $ 87, $ 87, $ 78, $ 87, $ 96, // 2028
$ A5, $ C3, $ A6, $ 87, $ 88, $ 88, $ 78, $ 87, $ 86, // 2029
$ A5, $ A6, $ A6, $ 88, $ 88, $ 88, $ 78, $ 87, $ 87, // 2030
$ A5, $ 96, $ 96, $ 88, $ 78, $ 78, $ 78, $ 87, $ 87, // 2031
$ 95, $ A5, $ A6, $ 97, $ 87, $ 87, $ 78, $ 87, $ 96, // 2032
$ A5, $ C3, $ A6, $ 88, $ 88, $ 8833 $ A5, $ B3, $ A5, $ A5, $ A6, $ A6 $ 88, $ 78, $ 88, $ 78, $ 87, $ 87, // 2034
$ A5, $ B4, $ 96, $ 88, $ 88, $ 78, $ 78, $ 87, $ 87, // 2035
$ 95, $ B4, $ A6, $ 97, $ 87, $ 87, $ 78, $ 87, $ 96, // 2036
$ A5, $ C3, $ A6, $ 87, $ 88, $ 88, $ 78, $ 87, $ 86, // 2037
$ A5, $ B3, $ A6, $ 88, $ 88, $ 88, $ 78, $ 87, $ 87, // 2038
$ A5, $ B4, $ 96, $ 88, $ 88, $ 78, $ 78, $ 87, $ 87, // 2039
$ 95, $ B4, $ A6, $ 97, $ 87, $ 87, $ 78, $ 87, $ 96, // 2040
$ A5, $ C3, $ A6, $ 87, $ 88, $ 87, $ 78, $ 87, $ 86, // 2041
$ A5, $ B3, $ A6, $ 88, $ 88, $ 88, $ 78, $ 87, $ 87, // 2042
$ A5, $ B4, $ 96, $ 88, $ 88, $ 78, $ 78, $ 87, $ 87, // 2043
$ 95, $ A5, $ A6, $ 97, $ 87, $ 87, $ 88, $ 87, $ 96, // 2044
$ A5, $ C3, $ A6, $ 87, $ 88, $ 87, $ 78, $ 87, $ 86, // 2045
$ A5, $ B3, $ A6, $ 87, $ 88, $ 88, $ 78, $ 87, $ 87, // 2046
$ A5, $ B4, $ 96, $ 88, $ 88, $ 78, $ 78, $ 87, $ 87, // 2047
$ 95, $ A5, $ A5, $ 97, $ 87, $ 87, $ 88, $ 86, $ 96, // 2048
$ A5, $ A5, $ A6, $ 97, $ 87, $ 87, $ 78, $ 87, $ 86, // 2049
$ A5, $ C3, $ 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 it is a leap year
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 Begin Result: = 30; EXIT; END; HEIGHT: = 0; Low: = 29; Ibit: = 16-ilunarmonth; IF (ilunarmonth> getleapmonth) and (getleapmonth>> 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: = 'methion base 丁戊 庚 辛 壬'; Sztext2: = 'Ziqi Yuchen's unwielded 未 酉 海; Sztext3: = 'rat cattle tiger free dragon saucer horse sheather chicken dog'; 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 'Year'; 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: = 'January'; EXIT; END; Sztext: = 'Zheng two three four five six eight ninety'; IF IMONTH <= 10 Thenbegin PBuffer: = ''; PBUFFER: = PBuffer Copy (Sztext, (IMONTH-1) * 2 1, 2); PBuffer: = PBuffer 'Moon'; EXIT; END; IF IMONTH = 11 THEN PBuffer: = '11' Else PBUFFER: = 'twelve'; PBuffer: = PBuffer 'Moon'; 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: = 'First 10 廿'; Sztext2: = 'One or two three four five six seven eight ninety'; 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 'Ten'; 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 (IENDEDATE (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 // Ceremony February 19, 1901 is the first month of the first month of the lunar calendar 1901 // Soluk calendar from 1 January to February 19, 1901, 49 days If ispandays <49 THEN Begin Iyear: = start_year-1; If ispandays <19 kil Begin IMONTH: = 11; IDAY: = 11 Word (ISPANDAYS); end Else Begin IMONTH: = 12; Iday: = Word (ispandays) -18; EXIT; END; // The following from the lunar calendar in the first month of the first month of the first month ISPANDAYS: = ISPANDAYS-49; Iyear: = start_year; IMONTH: = 1; iDay: = 1; // calculate the year TMP: = LunaryEardAys (Iyear); While ispandays> = TMP DO Begin ISPANDAYS: = ISPANDAYS-TMP; INC; IYEAR TMP: = LunaryEardAys (Iyear); END; // calculate the month 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 ISPANDAYS: = ISPANDAYS-TMP; END; INC (IMONTH); TMP: = Loword (LunarmontHDAYS (Iyear, IMONTH)); END; // Computing Day 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 dam IF iDay> 15 THEN Result: = (IMONTH-1) * 2 2 Else Result: = (IMONTH-1) * 2 1 Else Result: = 0; END; Function Getlunarholday (Indiate: tdatetime): String; VAR I, Iyear, IMONTH, IDAY: WORD; Begin Decodate (INDATE, IYEAR, IMONTH, IDAY); I: = l_getlunarholday (Iyear, IMONTH, IDAY); Case I of 1: Result: = 'Xiaoyan'; 2: Result: = 'big cold'; 3: Result: = 'Li Spring'; 4: Result: = 'Rainwater'; 5: Result: = 'stunning'; 6: Result: = 'spring points'; 7: Result: = 'Qingming'; 8: Result: = 'Valley Rain'; 9: Result: = 'Lixia'; 10: Result: = 'Small full'; 11: Result: = 'Mang'; 12: Result: = 'Summer to'; 13: Result: = 'Xiaoxia'; 14: Result: = 'Daqing'; 15: Result: = 'Equation'; 16: Result: = '处'; 17: Result: = 'white dew'; 18: Result: = 'autumn; 19: Result: = 'cold dew'; 20: Result: = 'Frost'; 21: Result: = 'Large Winter'; 22: RESULT: = 'Snow'; 23: RESULT: = 'Snow'; 24: Result: = 'Winter Solids'; Else L_calclunardate (Iyear, IMONTH, IDAY, CALCDATEDIFF (Indate, Encodedate (Start_Year, 1, 1))))) Result: = Trim (FormatMonth Formatlunarday (iDay)); END; END; Function Getlunarholday (Iyear, IMONTH, IDAY: WORD): String; Begin Result: = Getlunarholday (Encodedate (Iyear, IMONTH, IDAY); END; End.
