万年历的一种写法

万年历的一种写法2010-03-12
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 }