![]() |
1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!
![]() ![]() |
![]() |
deniskavdv |
![]()
Сообщение
#1
|
Группа: Пользователи Сообщений: 1 Пол: Мужской Реальное имя: Денис Репутация: ![]() ![]() ![]() |
Подскажите как можно сделать чтоба в программе биоритм человека выводились синусоиды разных цветов.
Пока что с помощью интернета и учебника смог изобразить график буквами Код 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, { Den rozhdeniya, den tekushchiy. } m0, m, dm1, dm2, { Depeche Mode..;) } 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('Vashemu vnimaniyu predstavlyayetsya programma, '); gotoxy (18,2); Writeln('kotoraya rasschityvayet bioritmy cheloveka' ); gotoxy (20,3); Writeln('na zadannyy interval vremeni'); gotoxy (40,12); writeln('Programmu sostavil student Volokhin Denis'); gotoxy (40,13); writeln(''); gotoxy (49,14); writeln(''); gotoxy (40,15); writeln(''); gotoxy (20,24); writeln('Nazhmite lyubuyu klavishu dlya prodolzheniya'); read(tmp); ClrScr; end; procedure iDates(var d0, m0, y0, d, m, y, dd1, dm1, dy1, dd2, dm2, dy2: integer); var isCorr: boolean; procedure rDate(wel: string; var d, m, y: integer); const ymin = 1800; ymax = 2200; begin repeat Write('Vvedite ' + wel + ' v formate DD MM GGGG: '); ReadLn(d, m, y); isCorr := (y >= ymin) and (Y <= ymax) and (m >= 1) and (m <= 12) and (d > 0); if isCorr then if (m = 2) and (d = 29) and (y mod 4 = 0) then {foo bar, ibo etogo dnya ne sushchestvuyet..} else isCorr := d <= Size_of_Month[m]; if not isCorr then WriteLn('Oshibka v date'); until isCorr; end; begin repeat rDate('datu rozhdeniya', d0, m0, y0); rDate('tekushchuyu datu', d,m,y); {test for corr. input} isCorr := y > y0; if not isCorr and (y = y0) then begin isCorr := m > m0; if not isCorr and (y = y0) then begin isCorr := m > m0; if not isCorr and (m = m0) then isCorr := d >= d0; end; end; until isCorr; rDate('nachalnuyu datu diapazona poiska', dd1, dm1, dy1); rDate('konechnuyu datu diapazona poiska', 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.6884; pEmo = 2*3.1416/28.4261; pIntellect = 2*3.1416/33.1638; var dall, dcurr, i, j, gw: integer; rP, rE, rI: real; s: string; begin dall := dmax - dmin; if dall < 0 then WriteLn('Oshibka: Nachalnaya tochka privyshayet konechnuyu.'); gw:=WindMax and $FF -12; for i := 0 to dall do begin dcurr := dmin + i; rP := sin(dcurr * pPhisics); rE := sin(dcurr * pEmo); rI := sin(dcurr * pIntellect); s:=''; for j:=1 to gw do s:=s+' '; 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; writeln (' 100 80 60 40 20 0 -20 -40 -60 -80 -100 '); writeln ('p-fisicheskiy, e-emotsionalnyy, i-intellektualnyy '); end; BEGIN { main proc. } SplashScreen; iDates(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. |
![]() ![]() |
![]() |
Текстовая версия | 28.07.2025 16:19 |