A kind of writing of perpetual calendar

Source: Internet
Author: User

Program www;
var Year:integer;
Function MonthDay (year,month:integer): integer; {Days of month month of year}
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; {First year of month month
var M,n,i:integer;
Totaldays:integer;
Function Monthto (year,month:integer): integer; {The year from January (month-1) month?
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 {with 2000 years as the standard year of discussion}
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 {An algorithm with a year number less than 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; {Output three week header}
var A:integer;
Begin
For A:=1 to 3 do
Write (SU MO TU WE TH FR SA); Writeln;
End
PROCEDURE Day (X:integer); {Three months of output process}
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)); {Output The first line of three-month days}
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; {Output 2,3,4 line of three month days}
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; {Output three months 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 (January February March);
Weekout; Day (1);
Writeln (April May June);
Weekout; Day (4);
Writeln (Tue prefer September);
Weekout; Day (7);
Writeln (October November December);
Weekout; Day (10);
End.
{This is sent by my friend for me! Lionman}

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.