delphi显示阴阳日历

//显示阴阳日历
unit piOldDate;

interface

uses
SysUtils, Math;

function GetBit(m,n:Integer):Integer;
procedure e2c;
function GetcDateString:string;
function GetDateString:string;

var
CalendarData:Array[0..19] of Integer;
madd:Array[1..12] of Integer;
TheDate: TDateTime;
Year, Month, Day: Word;
tgString,dzString,numString,monString,weekString,sx:WideString;
cYear,cMonth,cDay:Integer;

implementation

function GetBit(m,n:Integer):Integer;
begin
Result:=(m shr n)and 1;
end;

procedure e2c;//阳历转换为阴历
var
total,m,n,k:Integer;
isEnd:Boolean;
tmp:Integer;
begin
isEnd:=false;
tmp:=Year;
if tmp<1900 then tmp:=tmp+1900;
total:=(tmp-2001)*365+Floor((tmp-2001) div 4)+madd[Month]+Day-23;
if (Year mod 4=0) and (Month>1) then Inc(total);
for m:=0 to 19 do
begin
if CalendarData[m]<$fffthenk:=11elsek:=12;forn:=kdownto0dobeginif(total<=29+GetBit(CalendarData[m],n))thenbeginisEnd:=true;break;end;total:=total-29-GetBit(CalendarData[m],n);end;if(isEnd)thenbreak;end;cYear:=2001+m;cMonth:=k-n+1;cDay:=total;ifk=12thenbeginifcMonth=Floor(CalendarData[m]div$10000)+1 then
cMonth:=1-cMonth;
if cMonth>Floor(CalendarData[m] div $10000)+1 then
Dec(cMonth);
end;
end;

function GetcDateString:string;//阴历
var
tmp:string;
begin
tmp:='';
tmp:=tmp+copy(tgString,((cYear-4) mod 10)+1,1);//年干
tmp:=tmp+copy(dzString,((cYear-4) mod 12)+1,1);//年支
tmp:=tmp+'年(';
tmp:=tmp+copy(sx,((cYear-4) mod 12)+1,1);
tmp:=tmp+')';
if cMonth<1 then
begin
tmp:=tmp+'润';
tmp:=tmp+copy(monString,(-cMonth-1)+1,1);
end
else
tmp:=tmp+copy(monString,(cMonth-1)+1,1);
tmp:=tmp+'月';
if cDay<11 then
tmp:=tmp+'初'
else
begin
if cDay<20 then
tmp:=tmp+'十'
else
begin
if cDay<30 then
tmp:=tmp+'廿'
else
tmp:=tmp+'卅';
end;
end;
if (cDay mod 10<>0) or (cDay=10) then
tmp:=tmp+copy(numString,((cDay-1)mod 10)+1,1);
Result:=tmp;
end;

function GetDateString:string;//阳历
var
tmp:string;
t1:Integer;
begin
tmp:='';
t1:=Year;
if t1<1900 then t1:=t1+1900;
tmp:=tmp+IntToStr(t1)+'年'+IntToStr(Month)+'月'+IntToStr(Day)+' '+'星期'+copy(weekString,DayOfWeek(TheDate),1);
Result:=tmp;
end;

initialization//初始化参数
tgString:='甲乙丙丁戊己庚辛壬癸';
dzString:='子丑寅卯辰巳午未申酉戌亥';
numString:='一二三四五六七八九十';
monString:='正二三四五六七八九十冬腊';
weekString:='日一二三四五六';
sx:='鼠牛虎兔龙蛇马羊猴鸡狗猪';
CalendarData[0]:=$41A95;CalendarData[1]:=$D4A;
CalendarData[2]:=$DA5;CalendarData[3]:=$20B55;
CalendarData[4]:=$56A;CalendarData[5]:=$7155B;
CalendarData[6]:=$25D;CalendarData[7]:=$92D;
CalendarData[8]:=$5192B;CalendarData[9]:=$A95;
CalendarData[10]:=$B4A;
CalendarData[11]:=$416AA;CalendarData[12]:=$AD5;
CalendarData[13]:=$90AB5;
CalendarData[14]:=$4BA;CalendarData[15]:=$A5B;
CalendarData[16]:=$60A57;
CalendarData[17]:=$52B;CalendarData[18]:=$A93;
CalendarData[19]:=$40E95;
madd[1]:=0;
madd[2]:=31;
madd[3]:=59;
madd[4]:=90;
madd[5]:=120;
madd[6]:=151;
madd[7]:=181;
madd[8]:=212;
madd[9]:=243;
madd[10]:=273;
madd[11]:=304;
madd[12]:=334;
TheDate:=Date;
DecodeDate(TheDate,Year,Month,Day);
e2c;

{
Caption:=GetcDateString;得到阴历
Caption:=GetDateString;得到阳历
}

end.