Программа
PROGRAM Calendar;
TYPE Date=record { Тип дата }
Year,Month,Day:longint; { Год, месяц, день }
end;
VAR Date1,Date2:Date; { Даты }
YearDay:word; { Номер дня года }
BufDate:Date; { Буфер для обмена }
Number:longint; { Номер дня эры }
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;
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:=Error or (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;
FUNCTION GetStringDate(D:Date):string; { Функция преобразования даты в строку }
Var Day,Month,Year:string;
{ Вспомогательные переменные для преобразования даты }
Begin
Str(D.Day,Day); { Преобразование числа }
if Length(Day)=1 then Day:='0'+Day; { Форматирование дня месяца }
Str(D.Month,Month); { Преобразование месяца }
if Length(Month)=1 then Month:='0'+Month; { Форматирование месяца }
Str(D.Year,Year); { Преобразование года }
GetStringDate:=Day+'.'+Month+'.'+Year { Определение значения функции }
End;
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;
FUNCTION GetEraDay(D:Date):longint; { Функция вычисления дня эры }
Var EraDay:longint; { День эры }
Begin
EraDay:=(D.Year-1)*365+(D.Year-1) div 4; { Количество дней в целых годах }
GetEraDay:=EraDay+GetYearDay(D);
{ Определение значения функции с учетом количества дней данного года }
End;
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;
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;
PROCEDURE GetDate(EraDay:longint;var D:Date);
{ Процедура вычисления даты по дню эры }
Const January =31;
February =31+29;
March =31+29+31;
April =31+29+31+30;
May =31+29+31+30+31;
June =31+29+31+30+31+30;
July =31+29+31+30+31+30+31;
August =31+29+31+30+31+30+31+31;
September =31+29+31+30+31+30+31+31+30;
October =31+29+31+30+31+30+31+31+30+31;
November =31+29+31+30+31+30+31+31+30+31+30;
December =31+29+31+30+31+30+31+31+30+31+30+31;
Begin
D.Year:=EraDay div (365*4+1) *4;
{ Вычисление количества прошедших четырехлетних периодов }
EraDay:=EraDay mod (365*4+1);
{ Пересчет количества оставшихся неучтенных дней }
case EraDay of
0 ..364 :;
365 ..365+364 :begin D.Year:=D.Year+1; EraDay:=EraDay-365 end;
365+365 ..365+365+364 :begin D.Year:=D.Year+2; EraDay:=EraDay-365*2 end;
365+365+365..365+365+365+365:begin D.Year:=D.Year+3; EraDay:=EraDay-365*3 end
end;
if EraDay<>0
then begin
D.Year:=D.Year+1; { Определение текущего года }
EraDay:=EraDay+Ord((D.Year mod 4<>0)and(EraDay>31+28));
{ Вычисление месяца и числа: }
case EraDay of
1 ..January :begin D.Month:=1; D.Day:=EraDay end;
1+January ..February :begin D.Month:=2; D.Day:=EraDay-January end;
1+February ..March :begin D.Month:=3; D.Day:=EraDay-February end;
1+March ..April :begin D.Month:=4; D.Day:=EraDay-March end;
1+April ..May :begin D.Month:=5; D.Day:=EraDay-April end;
1+May ..June :begin D.Month:=6; D.Day:=EraDay-May end;
1+June ..July :begin D.Month:=7; D.Day:=EraDay-June end;
1+July ..August :begin D.Month:=8; D.Day:=EraDay-July end;
1+August ..September:begin D.Month:=9; D.Day:=EraDay-August end;
1+September..October :begin D.Month:=10; D.Day:=EraDay-September end;
1+October ..November :begin D.Month:=11; D.Day:=EraDay-October end;
1+November ..December :begin D.Month:=12; D.Day:=EraDay-November end
end
end
else begin
D.Month:=12;
D.Day:=31
end
End;
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)); { Вычисление и вывод дня недели }
WriteLn; { Пропуск строки }
WriteLn('Определение даты по дню эры'); { Вывод заголовка }
WriteLn('---------------------------');
Write('Введите число '); { Вывод приглашения }
ReadLn(Number); { Ввод дня эры }
GetDate(Number,Date1); { Определение даты }
WriteLn('Дата: ',GetStringDate(Date1)); { Вычисление и вывод даты }
END.
Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию