Технологии программирования

({Константы укорочены при макетировании! }

' Январь Февраль Март',

' Апрель Май Июнь',

' Июль Август Сентябрь',

' Октябрь Ноябрь Декабрь'

);

WEEKDAYNAME: Array [1…7] of String [2] = ('Пн', 'Вт', 'Ср', 'Чт', 'Пт', 'Сб', 'Вс');

Var

F: Text; {Файловая переменная}

Year: Word; {Год распечатываемого календаря}

Kvartal: Word; {Квартал года}

{Количество дней в каждом месяце}

MonthsDays: Array [1…12] of Word;

{Количество пустых клеток в начале января года Year}

Balnks: Word;

{Количество пустых клеток в начале каждого месяца }

BlanksDaus: Array [1…12] of Word;

idW: Word; {Номер дня недели }

iMonth: Word; {Номер месяца в году }

iKvartalMonth: Word; {Номер месяца в квартале }

iCol: Word; {Номер колонки в месяце квартала }

iCell: Word; {Номер клетки в месяце квартала}

i: Integer;

Function Vys (Year: Word): Boolean;

{Функция возвращает True в случае високосности года Year}

begin

Vys: = False;

if (((Year mod 4 = 0) and (Year mod 100<>0))

or (Year mod 1000 = 0))

then

Vys: = True;

end; {Vys}

begin { Основная программа }

ClrScr; {Очистка экрана }

Write ('Программа печати календаря');

WriteLn ('заданного года');

Write ('Укажите год распечатываемого');

WriteLn ('календаря после', YEARBASE: 5, 'года');

ReadLn (Year);

{Контроль введенного года }

if Year < YEARBASE then

begin

{Аварийное завершение программы }

Write ('He могу составить календарь');

WriteLn (Year: 5, 'года');

Write ('Для завершения программы');

WriteLn ('нажмите любую клавишу…');

repeat until KeyPressed;

Halt (1);

end;

WriteLn ('Ждите, идет печать…');

Assign (F, 'PRN');

Rewrite (F);

{Печать календаря на принтере }

{Часть пробелов в следующей строке была изъята!}

WriteLn (F, ' ', Year);

{Подготовка информации}

{Определение количества пустых клеток в январе года Year}

Blanks: = BLANKS1917;

i:= YEARBASE;

while (I Year) do begin

{Увеличение Blanks}

Inc (Blanks); {В любой год плюс 1 }

if Vys (i)

then

Inc (Blanks); {Прошлый год високосный, +2}

{Корректировка Blanks}

if (Blanks >= 7) then Blanks:= Blanks — 7;

Inc (i); {Текущий год }

end;

{Определение количества дней в каждом месяце }

for i:= 1 to 12 do

MonthsDays [i]:= 31;

MonthsDays [4]:= 30;

MonthsDays [6]:= 30;

MonthsDays [9]:= 30;

MonthsDays [11]:= 30;

MonthsDays [2]:= 28;

if Vys (Year) then MonthsDays [2]: = 29;

{Определение количества пустых клеток в начале каждого месяца }

BlanksDays [1]:= Blanks;

for i: = 2 to 12 do

if BlanksDays [i — 1] + MonthsDays [i — 1] < 35

then

BlanksDays [i]:= BlanksDays [i — 1] + MonthsDays [i — 1] — 28

else

BlanksDays [i]:= BlanksDays [i — 1] + MonthsDays [i — 1] — 35;

{Задание номеров кварталов }

{Печать тела календаря }