Есть задание по Паскалю :
Создать универсальный календарь ,вводишь день ,год и месяц и должно выдать день недели с учётом весокосных годов,также условие ,что каждый год,который делится на 100 без остатка ( 100 ,300,210000...) и при этом не делится на 400 ( 400 ,800,1200...) считается НЕ весокосным
вот мой код:
program kalendar;
uses crt;
var
dayn,mn,year,dayn2,year2:integer;
yn:string;
const
day0:array[0..6] of string=('Ponedelnik','Vtornik','Sreda','Chetverg','Patnica','Sybbota','Voskresenie');
day1:array[0..6] of string=('Vtornik','Sreda','Chetverg','Patnica','Sybbota','Voskresenie','Ponedelnik');
day2:array[0..6] of string=('Sreda','Chetverg','Patnica','Sybbota','Voskresenie','Ponedelnik','Vtornik');
day3:array[0..6] of string=('Chetverg','Patnica','Sybbota','Voskresenie','Ponedelnik','Vtornik','Sreda');
day4:array[0..6] of string=('Patnica','Sybbota','Voskresenie','Ponedelnik','Vtornik','Sreda','Chetverg');
day5:array[0..6] of string=('Sybbota','Voskresenie','Ponedelnik','Vtornik','Sreda','Chetverg','Patnica');
day6:array[0..6] of string=('Voskresenie','Ponedelnik','Vtornik','Sreda','Chetverg','Patnica','Sybbota');
month:array[1..12] of integer=(31,28,31,30,31,30,31,31,30,31,30,31);
begin
clrscr;
yn:='n';
while yn='n' do
begin
writeln('Put year number');readln(year);
writeln('Put mounth number');readln(mn);
writeln('Put day number');readln(dayn);
dayn2:=0;
year2:=year;
while year>1 do
begin
if ((year mod 100) = 0) and ((year mod 400) <> 0) then dayn2:=dayn2+2;
if ((year mod 100) <> 0) and ((year mod 4) = 0) then dayn2:=dayn2+1;
if ((year mod 100) <> 0) and ((year mod 4) <> 0) then dayn2:=dayn2+1;
if dayn2=7 then dayn2:=0;
if dayn2=8 then dayn2:=1;
year:=year-1;
end;
while mn>1 do
begin
mn:=mn-1;
dayn:=dayn + month[mn];
end;
while year2>1 do
begin
if((year2 mod 100) = 0) and ((year mod 400)<>0) and (mn>1) then dayn:=dayn+1;
if((year2 mod 100) <> 0) and ((year mod 4)=0) and (mn>1) then dayn:=dayn+1;
year2:=year2-1;
end;
case dayn2 of
0:writeln(day6[dayn mod 7]);
1:writeln(day0[dayn mod 7]);
2:writeln(day1[dayn mod 7]);
3:writeln(day2[dayn mod 7]);
4:writeln(day3[dayn mod 7]);
5:writeln(day4[dayn mod 7]);
6:writeln(day5[dayn mod 7]);
else writeln('Oops!!!');
end;
writeln('Exit(y/n)');readln(yn);
end;
end.
работать нэхочэт( чо непра?
незнающих лесом
Комментарии (3)
А что не работает?
А!!! Паскаль )) Я за ним уже соскучилась, тебе сегодня повезло, у меня настроение хорошее ))
Хз, чо ты там понаписал, не хочу я разбираться в коде без комментов %) Привыкай описывать хоть основные части, это должно происходить на автомате, имхо, легче заново написать, чем разбирать, что где как обозвали %)
Смотрю, ты или процедуры/функции еще не освоил, или просто их не любишь... Написала из рассчета "не освоил", сам переделаешь, если чО ))
{ПРОГРАММА ДЛЯОПРЕДЕЛЕНИЯ ДНЯ НЕДЕЛИ ПОВВЕДЕННОЙ ДАТЕ (начиная с 01.01.0001)}
Program calendar;
Uses
CRT;
Var
day,month,year, {заданная дата}
day1,month1,year1,{дата начала отсчета — 1.1.1}
IntWeek, {переменная для рассчета дня недели}
i:integer; {счетчик}
exit_:char; {переменная выхода}
StrWeek:string; {строка "день недели"}
error:boolean; {переменная, указывающая на ошибку при вводе данных пользователем}
{НАЧАЛО ОСНОВНОЙ ПРОГРАММЫ}
Begin
ClrScr;
{НАЧАЛО ОСНОВНОГО ЦИКЛА}
{ВВОД ГОДА}
Repeat
Write('Введите год '); ReadLn(year);
{ВВОД МЕСЯЦА, ПРОВЕРКА ВВЕДЕННОГО ЗНАЧЕНИЯ}
Repeat
error:=false;
Write('Введите месяц '); ReadLn(month);
If (month<1) or (month>12)
then
Begin
error:=true;
WriteLn('Месяц введен неверно, введите еще раз.');
End
Until error=false;
{ВВОД ЧИСЛА, ПРОВЕРКА ВВЕДЕННОГО ЗНАЧЕНИЯ}
Repeat
error:=false;
Write('Введите день '); ReadLn(day);
If (day<1)
then
Begin
error:=true;
WriteLn('Число введено неверно, введите еще раз.');
End;
If ((month=4) or (month=6) or (month=9) or (month=11)) and (day>30)
then
Begin
error:=true;
WriteLn('В заданном месяце только 30 дней, введите еще раз.');
End;
If (month=2) and ((year mod 4 <> 0) or ((year mod 100 = 0) and (year mod 400 <> 0))) and (day>28)
then
Begin
error:=true;
WriteLn('В заданном месяце только 28 дней, т.к. год не високосный, введите еще раз.');
End;
If (month=2) and (((year mod 4 = 0) and (year mod 100 <> 0)) or (year mod 400 = 0)) and (day>29)
Then
Begin
error:=true;
WriteLn('В заданном месяце только 29 дней, введите еще раз.')
End
Until error=false;
{РАССЧЕТНАЯ ЧАСТЬ}
day1:=1; month1:=1; year1:=1;
{рассчет без учета високосных годов и при условии, что все месяцы по 31 день}
IntWeek:=(day-day1)+(month-month1)*31 + (year-year1)*365;
{рассчет с учетом разной длины месяцев, а также возможности, что текущий год — високосный}
For i:=1 to month do
Case i of
3: Begin
If ((year mod 4 = 0) and (year mod 100 <> 0)) or (year mod 400 = 0)
then IntWeek:=IntWeek-2
else IntWeek:=IntWeek-3
end;
5: IntWeek:=IntWeek-1;
7: IntWeek:=IntWeek-1;
10: IntWeek:=IntWeek-1;
12: IntWeek:=IntWeek-1;
End;
{рассчет с учетом всех високосных годов и разной длины месяцев}
For i:=year1 to year do
If ((i mod 4 = 1) and (i mod 100 <> 1)) or (i mod 400 = 1)
then IntWeek:=IntWeek+1;
{определение дня недели по остатку}
IntWeek:=IntWeek mod 7;
Case IntWeek of
1: StrWeek:=', это понедельник.';
2: StrWeek:=', это вторник.';
3: StrWeek:=', это среда.';
4: StrWeek:=', это четверг.';
5: StrWeek:=', это пятница.';
6: StrWeek:=', это суббота.';
0: StrWeek:=', это воскресение.';
End;
{ВЫВОД ИНФОРМАЦИИ ДЛЯ ПОЛЬЗОВАТЕЛЯ}
WriteLn('Вы ввели дату ',day,'.',month,'.',year,StrWeek);
WriteLn('Для выхода нажмите Q, для продолжения — любую кнопку '); ReadLn(exit_);
Until (exit_='q') or (exit_='Q');
{КОНЕЦ ОСНОВНОГО ЦИКЛА}
{КОНЕЦ ОСНОВНОЙ ПРОГРАММЫ}
End.
Repeat'ы можешь поубирать и заменить 3 строками без проверок, если тебе важна компактность. Хотя, имхо, без них фигово %)
ну и задания у вас... я такое только на олимпиаде решал %)