Практика программирования (Бейсик, Си, Паскаль)

       

Написать программу, которая рисует на


Задание 8.14. Построение шахматной доски

Написать программу, которая рисует на экране шахматную доску. Идея программы подсказана К. Э. Садыровым, однако мы предпочли другую реализацию с целью демонстрации идентичных программ на разных языках.

Совет 1 (общий)

Структура программы мало чем отличается от программ, демонстрировавших палитру (см. выше). Единственная тонкость заключается в организации правильного чередования цвета заливки смежных квадратов как в пределах строки, так и при переходе на следующую строку. Для этой цели использован прием "мерцающего бита". При каждом повторении внутреннего цикла величина col принимает чередующиеся значения 7 или 8 (в "мерцающем бите" аналогичная операция выглядела бы так: bit=l- bit или bit:=not bit). Если такое же действие не было бы предусмотрено и во внешнем цикле, то две смежные линейки начинались бы с квадратов одинакового цвета.

Совет 2 (QBasic)

Для подчеркивания границ каждого поля доски приходится сначала заливать очередную клетку, а потом обводить ее границу.

Совет 3 (Си, Паскаль)

Построение залитого поля с одновременной обводкой его границы можно выполнить процедурой bar3d с нулевой глубиной трехмерного столбика.

Программа 8_14.bas

RЕМ Построение шахматной доски DEFINT A-Z SCREEN 12

х0=10: у0=10: col=8: w=50
F0R y=y0 T0 y0+7*w STEP w
col=15-col F0R x=x0 T0 x0+7*w STEP w



LINE (x,y)-(x+w,y+w),col,BF :' Заливка клетки
LINE (x,y)-(x+w,y+w),15,В :' 0бводка границ col=15-col:
' Цвет для смежной клетки NEXT x NEXT у

Программа 8_14.с

/* Построение шахматной доски */
#include <stdio.h>
#include <conio.h>
#include <graphics.h>

main() {

int x,y,x0=10,y0=10,col=8,w=50;

int gd=0,gm;

initgraph(Sgd,&gm,"");

for(y=y0; y<y0+8*w; y+=w)

{
col-15-col;

for(x=x0; x<x0+8*w; xt=w) {

setfillstyle(1,col);

bar3d(x,y,x+w,y+w,0,1); /* 0бводка и заливка клетки */
col=15-col; /* Цвет для смежной клетки */ } }

getch();
closegraph(); }


Программа 8_14.pas

program shach;

{ Построение шахматной доски } uses Graph;
const

x0=10;
y0=10;
w=50;
col:integer=8;
var

i,j,gd, gm,x,у:integer;
begin gd:=0;

initgraph(gd,gm,' ') ;
for i:=0 to 7 do begin

col:=15-col;
y:=y0+i*w;
for j:=0 to 7 do begin

x:=x0+j *w;

setfillstyle(1,col);

bar3d(x,y,x+w,y+w,0,true);
{ 0бводка и заливка клетки }
col:=15-col;
{ Цвет для смежной клетки }
end;
end;
readln;
closegraph;
end.

Задание 8.15. 0тображение семисегментныхцифр

В электронных часах с цифровым индикатором цифры формируются как комбинации из семи сегментов (рис 8.3). Составить функцию (процедуру) cifra, которая по заданным координатам (х,у) и числовому значению цифры k (о <= k <= 9) формирует на экране ее графическое изображение.

Совет 1 (общий)

Выберем в качестве точки привязки (х,у) вершину семисегментной комбинации, расположенную в левом верхнем углу. 0чевидно, что для плотного примыкания смежных горизонтальных и вертикальных сегментов их срезы должны быть направлены под углами 45 и 135 градусов.




Рис. 8.3. Горизонтальный и вертикальный сегменты цифр

