IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Помогите откорректировать задачу биоритм
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 1
Пол: Мужской
Реальное имя: Денис

Репутация: -  0  +


Подскажите как можно сделать чтоба в программе биоритм человека выводились синусоиды разных цветов.
Пока что с помощью интернета и учебника смог изобразить график буквами

Код

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.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 23.12.2024 21:22
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name