PROGRAM calendar;
{ MoYo }
USES CRT;
CONST
MaxRows = 108;
BlankCell = ' ';
TYPE
RowRange = 1..MaxRows;
WeekDaysType = (sunday, monday, tuesday, wednesday, thursday,
friday, saturday );
MonthsYearType = (january, february, march, april, may, june,
july, august, september, october, november, december);
CellType = string[4];
YearRange = 1400..2600;
CalendarArrayType = array [1..MaxRows,WeekDaysType] of CellType;
VAR
YearChosen : YearRange;
CalendarArray : CalendarArrayType;
CurrentDay : weekdaystype;
Rows,
Columns : BYTE;
Z, A, B, C, M : INTEGER;
{******************************************************}
PROCEDURE Initialize (VAR CalendarArray : CalendarArrayType;
MaxRows : RowRange;
BlankCell : CellType);
VAR
Rows : RowRange;
Columns : WeekDaysType;
CurrentRow : RowRange;
CurrentColumn : WeekDaysType;
CurrentMonth : MonthsYearType;
BEGIN { Initialize }
CLRSCR;
FOR Rows := 1 to MaxRows do
BEGIN
FOR Columns := sunday to saturday do
BEGIN
CalendarArray [ Rows, Columns ] := BlankCell;
END;
END;
{ Name of the months }
CurrentRow := 1;
CalendarArray [ CurrentRow, Sunday ] := 'Janu';
CalendarArray [ CurrentRow, Monday ] := 'ary ';
INC (CurrentRow, 9);
CalendarArray [ CurrentRow, Sunday ] := 'Febr';
CalendarArray [ CurrentRow, Monday ] := 'uary';
INC (CurrentRow, 9);
CalendarArray [ CurrentRow, Sunday ] := 'Marc';
CalendarArray [ CurrentRow, Monday ] := 'h ';
INC (CurrentRow, 9);
CalendarArray [ CurrentRow, Sunday ] := 'Apri';
CalendarArray [ CurrentRow, Monday ] := 'l ';
INC (CurrentRow, 9);
CalendarArray [ CurrentRow, Sunday ] := 'May ';
CalendarArray [ CurrentRow, Monday ] := ' ';
INC (CurrentRow, 9);
CalendarArray [ CurrentRow, Sunday ] := 'June';
CalendarArray [ CurrentRow, Monday ] := ' ';
INC (CurrentRow, 9);
CalendarArray [ CurrentRow, Sunday ] := 'July';
CalendarArray [ CurrentRow, Monday ] := ' ';
INC (CurrentRow, 9);
CalendarArray [ CurrentRow, Sunday ] := 'Augu';
CalendarArray [ CurrentRow, Monday ] := 'st ';
INC (CurrentRow, 9);
CalendarArray [ CurrentRow, Sunday ] := 'Sept';
CalendarArray [ CurrentRow, Monday ] := 'embe';
CalendarArray [ CurrentRow, Tuesday ] := 'r ';
INC (CurrentRow, 9);
CalendarArray [ CurrentRow, Sunday ] := 'Octo';
CalendarArray [ CurrentRow, Monday ] := 'ber ';
INC (CurrentRow, 9);
CalendarArray [ CurrentRow, Sunday ] := 'Nove';
CalendarArray [ CurrentRow, Monday ] := 'mber';
INC (CurrentRow, 9);
CalendarArray [ CurrentRow, Sunday ] := 'Dece';
CalendarArray [ CurrentRow, Monday ] := 'mber';
{ End of the name of the months }
{ Name of the days }
CurrentRow := 2;
FOR CurrentMonth := January TO December Do
BEGIN
CalendarArray [ CurrentRow, Sunday ] := 'Sun ';
CalendarArray [ CurrentRow, Monday ] := 'Mon ';
CalendarArray [ CurrentRow, Tuesday ] := 'Tue ';
CalendarArray [ CurrentRow, Wednesday ] := 'Wed ';
CalendarArray [ CurrentRow, Thursday ] := 'Thu ';
CalendarArray [ CurrentRow, Friday ] := 'Fri ';
CalendarArray [ CurrentRow, Saturday ] := 'Sat ';
INC (CurrentRow, 9);
END;
END; { Initialize }
{ Test Code
FOR Rows := 1 to maxrows DO
BEGIN
FOR Columns := Sunday TO Saturday DO
WRITE (CalendarArray [ Rows, Columns ]:4);
WRITELN;
END;
READKEY; }
{************************************************************}
{************************************************************}
PROCEDURE GetTheYear (VAR YearChosen : YearRange );
BEGIN { GetTheYear }
REPEAT
WRITE ('INTRODUCE THE YEAR (1400..2600):'); READLN(YearChosen);
UNTIL (YearChosen >= 1400) AND (YearChosen <= 2600)
END; { GetTheYear }
{***********************************************************}
{***********************************************************}
Procedure FillCalendarArray ( VAR CalendarArray : CalendarArrayType;
YearChosen : YearRange;
MaxRows : RowRange);
{ LEAP YEAR }
FUNCTION IsLeapYear (YearChosen : YearRange) : BOOLEAN;
BEGIN
IsLeapYear := ((YearChosen MOD 4) = 0) AND ((YearChosen MOD 100) <> 0) OR
((YearChosen MOD 400) = 0)
END;
{ END LEAP YEAR }
PROCEDURE FirstDay (yearChosen : YearRange;
VAR Z : Integer);
BEGIN { Zeller's Congruence }
{ IGNORE THIS PART, THIS PART IS TO KNOW THE OTHERS DAYS OF THE YEAR
IF ( M<=2 ) THEN
A:= 1+10;
B:= (YearChosen-1) MOD 100;
C:= (YearChosen-1) DIV 100; }
IF ( M>=3) THEN
BEGIN
A:= 1-2;
B:= YearChosen MOD 100;
C:= YearChosen DIV 100;
END;
IF YearChosen = 1400 THEN
Z := 5;
{*****************************************************************}
IF (YearChosen >= 1401) AND (YearChosen <= 1500) THEN
BEGIN
Z := (702 + ((26*A) -2) DIV 10 + 1 + B + (B DIV 4) + (C DIV 4) - (2 * C )) MOD 7;
IF ((YearChosen MOD 4) = 0) AND ((YearChosen MOD 100) <> 0) OR ((YearChosen MOD 400) = 0) THEN
Z := Z-1
ELSE
Z:= Z-1;
END;
{******************************************************************}
IF (YearChosen >= 1501) AND (YearChosen <= 1700) THEN
BEGIN
Z := (703 + ((26*A) -2) DIV 10 + 1 + B + (B DIV 4) + (C DIV 4) - (2 * C )) MOD 7;
IF ((YearChosen MOD 4) = 0) AND ((YearChosen MOD 100) <> 0) OR ((YearChosen MOD 400) = 0) THEN
Z := Z-1
ELSE
Z := Z-1;
END;
{*********************************************************}
IF (YearChosen >= 1701) AND (YearChosen <= 1751) THEN
BEGIN
Z := (704 + ((26*A) -2) DIV 10 + 1 + B + (B DIV 4) + (C DIV 4) - (2 * C )) MOD 7;
IF ((YearChosen MOD 4) = 0) AND ((YearChosen MOD 100) <> 0) OR ((YearChosen MOD 400) = 0) THEN
Z := Z-1
ELSE
Z := Z-1;
END;
{********************************************************}
IF YearChosen = 1748 THEN
Z:= 6;
{********************************************************}
IF YearChosen = 1752 THEN
Z:= 4;
{*************************************************************}
IF (YearChosen >= 1753) AND (YearChosen <= 2600) THEN
BEGIN
Z:= (700 + ((26*A) -2) DIV 10 + 1 + B + (B DIV 4) + (C DIV 4) - (2 * C )) MOD 7;
IF ((YearChosen MOD 4) = 0) AND ((Yearchosen MOD 100) <> 0) OR ((Yearchosen MOD 400) = 0) THEN
Z:= Z - 1;
END;
END; { Zeller's Congruence }
{***************************************************************************}
{ days of the months }
FUNCTION Days (VAR Months : Monthsyeartype; YearChosen : YearRange ) : INTEGER;
BEGIN
CASE Months OF
january : Days := 31;
february : BEGIN
IF ((YearChosen MOD 4) = 0) AND ((YearChosen MOD 100) <> 0) OR
((YearChosen MOD 400) = 0) THEN
Days := 29
ELSE
Days := 28;
END;
march : Days := 31;
april : Days := 30;
may : Days := 31;
june : Days := 30;
july : Days := 31;
august : Days := 31;
september : BEGIN
IF YearChosen = 1752 THEN
Days := 19
ELSE
Days := 30;
END;
october : Days := 31;
november : Days := 30;
december : Days :=31;
END;
END;
{ end days of the months }
{begin the fuction }
FUNCTION CurrentDay ( Z : INTEGER ) : WeekDaysType;
BEGIN
CASE Z OF
0 : CurrentDay := saturday;
1 : CurrentDay := sunday;
2 : CurrentDay := monday;
3 : CurrentDay := tuesday;
4 : CurrentDay := wednesday;
5 : CurrentDay := thursday;
6 : CurrentDay := friday;
END;
{ end of the function }
BEGIN { FillCalendarArray }
FirstDay (YearChosen, Z);
END; { END FillCalendarArray }
{ GET THE FIRST DAY OF THE YEAR
IF (year < 2000) THEN
FOR Firstday := (2000 - 1) DOWNTO year DO
ELSE
FOR Firstday := 2000 TO (year - 1) DO
BEGIN
END;
END OF THE FIRST DAY OF THE YEAR }
{*****************************************************}
{*****************************************************}
{ aki es dond tengo q ver lo d los numeros pero no se como hacer para q salgan en pantalla con los meses y los dias d la semana}
PROCEDURE DisplayCalendar (VAR CalendarArray : CalendarArrayType
);
VAR
Daysofyear : INTEGER;
BEGIN
FOR Daysofyear := 1 TO 31 DO
END;
{*****************************************************}
{*****************************************************}
BEGIN { MAIN PROGRAM }
Initialize ( CalendarArray, MaxRows, BlankCell);
GetTheYear ( YearChosen );
FillCalendarArray ( CalendarArray,YearChosen, MaxRows );
{ esta parte me falta DisplayMonths ( CalendarArray ); }
END. { MAIN PROGRAM }