Если пронумеровать точки контура одного сегмента от 0 до 6 по часовой стрелке от самой левой (для горизонтальных) или самой верхней (для вертикальных) и считать, что начальная точка имеет координаты (х0.у0), то координаты остальных точек можно рассчитать, используя относительные смещения, приведенные в табл. 8.4. Через а и ь здесь обозначены смещения по координатным осям для наклонных и горизонтальных (вертикальных) ребер контура. Задавая различные числовые значения этих параметров, можно строить сегменты нужного размера. Удобно выбирать b = 4*а, хотя не возбраняются и любые другие соотношения. В последующих расчетах нам понадобится и константа с = = 2*а. + b, представляющая максимальную длину (высоту) сегмента.


Таблица 8.4. Расчет координат точек с использованием

относительного смещения



Номер точки

Смещения по координатам относительно предыдущей точки

Для горизонтального сегмента

Для вертикального сегмента

По х

По у

Пох

По у
  0 0 0 0
  а а а

0 1 2


b


0


0


b

<




Номер точки

Смещения по координатам относительно предыдущей точки

Для горизонтального сегмента

Для вертикального сегмента

По х

По у

Пох

По у

3


а


а





а


4





а








5


-b


0


0


-b


Из табл. 8.4 видно, что при реализации программы достаточно иметь всего два массива смещений:

d1 = (0, а,b, а,-а,-а) и d2 = (0,-а, 0, а, а, 0)

Для вертикального сегмента они меняются местами и у одного из них меняются знаки.

Установим соотношения между точкой привязки цифры и координатами начальных точек каждого из семи сегментов. Пронумеруем сверху вниз числами 1, 2 и 3 горизонтальные сегменты, а числами 1, 2, 3 и 4 — вертикальные сегменты слева направо и сверху вниз. Несложно убедиться в том, что координаты их нулевых вершин вычисляются следующим образом.

Для горизонтальных сегментов:
xl = х х2 = х х3= х

yl = у у2 = у + с уЗ = у + 2*с
Для вертикальных сегментов:

xl=x х2=х+с х3=х х4 = х + с

yl = у у2 = у у3 = у + с у4=у + с

Совет 2 (Си)

Для того-чтобы установить соответствие между числовым значением отображаемой цифры и составляющим ее набором сегментов, предлагается использовать семиразрядные двоичные числа, единичные разряды в которых устанавливают присутствие того или иного сегмента. Например, контур цифры 0 образуется первым и третьим горизонтальными сегментами и всеми четырьмя вертикальными. Поэтому цифре 0 можно поставить в соответствие код 1011111. Цифра 9 описывается кодом 1111101 и т. д. В приведенном ниже тексте программы на Си эти коды представлены не самым рациональным способом — в виде двумерного массива. Более оптимальный вариант предложен в следующем задании:

Программа 8_15.с

/* Построение 7-сегментных цифр */
#include <stdio.h>

#include <conio.h>

#include <graphics.h>

void cifra(int x,int y,int n) ;

void main() {

int gd=0,gm, k;
initgraph(&gd,&gm,"");
setcolor(4);
for(k=0;k<10;k++)

cifrat(k+1)*50,30,k) ; getch(}; return;


}

