BLANKS1917 = 0; {Число пустых клеток в
начале января базового года}
KVARTALNAME: array [1…4] of String [53] =
({Константы укорочены при макетировании! }
<div class="fb2-code"><code>'</code></div> Январь Февраль Март',
<div class="fb2-code"><code>'</code></div> Апрель Май Июнь',
' Июль Август Сентябрь',
<div class="fb2-code"><code>'</code></div> Октябрь Ноябрь Декабрь'
);
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;
{Задание номеров кварталов }
{Печать тела календаря }
for Kvartal:= 1 to 4 do begin
{Печать наименования квартала }
WriteLn (F, KVARTALNAME [Kvartal]);
{Печать дат квартала }
{Задание номера дня недели }
for iDW:= 1 to 7 do
begin
{Печать наименования дней недель }
Write (f, WEEKDAYNAME [iDW];
