日历函数单元

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

文章整理：西部数码--专业提供域名注册、虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息，谢谢!