// Original copyright announcement:
/ ************************************************** ********************************************************** The program, recently transplanted on the PC, so the algorithm and data part are written by pure C , not involving the MFC, all the code is the main purpose in short saving storage space. I am very happy that you are interested in these code, you can free to copy and use some code, the only little desire: when you copy and use to others, do not forget to indicate the code of :-). The program code is also over, but the data behind, but I am working hard from the long-year-old calendar. If you have any good comments, Mail gives me.
WANGFEI@Hanwang.com.cn or Wangfei@engineer.com.cn March 2000 ****************************************************** *************************************************** /
// translated and modified by Icebird from C to Delphi 5 on 2001.1
Unit Calendar;
Interface
Uses sysutils, windows;
Const start_year = 1901; end_year = 2050;
// ==> function isleApyear (Year: word): boolean;
// Calculate Iyear, IMONTH, IDAY corresponds to the week of January 1, 61, December 31, 6. Function Weekday (Iyear, IMONTH, IDAY: WORD): Integer; // ==> Function Dayofwek (Date : Tdatetime): Integer;
// Calculate the number of weeks in the specified date, Zhou 0 begins for the first Sunday after the New Year: Word; OverLoad; Function Weeknum (Const Iyear, IMONTH, IDAY: WORD): Word; OVERLOAD;
// Return Iyear Year IMONTH month of 1 year from January to 65535 Function Monthdays (Iyear, IMONTH: WORD): Word;
// Return to the lunar calendar ilunaryer Year of the lunar calendar, if Ilunarmonth is the month, // High-character is the second iLunarmonTH day, otherwise high words are 0 / / 1901 January - December 2050 Function Lunarmonthdays (Ilunaryear, Ilunarmonth: Word): longword;
// Return the total number of days of lunal illico ilunaryear /////11 - December 2050 in December 20050 Function LunaryEardAys (Ilunaryear: Word): Word;
// Return the lunar month of the ilunaryear year, if there is no return 0 / / January 1901 - December 2050 Function Getleapmonth (ILunaryear: Word): Word;
// Put the string of Iyear's annual format into the annual method of Heavenly Decoction Procedure FormatLunaryear (Iyyear: Word; Var PBuffer: String); OVERLOAD; FUNCTION FORMATLUNARYEAR (IYEAR: WORD): String; OverLoad; // Put the IMONTH format into Chinese characters String Procedure FormatMonth (IMONTH: Word; Var PBuffer: String; Blunar: Boolean = true); OVERLOAD; Function Formatmonth (IMONTH: WORD; Blunar: Boolean = true): string; overload;
// Storm 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 January 1 - January 31, December 31, 61. Function Calcdatediff (Iendyear, IENDMONTH, IENDDAY: WORD; ISTARTYAR: WORD = Start_Year; iStartMonth: Word = 1; iStartday : Word = 1): Longword; Overload; Function Calcdatediff (Enddate, StartDate: tdatetime): Longword; Overload;
// Calculate the Qianyuan Iyear Year IMONTH Mon Valend Date, return to the corresponding lunar calendar 0-24 // January 1, 1901 - December 31, 2050 Function Getlunardate (Iyear, IMONTH, IDAY: WORD VAR iLunaryear, Ilunarmonth, ILunarday: Word: Word; Overload; Procedure Getlunardate (INDATE: TDATETIME; VAR ILunaryear, Ilunarmonth, ILunarday: Word); OVERLOAD
Function Getlunarholday (InDate: tdatetime): String; Overload; Function Getlunarholday (Iyear, IMONTH, IDAY: WORD): String; Overload;
// Private function --------------------------------------
// Calculate the lunar calendar date from January 1, 1901, ispandays, the l_calclunardate (Var Iyear, IMONTH, IDAY: WORD; ISPANDAYS: longword);
// Calculate the Physical Calear Iyear Year IMONTH Month Iday Japan Correspondence 0-24,0 Table is not a throttle function l_getlunarholday (Iyear, IMONTH, IDAY: WORD): Word;
// Calculates date corresponding constellation function GetConstellation (const DateTime: TDateTime): Integer; function GetConstellationName (const Constellation: Integer): string; overload; function GetConstellationName (const DateTime: TDateTime): string; overload;
IMPLEMENTATION
VAR // array GLUNARDAY deposits the number of monthly months 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 only 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, $ 6A80, $ 2B60, $ 9570, $ 4978, $ 4970, $ 64B0, / / 1930 $ D4A0, $ 80, $ 6D48, $ 5AD0, $ 2B60, $ 9370, $ 92E0, $ 9370, $ 92E0, $ C968, $ C950, $ D4A0, / / 1940 $ DA50, $ B550, $ 56A0, $ 92D0, $ C958, $ A950, $ B4A8, $ 6CA0, / / 1950 $ B550, $ 55A8, $ 4DA0, $ A5B0, $ 52B8, $ 52B0, $ A950, $ E950, $ 6AA0, $ AD50, / / 1960 $ AB50, $ 4B60, $ A570, $ E930, $ D950, $ 5AA8, $ 56A0, $ 96D0, / / 1970 $ 4AE8, $ 4AD0, $ A4D0, $ D268, $ D250, $ D528, $ 540, $ B6A0, $ 96D0, $ 95B0, / / 1980 $ 49B0, $ A4B8, $ A4B0 $ B258, $ 6A50, $ 9370, $ 4978, //990 $ 4970, $ 64b0, $ 6A50, $ 80, $ 6B28, $ 9368, $ 92E0, $ C960 , // 2000 $ D4A8, $ D4A0, $ DA50, $ 5AA8, $ 56A0, $ AAD8, $ 25D0, $ 92D0, $ C958, $ A950, / / 2010 $ B4A0, $ B550, $ 550, $ A5B0, $ 52B8, $ 52B0, $ A930, $ 74A8, // 2020 $ 6AA0, $ 4B60, $ 9570, $ A4E0, $ D260, $ E930, $ D530, $ 5AA0, / / 2030 $ 6B50, $ 96D0, $ 4AE8, $ 4AD0, $ A4D0, $ D258, $ D250, $ 4A0 $ 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, each word, two years of Glunarmonth: Array [0..74] of byte = ($ 00, $ 50, $ 04, $ 00, $ 20, //910 $ 60, $ 70, // 1920 $ 05, $ 00, $ 40 $ 00, $ 50, $ 03, $ 07, $ 00, //940 $ 60, $ 04, $ 00, $ 20, $ 70, //950 $ 06, //960 $ 00, $ 00, $ 07 $ 50, $ 04, $ 08, $ 00, $ 60, // 1980 $ 04, $ 0A, $ 00 $ 60, $ 0 4 4 0 5 00 00, $ 07, $ 50, $ 09, $ 04, $ 09, $ 00, $ 60, $ 04, //2020 $ 00, $ 20 $ 60, $ 05, $ 50, $ 06, $ 00, $ 50, //2040 $ 02, $ 07, $ 00, $ 50, $ 03); // 2050 // A group Glanarholiday stores each year's twenty-four kinds of gas The yield date // The twenty-four hollow calendar of the twenty-four hollow calendar is almost fixed, and the average distribution is distributed in 12 months / / January 200. April April May // Xiaofeng, the cold Summer Xiaoyu Mang Summer to / / July August September 11, September December // Small Summer Summer Qiu Qiu Summer White Louqiu Different Cream Falling Winter Snow Snow Winter to {***************** *********************************************************** ************* No determination rules without any determination, so there is only a good memory Table, save space, so .... ******************************************************** *****************************************} // data format description: // In the 1901 hollow, a month, January, September April, April, June, September, September, September, September, September, September, September, September, September, September, September, September, September, September, September, September, September, September, September, September, September December //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 every The first month of the month, the second fierce minus 15 gets the second row // This month is less than 16 months, and one byte is stored in one byte every month, the high level is stored in the first throttle data, low Store // The second throttle data can be obtained with the following top, Glunarholday: array [0..1799] of byte =
($ 96, $ 97, $ 78, $ 79, $ 79, $ 96, $ A4, $ 96, $ 96, $ 97, $ 87, $ 79, $ 79, $ 79, $ 69 $ 78, $ 78, $ 96, $ 87. $ 87, $ 79, $ 69,// 1903 $ 86, $ A5, $ 96, $ A5, $ 96, $ 97, The $ 88,96,96,// 1904 $ 96, $ 97, $ 978, $ 79, $ 79, $ 69,96, $ 77, $ A4, $ 96 $ 96, $ 79, $ 79, $ 69, $ A57, $ 87, $ 69, $ 69, $ 69, $ 78, $ 78, // 1907 $ 86, $ 96, $ 97, $ 88, $ 87, //908 $ 96, $ 97, $ 78, $ 79, $ 79, $ 69 $ 78, $ A4, $ 96, $ 79, $ 79, $ 69,96, $ 78, //910 $ 96, $ 87, $ 87, $ 87, $ 79 $ 69, $ 78, //911 $ 86, $ 97, $ 88, $ 78, $ 78, $ 69, $ 95, $ b4, $ 96, $ A6, $ 97, $ 79, $ 69, $ 78, $ 96, $ 97, $ 97, $ 79, $ 79, $ 79, $ 69, $ 78, $ 78, // 1914 $ 96, $ A5, $ 97, $ 96,97, $ 69,915 $ 96, $ A5, $ 96, $ 78, $ 78, $ 79, $ 77, $ 87, // 1916 $ 95,96,, $ 97,96, $ 787, //917 $ 96, $ 97, $ 79, $ 79, $ 79, $ 69 $ 78, $ 77, $ 96, $ 97, $ 69,96, # 78, //919 $ 96, $ A5, $ 96, $ A5, $ 96, $ 97, With $ 88,95, $ 87, //920 $ 95, $ 96, $ 97, $ 78, $ 87, //921 $ 96, $ B4, $ 96 $ A6, $ 97, $ 79, $ 78, $ 77, //922 $ 96, $ 87, $ 79, $ 79, $ 69, $ 69, $ 78, $ 78, // 1923 $ 96, $ 96, $ 97, $ 77, $ 87, //924 $ 95, $ B4, $ 97, $ 78, $ 79, $ 78, $ 69, $ 78, $ 87,
//925 $ 96, $ 97, $ 78, $ 79, $ 79, $ 69 $ 96, $ A4, $ 96, $ 96, $ 97, $ 87, $ 79, $ 79, $ 79 $ 69, $ 96, $ A5, $ 96, $ 78, $ 96, $ 88, $ 87, //928 $ 95, $ B4, $ 96, $ A5, $ 96 $ 97, $ 79, $ 96, $ 87, //929 $ 96, $ 97, $ 78, $ 79, $ 79, $ 69, $ 78, $ 77, / / 1930 $ 96, $ A4, $ 96, $ 96, $ 79, $ 69,96, $ 78, $ 9631 $ 96, $ 96, # 88, $ 78, $ 78, $ 87, $ 87 $ 932 $ 95, $ 97, $ 88, $ 78, $ 78, $ 999, $ B4, $ 96, $ A6, $ 97, $ 97, $ 78, $ 79 $ 79, $ 9634 $ 97, $ 97, $ 79, $ 79, $ 69, $ 78, $ 78, / / 1935 $ 96, $ A5, $ 96, $ A5, $ 96, $ 9636 $ 95, $ B4, $ 96, $ 78, $ 78, $ 69, $ 78, $ 87, / / 1937 $ 96, $ B4, $ 97, $ 78, $ 79, $ 79, $ 96, $ A4, $ 96, $ 96, $ 79, $ 79, $ 79, $ 79, $ 69, $ 78, $ 78, //939 $ 96, $ A5, $ 96, $ A578, $ 78, $ 78, $ 95, $ B48, $ 88, $ 78, $ 78, $ 69, $ 78, $ 87, //941 $ 96, $ 97, $ 78, $ 79, $ 79, $ 69,96, $ A4, $ 96, $ 96, $ 97, $ 97, $ 79, $ 79, $ 79 $ 69, $ 96, $ A5, $ 96, $ 78, $ 96, $ 88, $ 87, / / 1944 $ 95, $ B4, $ 96, $ A5, $ 96, $ 78, $ 79,95, $ 87, $ 78, $ 97, $ 97, $ 78, $ 79, $ 78, $ 69, $ 78, $ 77, // 1946 $ 96, $ 97, $ 97, $ 79, $ 78, $ A647 $ 96, $ A5, $ A6, $ 88, $ 88, $ 78, $ 78 $ 87, $ 97, $ A5, $ 96, $ 97, $ 88, $ 79, $ 78, $ 79, $ 87, / / 1949 $ 95, $ B4, $ 96, $ A5, $ 96, $ 97, $ 78, $ 79, $ 78, $ 69, $ 78, $ 77,
/ 1950 $ 96, $ 97, $ 79, $ 79, $ 79, $ 69, $ 96, $ A5, $ A6, $ A5, $ A6, $ 96, $ 88, $ 88,///952 $ A5, $ B47, $ 88, $ 78, $ 78, $ 79, $ 77, $ 87, / / 1953 $ 95, $ B4, $ 96, $ A5, $ 96, $ 78, $ 78, $ 87, //154 $ 96, $ 97, $ 78, $ 79, $ 79, $ 69, $ 78, $ 77, // $ 96, $ A5, $ A58, $ 88, $ 78, $ A57, $ 87, $ A5, $ 96, $ 97, $ 88, $ 78 $ 78,/ 1957 $ 95, $ 97, $ 88, $ 78, $ 78, $ 69,96, $ b4, $ 96, $ A6 $ 97, $ 97, $ 69,96, $ A4, $ A5, $ A58, $ A6, $ 88, $ 78, $ 87, $ 87, // $ A5, $ B4, $ 96, $ 78, $ 78, $ 78, $ 87, $ 96, $ a5, $ 96, $ 97, $ 88, $ 78, $ 78 $ 69, $ 96, $ 97, $ 78, $ 79, $ 79, $ 69, $ 78, $ 77, / / 1963 $ 96, $ A4, $ A5, $ A5, $ A6, $ 96, $ 88, $ 88, $ 87, / / 1964 $ A5, $ B4, $ 96, $ A578, $ 78, $ 78 $ 95, $ B48, $ 88, $ 78, $ 78, $ 69, $ 78, $ 87, //966 $ 96, $ 97, $ 78, $ 79, $ 79, $ 69,96, $ A4, $ A5, $ A58 # A6, $ A6, $ 88 $ 88, $ 87, $ 88 $ A5, $ 96, $ 88, $ 78, $ 78, $ 78, $ 87, $ 87, / / 1969 $ 95, $ B4, $ 96 $ A5, $ 96, $ 69,96, $ 87, //970 $ 96, $ 97, $ 78, $ 79, $ 79, $ 69, $ 78, $ 77, / US $ 96, $ A6, $ A6, $ 88, $ 88, $ 88, $ 78, $ A57, $ B5, $ 96, $ A5, $ A6, $ 96, With $ 88,95, $ 87, //973 $ 95, $ 96, $ 88, $ 78, $ 78, $ 69,96, $ b4, $ 96 $ A6, $ 97, $ 97, $ 78, $ 79, $ 78, $ 69, $ 78, $ 77,
/ 1975 $ 96, $ A6, $ A58, $ 89, $ 88, $ 78, $ A57, $ B4, $ 96, $ A5, $ 96, $ 96, $ 88,95, $ 87, //977 $ 95. $ 979988, $ 87, //978 $ 96, $ b4, $ 96 $ A6, $ 96, $ 78, $ 69, $ A4, $ A5, $ B58, $ A6, $ A6, $ 88, $ 88, $ 88, $ 78, $ 87, $ 87, //980 $ A5, $ B46, $ 88, $ 88, $ 78, $ 78, $ 87, / / 1981 $ 95, $ B4, $ 96, $ A5, $ 96, $ 97, $ 88, $ 77, $ 87, //982 $ 95, $ 969, $ 78, $ 79, $ 78, $ 69, $ 78, $ 77, //983 $ 96, $ b4, $ A5, $ B5, $ A6, $ 88, $ 78, $ 87, $ B4, $ A6, $ A58, $ 96, $ 88, $ 88, $ 78, $ 78 $ 87, $ 87, //985, $ 96, $ 97, $ 88, $ 78, $ 78, $ 95, $ 87, //986 $ 95, $ B4, $ 96, $ A5, $ 96, $ 97, $ 69, $ 78, $ 87, $ A57, $ B58, $ 88, $ 78, $ 87, $ 86, / / 1988 $ A5, $ B4, $ A5, $ A58, $ 88, $ 88, $ 78, $ 87, $ 87, / / 1989 $ A5, $ B4, $ 96, $ A58, $ 78, $ 79,95, $ B48, $ 88, $ 78, $ 78, $ 69, $ 78, $ 87, //991 $ 96, $ A6, $ 87, $ 88, $ 88, $ 78, $ A5, $ B3, $ A5, $ A5, $ A6, $ 96,98, $ 87, $ 87, //993 $ A5, $ 96, $ 88, $ 78, $ 78, $ 78, $ 87, $ 87, / / 1994 $ 95, $ 87, / / 1994 $ 95, $ B4, $ 96, $ A5, $ 76, $ 78, $ 96, $ B4, $ A57, $ 88, $ 88, $ 78 $ 87, $ B3, $ A58, $ A6, $ A6, $ 88, $ 87, //997 $ A5, $ B4, $ 96, $ 96, $ A5, $ 96, $ 96, $ 88, $ 87, //998 $ 95, $ 97,96, $ 78, $ 78, $ 69, $ 78, $ 87, //999 $ 96, $ A6, $ A6, $ 87, $ 88, $ 88, $ 78, $ 87, $ 86,
//20 $ A5, $ B3, $ A58, $ 88, $ 88, $ 78, $ 87, $ 87, // 2001 $ A5, $ B4, $ 96, $ A5, $ 96, $ 96 $ 88, $ 87, $ 87, //22 $ 95, $ B48, $ 88, $ 78, $ 78, $ 69, $ 78, $ 87, / / 2003 $ 96, $ B4, $ A5, $ B57, $ 88, $ 88, $ 78, $ A5, $ B3, $ A58, $ A6, $ A6, $ 88, $ 88, $ 88 $ 78, $ A5, $ B4, $ 96, $ 88, $ 78, $ 78, $ 87, $ 87, // 2006 $ 95, $ B4, $ 96, $ A5 $ 96, $ 97, $ 69,96, $ B4, $ A57, $ 88, $ 87, $ 78, $ 87, $ 86, / $ A5, $ B3, $ A58, $ 88, $ 88, $ 78, $ 87, $ 87, // 2009 $ A5, $ B4, $ 96, $ A5, $ A6, $ 96 $ 88, $ 87, $ 87, // 2010 $ 95, $ B48, $ 97, $ 88, $ 78, $ 78, $ 79, $ 78, $ 87, // 2011 $ 96, $ B4, $ A5, $ B57, $ 88, $ 87, $ 78, $ 87, $ B3, $ A57, $ 88, $ 88 $ 78, $ 87, $ B4, $ 96, $ A58, $ 78, $ 78, $ 87, $ 87, / / 2014 $ 95, $ B4, $ 96, $ A5, $ 78, $ 79,95, $ B4, $ A57, $ 88, $ 87, $ 78, $ 87 $ 86, $ A5, $ B5, $ A6, $ A6, $ 87, $ 87, // 2017 $ A5, $ B4, $ A6, $ A5 $ A6, $ 96, $ 87, $ 87, // 2018 $ 96, $ B49, $ 88, $ 78, $ 78, $ 79, $ 77, $ 87, // $ 95, $ B4, $ A6, $ 97, $ 87, $ 87, $ 78, $ C3, $ A5, $ B5, $ A6, $ A6 $ 87, $ 88, $ 86, //2021 $ A5, $ B4, $ 96, $ 88, $ 88, $ 78, $ 87, $ 87, // 2022 $ A5 $ B4, $ 96, $ 88, $ 78, $ 7823 $ 95, $ B4, $ A523 $ 87, $ A6, $ 97, $ 87, $ 87 $ 78, $ A5, $ C3, $ A5, $ B57, $ 88, $ 78, $ 87, $ 86,
// 2025 $ A5, $ A6, $ 88, $ 88, $ 8826 $ A5, $ B4, $ 96, $ A5, $ 96, $ 96 $ 88, $ 87, $ 87, //2027 $ 95, $ B4, $ A6, $ 97, $ 87, $ 87, $ 78, $ 87, $ 96, // 2028 $ A5 $ C3, $ A5, $ 88, $ 88, $ 78, $ 87,56, //2029 $ A5, $ B3, $ A5, $ A58, $ A6, $ A6, $ 88 $ 88, $ 87, $ 88 $ A5, $ B46, $ 88, $ 78, $ 78, $ 78, $ 87, $ 87, //2031 $ 95, $ B4, $ A5, $ B4, $ A57, $ 87, $ 78, $ 87, $ 96, $ C3, $ A5, $ B58, $ A6, $ 88, $ 88, $ 88, $ 7833 $ A5, $ B3, $ A58, $ 78, $ 88, $ 78, $ 87, $ 87, //2034 $ A5, $ B4, $ 96, $ A58, $ A6, $ 78, $ 87, $ 87, //2035 $ 95, $ A6, $ 97, $ 87, $ 87, $ 78, $ 87, $ 96, //2036 $ B5, $ A6, $ A6, $ 87, $ 88, $ 8837, $ 86, //2037 $ A5, $ B3, $ A5, $ A5, $ A6, $ A6, $ 88, $ 87, //2038 $ A5, $ B4, $ 96, $ 88, $ 78, $ 78, $ 87, $ 87, / / 2039 $ 95, $ B4, $ A5, $ 97, $ 87, $ 87, $ 78, $ A5, $ C3, $ A5, $ B58, $ A6, $ 87, $ 88, $ 87 $ 78, $ 87, $ A5, $ B3, $ 88, $ 88, $ 88, $ 78, $ 87, $ 87, //2042 $ A5, $ B4, $ 96 $ A58, $ A6, $ 78, $ 87, $ 87, //2043 $ 95, $ A6, $ 97, $ 87, $ 87, $ 88, $ 87 $ 96, //2044 $ B4, $ A57, $ 87, $ 88, $ 87, $ 78, $ 86, //2045 $ A5, $ B3, $ A5, $ B5 $ A6, $ A6, $ 87, $ 87, //2046 $ A5, $ B48, $ 88, $ 88, $ 78, $ 78, $ 87, $ 87, // 2047 $ 95, $ A54, $ 97, $ 87, $ 88, $ 86, $ C3, $ A5, $ A5, $ A5, $ A6, $ 97, $ 87, $ 86, //2049 $ A5, $ C3, $ A5, $ 87, $ A6, $ 87, $ 88, $ 78, $ 78, $ 87,
$ 87); // 2050Function Weekday (Iyear, IMONTH, IDAY: WORD): Integer; Begin Result: = dayofweek (Encodedate (IMONTH, IDAY);
Function weeknum (const tdt: tdatetime): Word; VAR Y, M, D: Word; DTTMP: TDATETIME; Begin Decodedate (TDT, Y, M, D); DTTMP: = Encodedate (Y, 1, 1); Result: = (TRUNC (TDT - DTTMP) (DTTMP) - 1)) Div 7; if Result = 0 Then Result: = 51 else results: = results - 1;
Function Weeknum (Const Iyear, IMONTH, IDAY: WORD): Word; Begin Result: = WeekNum (Encodedate (Iyear, IMONTH, IDAY); END;
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;
Function Getleapmonth: 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 (Ibit; Ibit: = 0; low; meter; = 0; = 29; ibit: = 0; low: = 29; iBIT: = 0; low: = 29; ibit : = 16 - ilunarmonth; IF (ilunarmonth> getleapmonth (iLunaryear)) and (Ibit); 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 THEight: = 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;
Procedure FormatLunaryEar (Iyear: Word; Var PBuffer: String); var sztext1, sztext2, sztext3: string; begin sztext1: = 'methyl isthoopreneng 庚 壬 壬'; sztext2: = 'Zi Yizhen 巳 巳 巳 巳 亥 海; sztext3 : = 'Rat cattle tiger free Dragon Snake Pigs and sheepyskey Chicken Chicken Pig'; 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: = 'Jan'; EXIT; END; szText: = 'Positive Twenty Four Fifty VII; if IMONTH <= 10 THEN BEGIN PBUFFER: =' '; PBuffer: = PBuffer Copy (Sztext, (IMONTH - 1) * 2 1, 2); PBUFFER : = PBuffer 'Moon'; EXIT; END; if IMONTH = 11 THEN PBUFFER: = 'Eleven' 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 ten 廿 廿'; sztext2: = 'one or two three four five six seven eight nine ten; 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;
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)) ;
Function Calcdatediff (Enddate, Startdate: tdatetime): Longword; Begin Result: = Trunc (Enddate - StartDate);
function GetLunarDate (iYear, iMonth, iDay: Word; var iLunarYear, iLunarMonth, iLunarDay: Word): Word; begin l_CalcLunarDate (iLunarYear, iLunarMonth, iLunarDay, CalcDateDiff (iYear, iMonth, iDay)); Result: = l_GetLunarHolDay (iYear, iMonth , iDay); end; procedure GetLunarDate (inDate: TDateTime; var iLunarYear, iLunarMonth, iLunarDay: Word); begin l_CalcLunarDate (iLunarYear, iLunarMonth, iLunarDay, CalcDateDiff (inDate, EncodeDate (START_YEAR, 1, 1))); end;
Procedure l_calclunardate (var Iyear, IMONTH, IDAY: WORD; ispandays: longword); var tmp: longword; begin // Cumulatory calendar February 19, 1901, for the lunar calendar 1901, first month, first month, January 1, 2 There are 49 days of the 19th if ispandays <49 the begin Iyear: = start_year - 1; if ispandays <19 dam iMonth: = 11; iDay: = 11 Word (ispandays); Else Begin IMONTH: = 12; IDAY: = Word (ISPANDAYS) - 18; END; EXIT; END; // Below from the lunar calendar 1901, ISPANDAYS: = ISPANDAYS - 49; IYEAR: = Start_Year; IMONTH: = 1; IDAY: = 1; // Calculating the Year TMP: = LunaryEardAys (IYEAR); While IsPandays> = Tmp Do Begin ISPAndays: = ISPANDAYS - TMP; INC (IYEAR); TMP: = LunaryEardAys (Iyear); End; // Computing Month: = 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 Function L_Getlunarholday (Iyear, IMONTH, IDAY: WORD): Word; var flag: Byte; day: word; begin flag: = glunarholday [(iodary - start_year) * 12 IMONTH - 1]; if iDay <15 Then Day: = 15 - (Flag SHR 4) Else Day: = (Flag and $ 0F) 15; if iDay = day dam 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 Decodate (Indate, Iyear, IMONTH, IDAY) I: = l_getlunarholday (Iyear, IMONTH, IDAY); Case I of 1: Result: = 'Xiaoyan'; 2: Result: = 'Big Han; 3: Result: =' 立 春 '; 4: Result: =' Rain '; 5: Result: =' horror '; 6: Result: =' spring points '; 7: Result: =' Qingming '; 8: Result: =' 雨 '; 9: Result: =' Lixia; 10: Result : = 'Small Full'; 11: Result: = 'Mang'; 12: Result: = 'Summer to'; 13: Result: = 'Xiaoxia; 14: Result: =' Da Hot '; 15: Result: =' Autumn 16: Result: = 'Summers'; 17: Result: = 'Baiwu'; 18: Result: = 'Autumn Fix'; 19: Res ULT: = 'Holden'; 20: Result: = 'Cream'; 21: Result: = 'Large'; 22: Result: = 'Snow'; 23: Result: = 'Snow'; 24: Result: = 'Winter '; Else Result: ='; end; end; Function Getlunarholday (Iyear, IMONTH, IDAY: WORD; begin result: = getlunarhold (Encodedate (iYear, IMONTH, IDAY); Function getConstellation (const datetime: tdatetime): Integer; var Y, m, d: word; begin decodate (datetime, y, m, d); y: = m * 100 D; if (y> = 321) and (y> = 321) Y <= 419) Then Result: = 0 else if (y> = 420) and (y <= 520) THEN Result: = 1 else if (y> = 521) and (y <= 620) Then Result: = 2 Else if (y> = 621) and (y <= 722) THEN Result: = 3 else if (y> = 723) THEN Result: = 4 else if (y> = 823) and (y> = 823) Y <= 922) THEN Result: = 5 else if (y> = 923) THEN Result: = 6 else if (y> = 1023) And (y <= 1121) Then Result: = 7 Else if (y> = 1122) and (y <= 1221) THEN Result: = 8 else if (y> = 1222) or (y <= 119) Then Result: = 9 else ing > = 120) and (y <= 218) THEN Result: = 10 else if (y> = 219) AND (Y <= 320) THEN Result: = 11 else result: = -1; Function getConstellationName: string; begin case constellation of 0: result: = 'Aries'; 1: Result: = 'Jin Bull'; 2: Result: = 'Double Substock'; 3: Result: = 'Cancer' ; 4: Result: = 'Leo; 5: Result: =' Virgo '; 6: Result: =' Libra '; 7: Result: =' Scorpio '; 8: Result: =' Sagittarius'; 9: Result: = 'Capricorn'; 10: Result: = 'Aquarius'; 11: Result: =' Double Pisces'; Else Result: = '; End; End; Function GetConstellationName (const datetime: tdatetime): string; begin Result : = GetConstellationName (getConstellation (datetime)); End.