/*-----------------------------* /

void cifra(int x,int y,int n)

{

const a=4,b=20,c=a+a+b; //габариты сегмента
const dl[]={a,b,a,-a,-b}; //приращения по координатам
const d2 [] = {-a,_0,a,a, 0}; //приращения по координатам
const dx[]={0,0,0,0,с,0,с}; //смещения начальных1 вершин по х
const dy [] = {0, с, 2*с, 0, 0, с, с}; //смещения начальных вершин по у
int j, k; struct {int x;int у;} ху[6]; //координаты точек контура
char q[10][7]={ {1,0,1,1,1,1,1}, //перемычки цифры 0
{0,0,0,0,1,0,1},{1,1,1,0,1,1,0}, //перемычки цифр 1,2
{1,1,1,0,1,0,1},{0,1,0,1,1,0,1}, //перемычки цифр 3,4
{1,1,1,1,0,0,1},{!,1,1,1,0,1,1}, //перемычки цифр 5,6
{1,0,0,0,1,0,1},{1,1,1,1,1,1,1}, //перемычки цифр 7,8
{1,1,1,1,1,0,1}}; //перемычки цифры 9

for(j=0; j<7; j++) {

if(q[n][j]==0) continue;
xy[0].x=x+dx[j];
xy[0].y=y+dy[j];
for(k=l; k<6;k++)

{// цикл вычисления координат точек контура if(j<3)

{//пересчет для горизонтальных перемычек
xy[k].x=xy[k-l].x+dl[k-l];
xy[k].y=xy[k-l].y+d2[k-l]; }
else

{//пересчет для вертикальных перемычек
xy[k].x=xy[k-l].x-d2[k-l];
xy[k].y=xy[k-l].y+dl[k-l]; } }

fillpoly(6,(int *)xy); //заливка перемычки

} }

Задание 8.16. Цифровые часы

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

Попытка использовать предыдущую программу cifra сразу же выявляет ее недостаток. 0на хорошо "рисует" цифры на чистом экране, но в часах приходится строить новую цифру поверх уже нарисованной. Поэтому в самом начале процедуры придется стереть предыдущее изображение, например с помощью процедуры bar.

Совет 1 (Паскаль)

Показания системных часов в Паскале можно опросить с помощью процедуры gettime. Для того чтобы исключить излишнее мигание на экране, целесообразно перерисовывать цифры часов, минут или секунд только при их изменении. С этой целью в программе предусмотрен двойной набор переменных для хранения предыдущего (hl.ml.sl) и текущего (h2,m2,s2) показаний часов. В начале работы программы в первый набор заносятся невообразимые значения, поэтому первое же обращение к gettime вызовет перерисовку всех трех цифр и запоминание нормальных значений часов, минут и секунд. В последующих циклах будут перерисовываться только те цифры, значения которых изменились.


Совет 2 (Паскаль)

Позиции цифр на экране и двоеточия, разделяющего часы, минуты и секунды, подбирались экспериментальным путем. В программе не очень изящно реализовано отображение двоеточия. Было бы лучше, если бы оно мигало с частотой раз в секунду. Но усовершенствования такого рода мы вполне доверяем читателям.

Совет 3 (Паскаль)

В отличие от приводившейся выше функции cifra здесь использован одномерный массив двоичных чисел, что уменьшает объем используемых данных и несколько ускоряет работу программы (операции с элементами одномерных массивов выполняются быстрее). Прощупывание двоичных битов ведется в цикле путем сдвига соответствующей константы на нужное число разрядов влево и логического умножения на код соответствующих перемычек.

Совет 4 (Паскаль)

Программа оформлена в виде бесконечного цикла, работа которого прерывается нажатием любой клавиши.

Программа 8_16.pas

program time;

uses Crt, Dos, Graph;

var

gd,gm,k:integer;

hi,ml,si,h2,m2,s2,hs2:word;
procedure cifra(x,y,n:integer); type

a4=array [0..4] of integer;

a6=array [1..7] of byte; const

a=4; b=20; c=a+a+b;

dl:a4=(a,b,a,-a,-b);

d2:a4=(-a,0,a,a,0);

dx:a6=(0,0,0,0,c,0,c);

dy:a6=(0,c,2*c,0,0,c,c);

q:array[0..9]of byte=

($5F,$5,$76,$75,$2D,$79,$7B,$45,$7F,$7D); var

xy:array [0..5] of PointType;

j,k,d:byte; begin

setfillstyle(0,0);

bar(x-a,y-a,x+(c+a+a),y+2*(c+2*a));

d:=q[n];

for j:=1 to 7 do begin

if ((d) and ($80 shr j))=0 then continue;

ху[0]. х:=x+dx[j];
ху[0].y:=y+dy[j];
for k:=l to 5 do if j<4 then begin

xy[k].x:=xy[k-l].x+dl[k-l];

xytk].y:=xy[k-l].y+d2[k-l];
end
else
begin

xy[k].x:=xy[k-l].x-d2[k-l];

xy[k].y:=xy[k-l].y+dl[k-l];
end;
setfillstyle(l,14);
fillpoly(6,xy);
end;
end;

begin gd:=0;

initgraph(gd,gm,'');
settextstyle(0,0,4);
setcolor(14);

outtextxy(136,44,':');
{ Разделитель часов и минут }
outtextxy(256,44,':');
{ Разделитель минут и секунд }
setcolor(4);

hi:=100; { Начальные установки }
ml:=100;
sl:=100;


repeat

gettime(h2,m2,s2,hs2); ( 0прос текущего времени }
if hloh2 then begin { Если изменились часы }

k:=h2 div 10;
cifra(50,30,k);
{ Старшая цифра часов }
k:=h2 mod 10;
cifra(100,30,k); { Младшая цифра часов }
hi:=h2; end;

if ml<>m2 then begin { Если изменились минуты }
k:=m2 div 10; cifra(170,30,k);
k:=m2 mod 10; cifra(220,30,k);
ml:=m2;

end;

if sl<>s2 then begin { Если изменились секунды }
k:=s2 div 10;
cifra(290,30,k);

k:=s2 mod 10; cifra(340,30,k);
sl:=s2; end;

unit1 KeyPressed;
closegraph;

end.

Задание 8.17. Графические спрайты

Спрайты (от англ. Sprite — "дух, привидение") представляют собой небольшие графические изображения, перемещаемые по экрану для имитации движущихся фигур или предметов. Без спрайтов не обходится ни одна динамическая игра. Для некоторых изображений достаточно единственного спрайта, который просто перемещается по заданной траектории. Таким спрайтом, например, может быть изображение летящего самолета. В других случаях приходится манипулировать цепочкой спрайтов, на которых зафиксированы отдельные кадры, соответствующие разным фазам движения.

0сновная идея простейших программ анимации заключается в организации быстрой смены кадров на экране, при которой отображаются последовательные фазы изменения состояния фигуры и производится ее перемещение. При этом крайне нежелательно, чтобы спрайты "затирали" находящийся под ними интерьер. Последнее достигается за счет разумного подбора цветовых оттенков как спрайта, так и фона, и вывода спрайтов в режиме X0R.

Продемонстрируем технику перемещения единственного спрайта —"летающей тарелки" на фоне "звездного неба". Увеличенное изображение "тарелки" было нарисовано на миллиметровой бумаге в прямоугольной области размером 43x24 мм и представляло собой эллипс с полуосями 20 и 8 мм, внутри которого проходил эллиптический поясок (дуга эллипса со смещенным центром). Из "корпуса" тарелки под небольшими углами расходились отрезки прямых — стойки локаторов, на концах которых размещались две круговые "антенны" - кружочки небольшого радиуса (2 мм). Контуры тарелки рисуются белым цветом, а внутренность корпуса заливается красным цветом.


Совет 1 (общий)

Для создания образа спрайта в оперативной памяти поступим следующим образом. Сначала воспроизведем спрайт в любом месте экрана и запомним содержимое соответствующего участка видеопамяти в массиве соответствующего размера (в QBasice — оператор GET, на Си или Паскале — процедура getimage). Затем повторно выведем спрайт на то же место экрана в режиме X0R для стирания статичного изображения.

Совет 2 (общий)

Для имитации звездного неба построим 1000 случайных точек на экране, окрашенных в случайные цвета.

Совет 3 (общий)

0рганизуем бесконечный цикл, в котором изображение тарелки на небольшое время (порядка 0,6 с) появляется в некоторой точке с координатами (х,у), а затем стирается. После этого точка (х,у) смещается на случайные перемещения (dx.dy) и цикл повторяется до нажатия какой-либо клавиши пользователем. Для того чтобы перемещения из текущей точки в следующую выглядели случайными, можно менять знаки приращений dx и dy, когда они оказываются четными или нечетными. Кроме того, необходимо организовать проверку очередной точки на принадлежность экрану и запретить ее выход из допустимого интервала.

Совет 4 (QBasic)

В связи с тем, что задержка по оператору SLEEP может быть организована только с точностью до секунды, предлагается воспользоваться оператором S0UND f, dt. 0н организует выдачу звукового сигнала с частотой f Гц, длящегося dt тиков (в 1 с содержится 18,2 тика). А чтобы звук не доставлял неприятностей, можно выбрать частоту, не воспринимаемую человеческим ухом (например, f = 32767 Гц).

Программа 8_17.bas

REM Летающая тарелка

DEFINT A-Z

DIM TARELKA(300)

Х=320: Y=240

SCREEN 12

CIRCLE (100,50),20,15,,,.4

PAINT (100,50),4,15

CIRCLE (100, 46); 20,15, 3.3,0, .3

LINE (107,44)-(110,38) ,15

CIRCLE (110,38),2,15

LINE (93,44)-(90,38),15

CIRCLE (90,38),2,15

' Запомнили образ

GET (79,36)-(121,59),TARELKA

' Стерли

PUT (79,36),TARELKA,X0R

' Построение звездного неба

F0R I=0 T0 1000

PSET (INT(RND*639)+1,INT(RND*473)+1),INT(RND*15) +1


NEXT I

D0 WHILE INKEY$=""

PUT (X,Y),TАРЕЛКА, X0R :

S0UND 32767,4.92 ;' Задержка на 0.6 сек

PUT (A,Y),TAKELKA,X0R ;' Стирание тарелки

DX=INT(RND*60)+1: IF DX M0D 2=1 THEN DX=-DX

X=X+DX :' Смещение по горизонтали

IF X>590 THEN X=590 :' Контроль за правой границей экрана

IF X<0 THEN X=0 :' Контроль за левой границей экрана

DY=INT(RND*40)+1: IF DY M0D 2=1 THEN DY=-DY

Y=Y+DY :' Смещение по вертикали

IF Y>450 THEN Y=450 :' Контроль за нижней границей экрана

IF Y<0 THEN Y=0 :' Контроль за верхней границей экрана

L00P

END

Программа 8_17.с

/* Летающая тарелка */ #include <graphics.h> #include <stdlib.h>

