Кетхоум

07:16
Онлайн 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
    ну и задания у вас... я такое только на олимпиаде решал %)

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