program bio ; uses crt; const Size_of_Month: array [1..12] of byte = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); var d0, d, dd1, dd2, { День рождения, день текущий, день первый, день второй } m0, m, dm1, dm2, { Месяц рождения, месяц текущий, месяц первый, месяц второй } y0, y, dy1, dy2, { Год рождения, год текущий, год первый, год второй } days, dmin, dmax: integer; tstr: string[1]; Label L1; Procedure SplashScreen; var tmp: string[1]; begin textbackground (White) ; textColor (Red); ClrScr; gotoxy (20,1) ; Writeln('Вашему вниманию представляется программа, '); gotoxy (20,2) ; Writeln('которая рассчитывает биоритмы человека' ); gotoxy (20,3) ; Writeln('на заданный интервал времени.'); gotoxy (40,12) ; writeln('Программу составила студентка'); gotoxy (40,13) ; writeln('МГУ ПС группы ЭИЭ-111'); gotoxy (49,14) ; writeln('Громова Ирина'); gotoxy (40,15) ; writeln('г.Москва, 16.12.2007') ; gotoxy (20,24); writeln('Нажмите любую клавишу для продолжения'); read(tmp); ClrScr; end; procedure InputDates(var d0, m0, y0, d, m, y, dd1, dm1, dy1, dd2, dm2, dy2: integer); var correctly: boolean; procedure rDate(wel: string; var d, m, y: integer); const ymin = 1200; ymax = 2200; begin repeat Write('Введите ' + wel + ' в формате ДД ММ ГГГГ: '); ReadLn(d, m, y); correctly := (y >= ymin) and (Y <= ymax) and (m >= 1) and (m <= 12) and (d > 0); if correctly then if (m = 2) and (d = 29) and (y mod 4 = 0) then else correctly := d <= Size_of_Month[m]; if not correctly then WriteLn('Ошибка в дате'); until correctly; end; begin repeat rDate('дату рождения', d0, m0, y0); rDate('текущую дату', d,m,y); {Проверка на правильность введенных дат} correctly := y > y0; if not correctly and (y = y0) then begin correctly := m > m0; if not correctly and (y = y0) then begin correctly := m > m0; if not correctly and (m = m0) then correctly := d >= d0; end; end; until correctly; rDate('начальную дату диапазона поиска', dd1, dm1, dy1); rDate('конечную дату диапазона поиска', dd2, dm2, dy2); end; procedure getDays (d0, m0, y0, d, m, y: integer; var days: integer); Procedure mLoop; var mm: integer; begin mm := m0; while mm < m do begin days := days + Size_of_Month[mm]; if (mm = 2) and (y0 mod 4 = 0) then inc(days); inc(mm); end; end; procedure ymLoop; var mm, yy: integer; begin mm := m0 + 1; while mm <= 12 do begin days := days + Size_of_Month[mm]; if (mm = 2) and (y0 mod 4 = 0) then inc(days); inc(mm); end; yy := y0 + 1; while yy < y do begin days := days + 365; if yy mod 4 = 0 then inc(days); inc(yy); end; mm := 1; while mm < m do begin days := days + Size_of_Month[mm]; if (y mod 4 = 0) and (mm = 2) then inc(days); inc(mm); end; end; begin if (y = y0) and (m = m0) then days := d - d0 else begin days := d + Size_of_Month[m0] - d0; if (y0 mod 4 = 0) and (m0 = 2) then inc(days); if y = y0 then mLoop else ymLoop; end; end; procedure parseGraph(d0, m0, y0, dmin, dmax: integer); const pPhisics = 2*3.1416/23; pEmo = 2*3.1416/28; pIntellect = 2*3.1416/33; var dcurr, j, gw, gw5: integer; step: real; rP, rE, rI, r, fr: real; s, c: string; begin gotoxy (1, 7); if dmax < dmin then begin WriteLn('Ошибка: Начальная точка привышает конечную.'); exit; end; gw := WindMax and $FF - 12; for dcurr := dmin to dmax do begin rP := sin(dcurr * pPhisics); rE := sin(dcurr * pEmo); rI := sin(dcurr * pIntellect); {write(' ['); write(rP); write(' | '); write(rE); write(' | '); write(rI); write('] '); WriteLn;} s:=''; for j:=1 to gw do s:=s+' '; s[Trunc(1/2*gw+1)]:='|'; s[Trunc((rP+1)/2*gw+1)]:='p'; s[Trunc((rE+1)/2*gw+1)]:='e'; s[Trunc((rI+1)/2*gw+1)]:='i'; WriteLn(dd1:2,dm1:3,dy1:5,' :',s,':'); Inc(dd1); if dd1>Size_of_Month[dm1] then begin dd1:=1; Inc(dm1); if dm1>12 then begin dm1:=1; Inc(dy1) end end; end; gw5 := Trunc(gw / 5); step:= 10. / gw; Write('=========='); r := -1; for j := 1 to gw5 do begin if r < 0 then Write('-'); fr := Frac(r); str(Round(abs(r - fr)), c); Write(c[1]); str(Round(abs(fr) * 10), c); Write('.'); Write(c[1], '='); if r >= 0 then Write('='); r := r + step end; for j := gw5 * 5 to gw do Write('='); Write(1); Write('>'); end; BEGIN SplashScreen; InputDates(d0, m0, y0, d, m, y, dd1, dm1, dy1, dd2, dm2, dy2); getDays(d0, m0, y0, d, m, y, days); getDays(d0, m0, y0, dd1, dm1, dy1, dmin); getDays(d0, m0, y0, dd2, dm2, dy2, dmax); parseGraph(d0, m0, y0, dmin, dmax); read(tstr); END.