main() {

int x=320, y=240, i, dx, dy, gd=0, gm;

char Tarelka[600];

initgraph(&gd,&gm,"");

randomize() ; /* Построение летающей тарелки */

setfillstyle( S0LID_FILL, 4);

fillellipse(100, 50, 20, 8) ;

ellipse(100, 46, 190, 357, 20, 6) ;

line(107, 44, 110, 38);

circle(110, '38, 2} ;

line(93, 44, 90, 38);

circle(90, 38, 2); /* Запомнили изображение и стерли его */

getimage(79, 36, 121, 59, Tarelka);

putimage(79, 36, Tarelka, X0R_PUT); /* Построение звездного неба */

for ( i=0 ; i<1000; ++i )

putpixel(random(639), random(479), random(15)+1) ; while ( !kbhit() ) { /* Бесконечный цикл до нажатия клавиши */

putimage(x, у, Tarelka, X0R_PUT);
/* вывод тарелки */
delay(6000);
/* задержка */

putimage(x, у, Tarelka, X0R_PUT);
/* стирание тарелки */
/* Перемещение тарелки */
dx = random(60);
if (dx % 2 == 0 ) dx = - dx;
x = x + dx;
if (x > 590) x = 590;
else if (x < 0) x = 0; dy = random(40);
if (dy % 2 == 0 ) dy = - dy; у = у + dy;
if (y > 450) у = 450;
else if (y < 0) у = 0; }

getch(); }

Программа 8_17.pas

{ Программа "Летающая тарелка" } program nlo; uses Crt,Graph; var

x, y, i, dx, dy, gd, gm: integer;

Tarelka:array [1..600] of byte; begin

x:=320;

y:=240;

gd:=0;

initgraph(gd,gm,'');

randomize; { Построение летающей тарелки }


setfillstyletSolidFill, 4);

