PROGRAM Calendar;
TYPE Date=record { Тип дата }
Year,Month,Day:longint; { Год, месяц, день }
end;
VAR Date1,Date2:Date; { Даты }
YearDay:word; { Номер дня года }
BufDate:Date; { Буфер для обмена }
FUNCTION CorrectDate(D:Date):boolean; { Функция проверки корректности даты }
Begin
with D do
if (Year>=1)and(1<=Month)and(Month<=12)and(1<=Day)
then case Month of
2: CorrectDate:=(Day<=28)or((Year mod 4=0)and(Day=29));
4,6,9,11:CorrectDate:=Day<=30;
else CorrectDate:=Day<=31
end
else CorrectDate:=FALSE
End;
{
***************
* *
* П У С К *
* *
***************
:
:
:
*
* * ┌─
* * │
Нет * * Да │ (Year>=1)and(1<=Month)
∙∙∙∙∙<∙∙∙∙∙* *∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙│ and(Month<=12)and(1<=Day)
: * * : │
: * * : │
: * * * └─
: * * *
: * *
: * *
: * Month *
: * *
***************** * *
* * * *
* CorrectDate * *
* * :
* :=FALSE * :
* * 2 4,6,9,11 : else
***************** .∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙.
: : : :
: : : :
: ***************** ***************** *****************
: * CorrectDate:= * * * * *
: * (Day<=28)or * * CorrectDate:= * * CorrectDate:= *
: *((Year mod 4=0)* * * * *
: * and(Day=29)) * * Day<=30 * * Day<=31 *
: * * * * * *
: ***************** ***************** *****************
: : : :
: : : :
`∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙'
:
:
***************
* *
* К О Н Е Ц *
* *
***************
}
PROCEDURE InputDate(var D:Date); { Процедура ввода даты }
Var Buf:String; { Буфер для ввода даты }
Error:boolean; { Флаг ошибки }
Code:integer; { Номер неправильного символа при преобразовании даты }
Begin
repeat { Цикл ввода даты }
Write('Введите дату [ДД.ММ.ГГГГ] '); { Вывод приглашения ввести дату }
ReadLn(Buf); { Ввод строки даты }
while Buf[1]=' ' do Buf:=Copy(Buf,2,Length(Buf)-1);
{ Удаление начальных пробелов }
while Buf[Length(Buf)]=' ' do Buf:=Copy(Buf,1,Length(Buf)-1);
{ Удаление конечных пробелов }
Error:=Length(Buf)>12; { Проверка корректности даты по длине записи }
Val(Copy(Buf,1,Pos('.',Buf)-1),D.Day,Code);
{ Выделение и преобразование числа месяца }
Error:=Code<>0; { Проверка корректности преобразования числа }
Delete(Buf,1,Pos('.',Buf)); { Удаление числа месяца }
Val(Copy(Buf,1,Pos('.',Buf)-1),D.Month,Code);
{ Выделение и преобразование месяца }
Error:=Error or (Code<>0); { Проверка корректности преобразования месяца }
Delete(Buf,1,Pos('.',Buf)); { Удаление месяца }
Val(Buf,D.Year,Code); { Преобразование года }
Error:=Error or (Code<>0); { Проверка корректности преобразования года }
Error:=Error or not CorrectDate(D); { Проверка корректности даты }
if Error then WriteLn(#7'ОШИБКА') { Если при преобразовании введенной
строки обнаружена ошибка, то вывод сообщения }
until not Error { Выход из цикла при получении корректной даты }
End;
{
***************
* *
* П У С К *
* *
***************
:
:
:∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙<∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙.
: :
: :
: :
***************** :
:
*Вывод приглаше-* :
ния и ввод :
* даты * :
:
***************** :
: :
: :
:∙∙∙∙∙∙∙∙∙<∙∙∙∙∙∙∙∙∙∙∙. :
: : :
: ***************** :
: * Удаление * :
: * первого * :
: * символа * :
* * в строке * :
* * * * :
* * ***************** :
* * Да : :
* Buf[1]=' ' *∙∙∙∙∙∙∙∙∙∙∙∙∙' :
* * :
* * :
* * :
* :
: Нет :
: :
: :
:∙∙∙∙∙∙∙∙∙<∙∙∙∙∙∙∙∙∙∙∙. :
: : :
: ***************** :
: * Удаление * :
: * последнего * :
: * символа * :
* * в строке * :
* * * * ┌─ :
* * ***************** │ :
* * Да : │ Последний :
* *∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙│ символ в строке - :
* * │ - пробел :
* * │ :
* * └─ :
* :
: Нет :
: :
***************** :
* * :
* Error:= * :
* Length(Buf)>12* :
* * :
* * :
***************** :
: :
: :
: :
***************** :
* * :
* Выделение и * :
* преобразование* :
* числа месяца * :
* * :
***************** :
: :
: :
: :
***************** :
* Проверка * :
* корректности * :
* преобразования* :
* числа * :
* * :
***************** :
: :
: :
: :
***************** :
* * :
* Удаление * :
* числа * :
* месяца * :
* * :
***************** :
: :
: :
: :
***************** :
* * :
* Выделение и * :
* преобразование* :
* месяца * :
* * :
***************** :
: :
: :
: :
***************** :
* Проверка * :
* корректности * :
* преобразования* :
* месяца * :
* * :
***************** :
: :
: :
: :
***************** :
* * :
* Удаление * :
* месяца * :
* * :
* * :
***************** :
: :
: :
: :
***************** :
* * :
* Преобразование* :
* года * :
* * :
* * :
***************** :
: :
: :
: :
***************** :
* Проверка * :
* корректности * :
* преобразования* :
* года * :
* * :
***************** :
: :
: :
: :
***************** :
* * :
* Проверка * *****************
* корректности *
* даты * * *
* * ОШИБКА
***************** * *
:
: *****************
: :
* :
* * :
* * :
* * Нет :
* not Error *∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙>∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙∙'
* *
* *
* *
*
: Да
:
:
:
***************
* *
* К О Н Е Ц *
* *
***************
}
FUNCTION GetYearDay(D:Date):word; { Функция вычисления дня года }
Var YearDay:word; { Переменная для набора результата }
Begin
case D.Month of { Подсчет количества дней в целых месяцах данного года }
1:YearDay:=0;
2:YearDay:=31;
3:YearDay:=31+28;
4:YearDay:=31+28+31;
5:YearDay:=31+28+31+30;
6:YearDay:=31+28+31+30+31;
7:YearDay:=31+28+31+30+31+30;
8:YearDay:=31+28+31+30+31+30+31;
9:YearDay:=31+28+31+30+31+30+31+31;
10:YearDay:=31+28+31+30+31+30+31+31+30;
11:YearDay:=31+28+31+30+31+30+31+31+30+31;
12:YearDay:=31+28+31+30+31+30+31+31+30+31+30
end;
if (D.Year mod 4 =0) and (D.Month>2) then YearDay:=YearDay+1;
{ Корректировка високосного года }
YearDay:=YearDay+D.Day; { Количество дней в данном месяце }
GetYearDay:=YearDay { Определение значения функции }
End;
{
***************
* *
* П У С К *
* *
***************
:
:
:
*
* *
* *
* *
* Month *
* *
* *
* *
*
:
.∙∙∙∙∙∙∙∙'
:
:
: *****************
: * *
: 1 * *
:∙∙∙∙∙* YearDay:=0 *∙∙∙∙∙.
: * * :
: * * :
: ***************** :
: ***************** :
: * * :
: 2 * * :
:∙∙∙∙∙* YearDay:=31 *∙∙∙∙∙:
: * * :
: * * :
: ***************** :
: ***************** :
: * * :
: 3 * * :
:∙∙∙∙∙* YearDay:=31+28*∙∙∙∙∙:
: * * :
: * * :
: ***************** :
: ***************** :
: * * :
: 4 * YearDay:= * :
:∙∙∙∙∙* 31+28+31 *∙∙∙∙∙:
: * * :
: * * :
: ***************** :
: ***************** :
: * * :
: 5 * YearDay:= * :
:∙∙∙∙∙* 31+28+31+30 *∙∙∙∙∙:
: * * :
: * * :
: ***************** :
: ***************** :
: * * :
: 6 * YearDay:= * :
:∙∙∙∙∙* 31+28+31+30+ *∙∙∙∙∙:
: * 31 * :
: * * :
: ***************** :
: ***************** :
: * * :
: 7 * YearDay:= * :
:∙∙∙∙∙* 31+28+31+30+ *∙∙∙∙∙:
: * 31+30 * :
: * * :
: ***************** :
: ***************** :
: * * :
: 8 * YearDay:= * :
:∙∙∙∙∙* 31+28+31+30+ *∙∙∙∙∙:
: * 31+30+31 * :
: * * :
: ***************** :
: ***************** :
: * * :
: 9 * YearDay:= * :
:∙∙∙∙∙* 31+28+31+30+ *∙∙∙∙∙:
: * 31+30+31+31 * :
: * * :
: ***************** :
: ***************** :
: * YearDay:= * :
: 10 * 31+28+31+30+ * :
:∙∙∙∙∙* 31+30+31+31+ *∙∙∙∙∙:
: * 30 * :
: * * :
: ***************** :
: ***************** :
: * YearDay:= * :
: 11 * 31+28+31+30+ * :
:∙∙∙∙∙* 31+30+31+31+ *∙∙∙∙∙:
: * 30+31 * :
: * * :
: ***************** :
: ***************** :
: * YearDay:= * :
: 12 * 31+28+31+30+ * :
`∙∙∙∙∙* 31+30+31+31+ *∙∙∙∙∙:
* 30+31+30 * :
* * :
***************** :
:
:
:
.∙∙∙∙∙∙∙∙∙∙∙∙∙'
:
:
*
* * ┌─
* * │
* * Да │ Год високосный
* *∙∙∙∙∙∙∙∙∙∙∙∙∙.∙∙∙∙∙∙∙∙∙∙∙│ и месяц больший
* * : │ февраля
* * : │
* * ***************** └─
* * *
: Нет * YearDay:= *
: * *
: * YearDay+1 *
: * *
: *****************
: :
: :
:∙∙∙∙∙∙<∙∙∙∙∙∙∙∙∙∙∙∙∙∙'
:
:
*****************
* *
* Определение *
* значения *
* функции *
* *
*****************
:
:
:
***************
* *
* К О Н Е Ц *
* *
***************
}
FUNCTION GetEraDay(D:Date):longint; { Функция вычисления дня эры }
Var EraDay:longint; { День эры }
Begin
EraDay:=(D.Year-1)*365+(D.Year-1) div 4; { Количество дней в целых годах }
EraDay:=EraDay+GetYearDay(D); { Количество дней данного года }
GetEraDay:=EraDay { Определение значения функции }
End;
{
***************
* *
* П У С К *
* *
***************
:
:
:
:
*****************
* *
* EraDay:= *
* (Year-1)*365+ *
* (Year-1)div 4 *
* *
*****************
:
:
:
*****************
* *
* EraDay:= *
* EraDay+ *
* GetYearDay(D) *
* *
*****************
:
:
*****************
* *
* Определение *
* значения *
* функции *
* *
*****************
:
:
:
***************
* *
* К О Н Е Ц *
* *
***************
}
FUNCTION GetQuantityYear(D1,D2:Date):word;
{ Функция вычисления полных лет между датами }
Var QuantityYear:word; { Число лет }
Begin
QuantityYear:=D1.Year-D2.Year; { Подсчет числа лет по годам дат }
if (D1.Month<D2.Month)or((D1.Month=D2.Month)and(D1.Day<D2.Day))
{ Если дата болшего года меньше, то корректировка числа полных лет }
then QuantityYear:=QuantityYear-1;
GetQuantityYear:=QuantityYear { Определение значения функции }
End;
{
***************
* *
* П У С К *
* *
***************
:
:
:
:
*****************
* *
* Подсчет числа *
* лет по *
* годам дат *
* *
*****************
:
:
:
:
*
* * ┌─
* * │
* * Да │
* *∙∙∙∙∙∙∙∙∙∙∙∙.∙∙∙∙∙∙∙∙∙∙│ День большего года меньше
* * : │
* * : │
* * ***************** └─
* * *
: Нет * QuantityYear:=*
: * QuantityYear-1*
: * *
: * *
: *****************
: :
: :
:∙∙∙∙∙∙∙∙∙<∙∙∙∙∙∙∙∙∙∙'
:
:
:
*****************
* *
* Определение *
* значения *
* функции *
* *
*****************
:
:
:
***************
* *
* К О Н Е Ц *
* *
***************
}
FUNCTION GetWeekDay(D:Date):string; { Функция определения дня недели }
Begin
case (GetEraDay(D)-1) mod 7 of { Определение значения функции }
0:GetWeekDay:='ВОСКРЕСЕНЬЕ';
1:GetWeekDay:='ПОНЕДЕЛЬНИК';
2:GetWeekDay:='ВТОРНИК';
3:GetWeekDay:='СРЕДА';
4:GetWeekDay:='ЧЕТВЕРГ';
5:GetWeekDay:='ПЯТНИЦА';
6:GetWeekDay:='СУББОТА'
end
End;
{
***************
* *
* П У С К *
* *
***************
:
:
:
:
*
* * ┌─
* * │
* * │
* * ∙∙∙∙∙│ (GetEraDay(D)-1) mod 7
* * │
* * │
* * └─
*
:
.∙∙∙∙∙∙∙∙∙∙∙∙∙'
:
:
: *****************
: * *
: 0 * GetWeekDay:= *
:∙∙∙∙∙* *∙∙∙∙∙.
: * 'ВОСКРЕСЕНЬЕ' * :
: * * :
: ***************** :
: ***************** :
: * * :
: 1 * GetWeekDay:= * :
:∙∙∙∙∙* *∙∙∙∙∙:
: * 'ПОНЕДЕЛЬНИК' * :
: * * :
: ***************** :
: ***************** :
: * * :
: 2 * GetWeekDay:= * :
:∙∙∙∙∙* *∙∙∙∙∙:
: * 'ВТОРНИК' * :
: * * :
: ***************** :
: ***************** :
: * * :
: 3 * GetWeekDay:= * :
:∙∙∙∙∙* *∙∙∙∙∙:
: * 'СРЕДА' * :
: * * :
: ***************** :
: ***************** :
: * * :
: 4 * GetWeekDay:= * :
:∙∙∙∙∙* *∙∙∙∙∙:
: * 'ЧЕТВЕРГ' * :
: * * :
: ***************** :
: ***************** :
: * * :
: 5 * GetWeekDay:= * :
:∙∙∙∙∙* *∙∙∙∙∙:
: * 'ПЯТНИЦА' * :
: * * :
: ***************** :
: ***************** :
: * * :
: 6 * GetWeekDay:= * :
`∙∙∙∙∙* *∙∙∙∙∙:
* 'СУББОТА' * :
* * :
***************** :
:
:
:
.∙∙∙∙∙∙∙∙∙∙∙∙∙'
:
:
:
:
:
***************
* *
* К О Н Е Ц *
* *
***************
}
BEGIN
WriteLn;WriteLn;WriteLn; { Пропуск строк }
{ Вывод заголовка: }
WriteLn('Вычисление количества дней и полных лет между двумя датами');
WriteLn('----------------------------------------------------------');
{ Ввод дат: }
InputDate(Date1);
InputDate(Date2);
if (Date1.Year<Date2.Year)or
((Date1.Year=Date2.Year)and((Date1.Month<Date2.Month)or((Date1.Month=Date2.Month)and(Date1.Day<Date2.Day))))
{ Если первая дата меньше второй, то перестановка дат }
then begin BufDate:=Date1; Date1:=Date2; Date2:=BufDate end;
WriteLn('Количество дней между датами: ',GetEraDay(Date1)-GetEraDay(Date2));
{ Вычисление и вывод количества дней между датами }
WriteLn('Количество полных лет между датами: ',GetQuantityYear(Date1,Date2));
{ Вычисление и вывод количества полных лет между датами }
WriteLn; { Пропуск строки }
{ Вывод заголовка: }
WriteLn('Определение номера дня с начала года и количества дней до конца года');
WriteLn('--------------------------------------------------------------------');
InputDate(Date1); { Ввод даты }
YearDay:=GetYearDay(Date1); { Получение номера дня с начала года }
WriteLn('Количество дней прошедших с начала года: ',YearDay);
WriteLn('Количество дней оставшихся до конца года: ',365-YearDay+Ord(Date1.Year mod 4 =0));
WriteLn; { Пропуск строки }
WriteLn('Определение дня недели'); { Вывод заголовка }
WriteLn('----------------------');
InputDate(Date1); { Ввод даты }
WriteLn('День недели: ',GetWeekDay(Date1)); { Вычисление и вывод дня недели }
END.
***************
* *
* П У С К *
* *
***************
:
:
:
:
*****************
* Вывод *
* заголовка *
*****************
:
:
:
:
*****************
* * * *
* * Ввод * *
* * * *
* *Date1,Date2* *
* * * *
*****************
:
:
:
:
*
* * ┌─
* * │
* * Да │
* *∙∙∙∙∙∙∙∙∙∙∙∙.∙∙∙∙∙∙∙∙∙∙│ Date1 меньше Date2
* * : │
* * : │
* * ***************** └─
* * *
: Нет * BufDate:=Date1*
: * Date1:=Date2 *
: * Date2:=BufDate*
: * *
: *****************
: :
: :
:∙∙∙∙∙∙∙∙∙<∙∙∙∙∙∙∙∙∙∙'
:
:
:
:
*****************
* *Вывод * *
* *количества * *
* *дней между * *
* *датами * *
* * * *
*****************
:
:
:
*****************
* *Вывод * *
* *количества * *
* *лет между * *
* *датами * *
* * * *
*****************
:
:
:
*****************
* Вывод *
* заголовка *
*****************
:
:
:
:
*****************
* * * *
* * Ввод * *
* * * *
* * Date1 * *
* * * *
*****************
:
:
:
*****************
* *Получение * *
* *номера дня * *
* *с начала * *
* *года * *
* * * *
*****************
:
:
:
*****************
* Вывод *
номера дня
* года *
*****************
:
:
:
*****************
* Вычисление и *
вывод количества
* дней до конца *
года
*****************
:
:
:
:
:
:
*****************
* Вывод *
* заголовка *
*****************
:
:
:
:
*****************
* * * *
* * Ввод * *
* * * *
* * Date1 * *
* * * *
*****************
:
:
:
*****************
* Вычисление и *
вывод дня
* недели *
*****************
:
:
:
***************
* *
* К О Н Е Ц *
* *
***************