Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 20.12.2007, 02:09   #1
Farfalla
 
Регистрация: 20.12.2007
Сообщений: 6
Вопрос Биоритмы

Помогите, пожалуйста, с графикой. Насколько я поняла и мне объяснили, мне нужны три графика, отображающих три состояния. Не получается..
И еще: если можно пойти каким-нибудь более легким путем - подскажите, пожалуйста..
Задача:
Цитата:
Составить программу отражения биоритмов человека на заданный интервал времени. Известно, что физическое, эмоциональное и умственное состояния изменяются со дня рождения циклически с периодом 23, 28, 33 дня соответственно. Состояние для Д-го дня со дня рождения определятся по формуле: y=sin(x1),
где x1=(Д/Р - [Д/Р])*2П при P=23,28,33.
[Д/Р] - целая часть от деления

То, что имеем:
Код:
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];

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);
 {test for correct input}
 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.6884;
 pEmo       = 2*3.1416/28.4261;
 pIntellect = 2*3.1416/33.1638;
var
 dall, dcurr, i: integer;
 rP, rE, rI: real;
begin
 dall := dmax - dmin;
 if dall < 0 then begin
  WriteLn('Ошибка: Начальная точка периода привышает конечную.');
 end;
 for i := 0 to dall do
 begin
  dcurr := dmin + dall;
  rP := sin(dcurr * pPhisics);
  rE := sin(dcurr * pEmo);
  rI := sin(dcurr * pIntellect);
  write(' ['); write(rP); write(' | '); write(rE); write(' | ');
  write(rI); write('] ');
 end
end;


BEGIN
{ main proc. }
  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.

Последний раз редактировалось Farfalla; 20.12.2007 в 02:13.
Farfalla вне форума Ответить с цитированием
Старый 20.12.2007, 15:14   #2
n@sok
Пользователь
 
Регистрация: 24.11.2007
Сообщений: 46
По умолчанию

Код:
program bioritms;
uses Graph,Dos;
label wwod;
const
  twopi=2*Pi;
  days:array [1..12] of byte = 
(30,28,31,30,31,30,31,31,30,31,30,31);
var
  a,k,d,m,y,d1,m1,y1:word;
  gd,gm:integer;
  dd:longint;

procedure axis;
var
  j,stroke:integer;
  s:string[2];
begin
  line(0,140,0,340);
  line(0,240,a*20,240);
  for j:=1 to a do
    begin
      stroke:=5; str(j,s);
      if j mod 5 = 0 then stroke:=10;
      line(j*20,240+stroke,j*20,240-stroke);
      if stroke=10 then outtextxy(j*20-5,240+20,s);
    end;
end;

procedure grafik(t,dfi,color:integer);
var
  x,y,x1,y1,k:integer;
begin
  x:=0;
  y:=round(240-100*sin(twopi*dfi/t));
  setcolor(color);
  moveto(x,y);
  for k:=1 to a do
    begin
      x1:=20*k;
      y1:=round(240-100*sin(twopi*(k+dfi)/t));
      lineto(x1,y1);
    end;
end;

function offset(d,m,y:integer):longint;
{Вычисляет количество дней от 1.01.1900 до d.m.y}
var
  k:integer;
  dd:longint;
begin
  dd:=365;  {Количество дней в 1900 г}
  {Цикл учета полных лет}
  for k:=1901 to y-1 do
    begin
      dd:=dd+365;
      {Поправка на високосный год}
      if k mod 4 = 0 then inc(dd);
    end;
  {Учет дней в году y до месяца m}
  for k:=1 to m-1 do  inc(dd,days[k]);
  offset:=dd+d; {Добавление дней, прошедших в месяце m}
end;

begin
  gd:=0;
wwod:
  writeln('Биоритмы на текущий месяц');
  writeln('Введите день, месяц (числом) и год своего рождения');
  readln(d,m,y);
  GetDate(y1,m1,d1,k); {опрос текущей даты}
  if (m<1)or(m>12)or(d<1)or(d>days[m])or(y<1900)or(y>y1) then
    begin
      write('Вы ошиблись. Нажмите Enter и повторите ввод');
      readln;  goto wwod;
    end;
  if y1 mod 4 = 0 then days[2]:=29; {поправка на високосный год}
  a:=days[m1]; {число дней в текущем месяце}
 {Интервал от дня рождения до начала текущего месяца}
  dd:=offset(1,m1,y1)-offset(d,m,y);
  initgraph(gd,gm,'C:\');
  outtextxy(0,0,'красный - физическое состояние');
  outtextxy(0,20,'синий - эмоциональное состояние');
  outtextxy(0,40,'зеленый - интеллектуальное состояние');
  axis;  {Построение и разметка координатных осей}
  grafik(23,dd mod 23,RED);
  grafik(28,dd mod 28,GREEN);
  grafik(33,dd mod 33,BLUE);
  readln;
  closegraph;
end.
n@sok вне форума Ответить с цитированием
Старый 20.12.2007, 17:59   #3
Farfalla
 
Регистрация: 20.12.2007
Сообщений: 6
По умолчанию

А у меня не работает =(
Farfalla вне форума Ответить с цитированием
Старый 20.12.2007, 18:09   #4
n@sok
Пользователь
 
Регистрация: 24.11.2007
Сообщений: 46
По умолчанию

Цитата:
А у меня не работает =(
А что именно не работает? Скорее всего строчка
initgraph(qd,qm,'C:\')
здесь вместо C:\ надо прописать путь к файлам .bgi
n@sok вне форума Ответить с цитированием
Старый 22.12.2007, 01:06   #5
Farfalla
 
Регистрация: 20.12.2007
Сообщений: 6
По умолчанию

Всё сделала, но теперь там проблема со шрифтами..Пыталась настроить - не получилось. Сначала вводит нормально, а после построения графика абракадабра =(
Farfalla вне форума Ответить с цитированием
Старый 22.12.2007, 01:16   #6
n@sok
Пользователь
 
Регистрация: 24.11.2007
Сообщений: 46
По умолчанию

Это связано с таблицой знакогенератора в DOS, которая не содержит русских букв. Поэтому при переходе в графический режим все русские буквы будут выводиться в виде абракадабры. С этим придется смириться или использовать латинские буквы при выводе сообщений.
n@sok вне форума Ответить с цитированием
Старый 23.12.2007, 23:48   #7
Farfalla
 
Регистрация: 20.12.2007
Сообщений: 6
По умолчанию

Спасибо большое!
Farfalla вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц