//显示阴阳日历
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]<$fff then k:=11 else k:=12;
for n:=k downto 0 do
begin
if(total<=29+GetBit(CalendarData[m],n)) then
begin
isEnd:=true;
break;
end;
total:=total-29-GetBit(CalendarData[m],n);
end;
if(isEnd) then break;
end;
cYear:=2001+m;
cMonth:=k-n+1;
cDay:=total;
if k=12 then
begin
if cMonth=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.