# 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}BeginCase month of0: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: =29else MonthDay: =28End EndFunction FirstDay (year,month:integer): integer; {First year of month monthvar M,n,i:integer;Totaldays:integer;Function Monthto (year,month:integer): integer; {The year from January (month-1) month?var Y,z:integer;Beginy:=0;For Z:=1 to (month-1) doY:=y+monthday (YEAR,Z);Monthto:=y;EndBEGINIf year>=2000 {with 2000 years as the standard year of discussion}ThenBegini:=0;For n:=1999 to (year-1) doIf 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;Endelse {An algorithm with a year number less than 2000}Begini:=0;For n:=1999 Downto (year-1) doIf 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;EndEnd;Procedure weekout; {Output three week header}var A:integer;BeginFor A:=1 to 3 doWrite (SU MO TU WE TH FR SA); Writeln;EndPROCEDURE Day (X:integer); {Three months of output process}var Month1,month2,month3:integer;Dayone,daytwo,daythree:integer;T, P:integer;BEGINMonth1:=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); Enddayone:=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); Enddaythree:=daythree+1;Until daythree=7;Writeln; p:=0;Repeat p:=p+1; {Output 2,3,4 line of three month days}t:=0;RepeatMonth1:=month1+1;write (Month1:3);t:=t+1;Until t=7;t:=0;RepeatMonth2:=month2+1;write (Month2:3);t:=t+1;Until t=7;t:=0;RepeatMonth3:=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); Endt:=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); Endt:=t+1;Until (t=7)EndBegin t:=0;Repeat if Month3=monthday (year,x+2) then write (: 3)else begin month3:=month3+1; Write (Month3:3); Endt:=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}`

Related Keywords:

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.