fillellipse(100, 50, 20, 8) ;

ellipse(100, 46, 190, 357, 20, 6);

line(107, 44, 110, 38);

circle (110, 38, 2); line(93, 44, 90, 38); circle(90, 38, 2);

{ Запомнили изображение и стерли его }
getimage(79, 36, 121, 59, Tarelka);
putimage(79, 36, Tarelka, X0Rput);
{ Построение звездного неба }
for i:=0 to 1000 do

putpixel(random(639), random(479), random(15}+1);
repeat { Бесконечный цикл до нажатия клавиши }

putimage(х,у,Tarelka,X0Rput);
{ вывод тарелки }

delay(6000);
{ задержка }

putimage(х,у,Tarelka,X0Rput);
{ стирание тарелки }
( Перемещение тарелки }

dx:=random(60);

if odd(dx) then dx:=- dx;

x:=x+dx;

if x>590 then x:=590;

if x<0 then x:=0;

dy:=random(40);

if odd(dy) then dy:=- dy;

y:=y+dy;

if y>450 then y:=450;

if y<0 then y:=0;
until KeyPressed;
closegraph;
end.

Задание 8_18. Биоритмы

Некоторые исследователи утверждают, что каждому человеку присущи три периодических процесса, сопровождающие его жизнь с момента рождения. Первый из них с периодом 23 дня соответствует физическому состоянию, второй с периодом 28 дней — интеллектуальному, третий с периодом 33 дня — эмоциональному. По каждому процессу можно построить график, отложив по горизонтальной оси время Т в днях с момента рождения, а по вертикальной оси — амплитуду синусоиды со своим периодом:

