Написать программу, которая рисует на
Задание 8.14. Построение шахматной доски
Написать программу, которая рисует на экране шахматную доску. Идея программы подсказана К. Э. Садыровым, однако мы предпочли другую реализацию с целью демонстрации идентичных программ на разных языках.
Совет 1 (общий)
Совет 2 (QBasic)
Совет 3 (Си, Паскаль)
Программа 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 (общий)



Рис. 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 (Си)
Программа 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 (Паскаль)
Совет 2 (Паскаль)
Совет 3 (Паскаль)
Совет 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 (общий)
Совет 2 (общий)
Совет 3 (общий)
Совет 4 (QBasic)
Программа 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 (общий)
Совет 2 (общий)
Совет 3 (общий)
Совет 4 (QBasic)
Совет 5 (Си)
Совет 6 (Паскаль)
Программа 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.