分享
 
 
 

日历函数单元

王朝delphi·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

//原始版权宣告:

/***************************************************************************

致看到这些源代码的兄弟:

你好!

这本来是我为一个商业PDA产品开发的日历程序,最近移植于PC机上, 所以算法

和数据部分是用纯C++写的,不涉及MFC,所有的代码都是以短节省存储空间为主要目

的.

很高兴你对这些代码有兴趣,你可以随意复制和使用些代码,唯一有一点小小的

愿望:在你使用和复制给别人时,别忘注明这些代码作者:-)。程序代码也就罢了,后

面的数据可是我辛辛苦苦从万年历上找出来输进去的。

如果你有什么好的意见不妨Mail给我。

wangfei@hanwang.com.cn

wangfei@engineer.com.cn

2000年3月

****************************************************************************/

//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;

//计算iYear,iMonth,iDay对应是星期几 1年1月1日 --- 65535年12月31日

function WeekDay(iYear, iMonth, iDay: Word): Integer;

// ==> function DayOfWeek(Date: TDateTime): Integer;

//计算指定日期的周数,周0为新年开始后第一个星期天开始的周

function WeekNum(const TDT: TDateTime): Word; overload;

function WeekNum(const iYear, iMonth, iDay: Word): Word; overload;

//返回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 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--------------------------------------

//计算从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;

//计算指定日期所对应的星座

function GetConstellation(const DateTime: TDateTime): Integer;

function GetConstellationName(const Constellation: Integer): string; overload;

function GetConstellationName(const DateTime: TDateTime): string; overload;

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 WeekDay(iYear, iMonth, iDay: Word): Integer;

begin

Result := DayOfWeek(EncodeDate(iYear, iMonth, iDay));

end;

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) + (DayOfWeek(dtTmp) - 1)) div 7;

if Result = 0 then

Result := 51

else

Result := Result - 1;

end;

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 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;

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

//阳历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

Result := '';

end;

end;

function GetLunarHolDay(iYear, iMonth, iDay: Word): string;

begin

Result := GetLunarHolDay(EncodeDate(iYear, iMonth, iDay));

end;

function GetConstellation(const DateTime: TDateTime): Integer;

var

Y, M, D: Word;

begin

DecodeDate(DateTime, Y, M, D);

Y := M * 100 + D;

if (Y >= 321) and (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) and (Y <= 822) then

Result := 4

else

if (Y >= 823) and (Y <= 922) then

Result := 5

else

if (Y >= 923) and (Y <= 1022) 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

if (Y >= 120) and (Y <= 218) then

Result := 10

else

if (Y >= 219) and (Y <= 320) then

Result := 11

else

Result := -1;

end;

function GetConstellationName(const Constellation: Integer): string;

begin

case Constellation of

0: Result := '白羊座';

1: Result := '金牛座';

2: Result := '双子座';

3: Result := '巨蟹座';

4: Result := '狮子座';

5: Result := '处女座';

6: Result := '天秤座';

7: Result := '天蝎座';

8: Result := '射手座';

9: Result := '摩羯座';

10: Result := '水瓶座';

11: Result := '双鱼座';

else

Result := '';

end;

end;

function GetConstellationName(const DateTime: TDateTime): string;

begin

Result := GetConstellationName(GetConstellation(DateTime));

end;

end.

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有