PH=SIN(2*PI*T/23)
IN=SIN(2*PI*T/28)
EM=SIN(2*PI*T/33)

Совместив все графики на общем рисунке, можно определить моменты общего подъема или спада потенциала человека. 0собого единства в трактовке "плохих" интервалов жизни человека нет. 0дни считают, что к "черным" дням относятся моменты, когда все три кривые одновременно или в достаточно узком интервале пересекают ось времени, другие склонны рассматривать в качестве дней депрессии моменты, когда все кривые имеют общую или близкую точку минимума.

Составим программу построения графика биоритмов на текущий месяц по заданной дате рождения. Для упрощения анализа високосных лет будем считать, что эта дата относится к XX столетию. Тогда можно ограничиться проверкой остатка от деления последующих лет на 4.


Совет 1 (общий)

С целью структурирования программы, кроме ее главной части целесообразно выделить в отдельные функции следующие процедуры:

  • offset — определение количества дней, прошедших от 1.01.1900 г. до заданной даты (dd — день, mm — месяц, уу — год);

  • axis — построение осей для графика биоритмов с нанесением рисок по горизонтальной оси и числовых меток, упрощающих определение дня текущего месяца;

  • grafik — построение графика синусоиды с заданными периодом т и начальным смещением df 1, окрашенной в указанный цвет.

    Совет 2 (общий)

    Алгоритм процедуры offset может быть самым примитивным. Например, можно прибавлять к сумме по 365 дней за каждый полностью прошедший год и компенсировать добавочным днем каждый високосный. В начале работы в сумму заносим 365 — число дней в невисокосном 1900 году. В текущем году количество дней подсчитываем с помощью массива days, задающего количество дней в каждом месяце. Нужно только откорректировать число дней февраля (days [1] = 29), если текущий год является високосным.

    Совет 3 (общий)

    Для определения текущей даты можно воспользоваться одной из функций, предлагаемых соответствующей системой программирования — DATE$ (QBasic), getdate (Си), GetDate (Паскаль).

    Совет 4 (QBasic)

    Самым неудобным моментом в программе является подбор положения цифровых меток у графических штрихов на оси х. К сожалению, кроме метода проб и ошибок, мы не можем предложить ничего разумного. Дело в том, что оператор L0CATE позиционирует курсор в терминах строка-столбец, а графика оперирует с пикселами. Поэтому приходится слегка смещать либо положение рисунка, либо положение подписи.

    Совет 5 (Си)

    Для абсолютной идентичности результатов программ на Си и Паскале пришлось написать очень нехитрую функцию round, округляющую вещественный аргумент до ближайшего целого числа. К сожалению, воспользоваться напрямую одной из библиотечных функций floor или ceil нельзя.

    Совет 6 (Паскаль)

    0братите внимание на то, что в графическом режиме мы не пользуемся процедурами и функциями модуля Crt, ибо они конфликтуют с процедурами модуля Graph. В отличие от этого в Си, например, функция gotoxy прекрасно работает и в графическом режиме.


    Программа 8_18.bas

    DECLARE SUB AXIS()

    DECLARE SUB GRAFIK(t!,dfi!,col!)

    DECLARE FUNCTI0N 0FFSET!(d!,m!,у!)

    REM Построение биоритмов на текущий месяц

    DATA 30,28,31,30,31,30,31,31,30,31,30,31

    DIM SHARED days(11),a

    F0R k=0 T0 11: READ days(k): NEXT k

    wwod:

    PRINT "Биоритмы на текущий месяц"

    PRINT "Введите день, месяц (числом) и год своего рождения"

    INPUT d,m,у

    d$=DATE$: ml=VAL(LEFT$(d$,2)) : dl=VAL(MID$(d$, 4, 2))

    yl=VAL(RIGHT$(d$, 4))

    IF (m<l)0R(m>12)0R(d<l)0R(d>days(m))0R(y<1900)0R(y>yl) THEN

    PRINT "Вы ошиблись. Повторите ввод"

    SLEEP 1: G0T0 wwod END IF

    IF (y1 M0D 4)=0 THEN days(2)=29:' поправка на високосный год
    a=days(ml):' число дней в текущем месяце
    ' Интервал от дня рождения до начала текущего месяца
    dd=0FFSET(l,ml,yl)-0FFSET(d,m,у) SCREEN 12

    PRINT "красный - физическое состояние"
    PRINT "синий - эмоциональное состояние"
    PRINT "зеленый - интеллектуальное состояние"
    ' Построение и разметка координатных осей

    axis

    GRAFIK 23,dd
    M0D 23,4
    GRAFIK 28,dd
    M0D 28,2
    GRAFIK 33,dd
    M0D 33,1
    SLEEP END

    SUB AXIS

    LINE (0,140)-(0,340)

    LINE (0,240)-(a*20,240)

    F0R j=l T0 a stroke=5

    IF (j M0D 5)=0 THEN stroke=10
    LINE (j*20,240+stroke)-(j*20,240-stroke)
    IF stroke=10 THEN L0CATE 17,(j*20-4)\8: PRINT j

    NEXT j
    END SUB

    SUB GRAFIK(t,dfi, col)
    C0NST twopi=6.2831853*

    x=0: y=240-100*SIN(twopi*dfi/t): C0L0R col PSET (x,y)
    F0R k=l T0 a xl=20*k

    yl=240-100*SIN(twopi*(k+dfi)/t)
    LINE -(xl,yl)
    NEXT k
    END SUB

    FUNCTI0N 0FFSET (d,m,y)

    REM Вычисляет количество дней от 1.01.1900 до
    d.m.y dd=365: 'Количество дней в 1900 г REM Цикл учета полных лет
    F0R k%=1901 T0 у-1 dd=dd+365

    REM Поправка на високосный год
    IF (k% M0D 4)=0 THEN dd=dd+l NEXT k%
    REM Учет дней в году у до месяца m

    F0R k%=l T0 m-1: dd=dd+days(k%): NEXT k%
    0FFSET=dd+d:' Добавление дней, прошедших в месяце m
    END FUNCTI0N

    Программа 8_18.с

    #include <dos.h>
    #include <math.h>


    #include <stdio.h>
    #include <graphics.h>
    #include <conio.h>

    #define twopi 2*M_PI

    void axis(void);

    void grafik( int t, int dfi, int color);

    long offset(int d, int m,int y);

    int round(double x);

    char days[]={30,28,31,30,31,30,31,31,30,31,30,31}; int a ;

    main () {

    int gd=0,gm, k,d,m, y,ml,yl;

    struct date q;

    long dd; wwod:

    clrscr () ;

    gotoxy(1,1);

    printf("Биоритмы на текущий месяц\n");

    printf("Введите день, месяц (числом) и год своего рождения\n");

    scanf("%d %d %d",&d,&m,&y);

    getdate(&q);

    ml=q.da_mon;

    yl=q.da_year;

    if(m<l || m>12 || d<l || d>days[m-l] || y<1900 || y>yl)
    {
    printf("\nBы ошиблись. Нажмите Enter и повторите ввод");

    getch();
    goto wwod;
    }

    if(yl % 4 == 0) days[l]=29;
    a=days[ml-1];

    dd=offset(l,ml,yl)-offset(d,m,y);
    initgraph(&gd, &gm, "");

    gotoxy(1,1);
    printf ("красный - физическое состояние");
    gotoxy(1,2);
    printf ("синий - эмоциональное состояние");
    gotoxy(l,3);
    printf ("зеленый - интеллектуальное состояние");
    axis();

    grafik(23,dd % 23,RED);
    grafik(28,dd % 28,GREEN);
    grafik(33,dd % 33,BLUE);
    getch();
    closegraph ();

    }

    /*---------------------------------*/

    void axis(void)

    { /* Построение и маркировка осей */
    int j,str; char qq[5];

    line(0,140,0,340); /* вертикальная ось */

    line(0,240,a*20,240);
    /* горизонтальная ось */
    /* цикл построения малых и больших штрихов на оси х */
    for(j=l;j <= a;j++) {

    str=5;

    if(j % 5 == 0) str=10;
    line(j*20,240+str,j*20,240-str);
    if (str == 10)

    { /* маркировка больших штрихов через 5 дней */
    itoa(j,qq,10);

    outtextxy(j*20-5,240+20,qq);
    }
    }
    } /*---------------------------*/

    void grafik(int t,int dfi,int color)

    /* построение синусоиды */
    /* t - период (в днях) */

    /* dfi - смещение для х=0 */
    /* color - цвет графика */
    /***************************/

    {

    int x,y,x1,y1,k; х=0;

    y=round(240-100*sin(twopi*dfi/t));


    setcolor(color); moveto(x,у);
    for(k=l; k<=a; k++)
    {

    xl=20*k;

    yl=round(240-100*sin(twopi*(k+dfi)/t));
    lineto(xl,yl); }

    }

    /*-------------------------------*/

    long offset(int d,int m,int y)

    {
    /* Вычисляет количество дней от 1.01.1900 до d.m.y */ int k; long dd;

    dd=365;
    /* Количество дней в 1900 г */
    /* Цикл учета полных лет */
    for(k=1901; k<y; k++)
    {

    dd += 365;

    if(k % 4 == 0) dd++;
    /* Поправка на високосный год */
    }

    dd += d;

    /* Учет дней в году у до месяца m */
    for(k=0; k<m-l; k++)

    dd += days[k];
    /* Добавление дней, прошедших в месяце m */ return dd;

    }

    /*-----------------------------------*/

    int round(double x)

    { /* округление вещественного числа до ближайшего целого */

    if(x>=0) return (int)(x+0.5);
    return (int)(x-0.5); }

    Программа 8.18.pas

    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,dl,ml,yl: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:=l to a do begin

    xl:=20*k;

    yl:=round(240-100*sin(twopi*(k+dfi)/t));
    lineto(xl,yl);
    end;
    end;

    function offset(d,m,y:integer)rlongint;
    {Вычисляет количество дней от 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;

    {Учет дней в году у до месяца m}
    for k:=l to m-1 do inc(dd,days[k]);
    sdwig:=dd+d; {Добавление дней, прошедших в месяце m}
    end;


    begin

    gd:=0; wwod:

    writeln('Биоритмы на текущий месяц');

    writeln('Введите день, месяц (числом) и год своего рождения');

    readln(d,m,у);

    GetDate(y1,m1,d1,k); {опрос текущей даты}

    if (m<l)or(m>12)or(d<l)or(d>days[m])or(y<1900)or(y>yl) then begin

    write('Вы ошиблись. Нажмите Enter и повторите ввод');

    readln;
    goto wwod;
    end;

    if yl mod 4=0 then days[2]:=29; {поправка на високосный год}
    а:=days[ml];
    {число дней в текущем месяце}
    { Интервал от дня рождения до начала текущего месяца}
    dd:=offset(I,ml,yl)-offset(d,m,у);
    initgraph(gd,gm,'');

    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.

    Содержание раздела