万年历的一种写法

program www;
var year :integer;
Function monthday(year,month:integer):integer;{第year年第month月的天数}
begin
case month of
0 :monthday:=0;
4,6,9,11 :monthday:=30;
1,3,5,7,8,10,12:monthday:=31;
2 :if (year mod 4 =0) and (year mod 100$#@60;>0) or (year mod 400=0)
then monthday :=29
else monthday :=28
end; end;
Function firstday(year,month:integer):integer; {第year年第month月一日是星期几}
var m,n,i :integer;
totaldays :integer;
Function monthto(year,month:integer):integer; {第year年从一月道(month-1)月?
var y,z :integer;
begin
y:=0;
for z:=1 to ( month-1 ) do
y:=y+monthday(year,z);
monthto:=y;
end;
BEGIN
if year>=2000 {以2000年为标准年分情况讨论}
then
begin
i:=0;
for n:=1999 to (year-1) do
if monthday(n,2)=29 then i:=i+1;
totaldays:=year-2000+i;
m:=(totaldays+6)mod 7;
m:=(m+monthto(year,month)) mod 7;
firstday:=m;
end
else {年数小于2000的算法}
begin
i:=0;
for n:=1999 downto (year-1) do
if monthday(n,2)=29 then i:=i+1;
totaldays:=-(1999-year+i+1);
m:=(totaldays+6)mod 7;
m:=(m+monthto(year,month)) mod 7;
firstday:=m;
end;
END;
Procedure weekout; {输出三个星期头}
var a :integer;
begin
for a:=1 to 3 do
write( SU MO TU WE TH FR SA); writeln;
end;
PROCEDURE day(x:integer); {输出三个月日子的过程}
var month1,month2,month3 :integer;
dayone,daytwo,daythree :integer;
t ,p :integer;
BEGIN
month1:=1; month2:=1; month3:=1;
dayone:=firstday(year,x);
daytwo:=firstday(year,(x+1));
daythree:=firstday(year,(x+2));
write(month1:3*(dayone+1)); {输出三个月天数的第一行}
repeat if dayone$#@60;6 then be month1:=month1+1;
write(month1:3); end;
dayone:=dayone+1;
until dayone=7;
write(month2:3*(daytwo+1));
repeat if daytwo$#@60;6 then begin month2:=month2+1;
write(month2:3)end;
daytwo:=daytwo+1;
until daytwo=7;
write(month3:3*(daythree+1));
repeat if daythree$#@60;6 then begin month3:=month3+1;
write(month3:3); end;
daythree:=daythree+1;
until daythree=7;
writeln; p:=0;
repeat p:=p+1; {输出三个月天数的2,3,4行}
t:=0;
repeat
month1:=month1+1;write(month1:3);
t:=t+1;
until t=7;
t:=0;
repeat
month2:=month2+1;write(month2:3);
t:=t+1;
until t=7;
t:=0;
repeat
month3:=month3+1;write(month3:3);
t:=t+1;
until t=7; writeln;
until p=3; p:=0;
repeat p:=p+1; {输出三个月天数的5,6}
begin t:=0 ;
repeat if month1=monthday(year,x) then write( :3)
else begin month1:=month1+1; write(month1:3); end;
t:=t+1;
until (t=7) end;
begin t:=0;
repeat if month2=monthday(year,x+1) then write( :3)
else begin month2:=month2+1;write(month2:3); end;
t:=t+1;
until (t=7)
end;
begin t:=0;
repeat if month3=monthday(year,x+2) then write( :3)
else begin month3:=month3+1; write(month3:3); end;
t:=t+1;
until (t=7)
end; writeln;
until p=2;
END;
BEGIN {main program}
readln(year);
writeln( 一月 二月 三月);
weekout; day(1);
writeln( 四月 五月 六月);
weekout; day(4);
writeln( 七月 八月 九月);
weekout; day(7);
writeln( 十月 十一月 十二月);
weekout; day(10);
END.
{这是my friend 替我发送的! lionman }