Кетхоум

10:13
Онлайн 3

Help me :)

  • Комментариев: 3
  • Рейтинг: 8

Есть задание по Паскалю :

Создать универсальный календарь ,вводишь день ,год и месяц и должно выдать день недели с учётом весокосных годов,также условие ,что каждый год,который делится на 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)

  • 1

    А что не работает?

  • 2

    А!!! Паскаль )) Я за ним уже соскучилась, тебе сегодня повезло, у меня настроение хорошее ))
    Хз, чо ты там понаписал, не хочу я разбираться в коде без комментов %) Привыкай описывать хоть основные части, это должно происходить на автомате, имхо, легче заново написать, чем разбирать, что где как обозвали %)
    Смотрю, ты или процедуры/функции еще не освоил, или просто их не любишь... Написала из рассчета "не освоил", сам переделаешь, если чО ))

    {ПРОГРАММА ДЛЯОПРЕДЕЛЕНИЯ ДНЯ НЕДЕЛИ ПОВВЕДЕННОЙ ДАТЕ (начиная с 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 строками без проверок, если тебе важна компактность. Хотя, имхо, без них фигово %)

  • 3

    ну и задания у вас... я такое только на олимпиаде решал %)

Необходимо авторизоваться, чтобы оставить свой комментарий.