Эта программа демонстрирует возможности изображения символов в графическом режиме (требует наличия в текущем каталоге файлов шрифтов *.chr)
| Pascal | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
| program Symbols;
uses
Graph, Crt;{подключение к программе библиотек Crt и Graph}
var
Key: Char;
Font: String; {названия шрифтов }
Size, MyFont: Word;
GrDriver, GrMode: Integer;{тип и режим работы графического драйвера}
begin
GrDriver := Detect; {автоопределение типа графического драйвера}
InitGraph(GrDriver, GrMode, 'C:\TP\BGI'); {установка графического режима }
if GraphResult <> GrOk then Halt;
{-----------------------------------------------------------}
SetTextStyle(DefaultFont, HorizDir, 2);
OutTextXY(140, 80, 'Меняем размер символов');
OutTextXY(220, 100, 'и цвет фона');
for Size := 0 to 13 do {Size - цвет фона и размер символов}
begin
SetBkColor(Size); {изменение цвета фона }
Rectangle(135, 425, 470, 450); {рисование рамки }
SetTextStyle(DefaultFont, HorizDir, 1);
OutTextXY(150, 435, 'Для продолжения нажмите любую клавишу !');
SetTextStyle(DefaultFont, HorizDir, Size);
OutTextXY(250 - Size * 15, 200, 'HELLO');
Key := ReadKey; ClearViewPort;
end; ReadLn;
{-----------------------------------------------------------}
SetBkColor(LightGray); SetColor(Red);{цвет фона и цвет рисования }
SetTextStyle(DefaultFont, HorizDir, 2);
{установка шрифта, направления и размера символов}
OutTextXY(70, 100, 'Располагаем строку горизонтально');
SetTextStyle(DefaultFont, VertDir, 2);
OutTextXY(310, 150, 'и вертикально');
Key := ReadKey; ClearViewPort;
{-----------------------------------------------------------}
SetTextStyle(DefaultFont, HorizDir, 2);
{установка шрифта, направления и размера символов}
OutTextXY(220, 30, 'Меняем шрифты');
for MyFont := 0 to 9 do {цикл по номерам шрифтов}
begin
case MyFont of
0: Font := '0 - Точечный (Default)';
1: Font := '1 - Утроенный (Triplex)';
2: Font := '2 - Уменьшенный (Small)';
3: Font := '3 - Прямой (SansSerif)';
4: Font := '4 - Готический (Gothic)';
5: Font := '5 - Рукописный';
6: Font := '6 - Курьер';
7: Font := '7 - Красивый (Tаймс Italic)';
8: Font := '8 - Таймс Roman';
9: Font := '9 - Курьер увеличенный';
end;
SetTextStyle(MyFont, HorizDir, 2);
OutTextXY(40, 70 + MyFont * 35, 'abcdfxyz 0123456789');{вывод текста}
SetTextStyle(DefaultFont, HorizDir, 1);
OutTextXY(410, 80 + MyFont * 35, Font){вывод названия шрифта}
end;
OutTextXY(380, 60, 'N шрифта Описание'); ReadLn;
CloseGraph; {закрытие графического режима}
end. |
|
Эта программа рисует закрашенный прямоугольник, меняя случайным образом цвет, тип штриховки и высоту тона звукового сопровождения
| Pascal | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
| program MusicColor;
uses
Crt, Graph;{подключение к программе библиотек Crt и Graph}
var
GrDriver, GrMode: Integer;{тип и режим работы графического драйвера}
begin
GrDriver := Detect; {автоопределение типа графического драйвера}
InitGraph(GrDriver, GrMode, 'C:\TP\BGI'); {установка графического режима}
SetColor(White); {установка белого цвета рамки }
Rectangle(130, 130, 460, 370); {рисование рамки }
Randomize; {инициализация датчика случайных чисел}
repeat {цикл прерывается нажатием любой клавиши}
Sound(Random(2000)); {изменение высоты звука }
Delay(Random(1000)); {задержка }
SetFillStyle(Random(4), Random(16)); {смена типа штриховки и цвета}
Bar(140, 140, 450, 360); {рисование закрашенного прямоугольника}
until KeyPressed;
NoSound; {отмена звука }
CloseGraph; ReadLn; {закрытие графического режима}
end. |
|
Эта программа рисует на экране звезду и закрашивает её, используя 12 типов штриховки
| Pascal | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
| program Star;
uses
Crt, Graph;
{подключение к программе библиотек Crt и Graph}
const{ массив координат вершин многоугольника (звезды) }
TopsStar: Array[1..18] of Integer = (300, 125, 325, 225, 425, 250,
325, 275, 300, 375, 275, 275, 180, 250, 275, 225, 300, 125);
var
i, j, GrDriver, GrMode: Integer;
begin
GrDriver := Detect;
InitGraph(GrDriver, GrMode, 'C:\TP\BGI'); {установка графического режима}
SetTextStyle(DefaultFont, HorizDir, 2); {установка шрифта,
направления и размера символов}
OutTextXY(220, 60, 'S T A R ');
SetTextStyle(DefaultFont, VertDir, 2);
OutTextXY(140, 150, 'S T A R ');
SetTextStyle(DefaultFont, VertDir, 2);
OutTextXY(500, 150, 'S T A R ');
i := 0;
repeat
j := i mod 12; { j - остаток от деления i на 12 }
SetFillStyle(j, Random(13)); { штриховка и фон }
FillPoly(9, TopsStar); {рисование и штриховка звезды}
Inc(i); {увеличение i на 1}
Delay(500)
until KeyPressed; {завершение цикла нажатием любой клавиши}
CloseGraph
end. |
|
Программа демонстрирует получение эффекта движения изображения прицела под управлением клавишей-стрелок клавиатуры с выводом координат центра прицела.
| Pascal | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
| program Sight;
uses
Crt, Graph;{подключение к программе
библиотек Crt и Graph}
const
Step = 5; {шаг изменения координат центра прицела }
Instr = 'УПРАВЛЕНИЕ ДВИЖЕНИЕМ ПРИЦЕЛА - СТРЕЛКИ, ВЫХОД - ESC';
var
GrDriver, GrMode: Integer; {тип и режим работы графического драйвера}
X, Y: Integer; {координаты центра прицела}
XStr, YStr: String;
Ch: Char;
{-----------------------------------------------------------}
procedure MakeSight(X, Y: Integer);{процедура рисования прицела}
begin
SetColor(White);
Circle(X, Y, 80);
SetColor(LightGreen);
Line(X - 80, Y, X + 80, Y); Line(X, Y - 63, X, Y + 63); {вывод осей прицела}
SetColor(LightRed); Circle(X, Y, 2); {окружность в центре прицела}
Str(X, XStr); Str(Y, YStr); {перевод координат в строковый тип}
SetColor(Yellow);
OutTextXY(X + 5, Y - 35, 'x=' + XStr); {вывод координат центра прицела }
OutTextXY(X + 5, Y - 20, 'y=' + YStr)
end;
{-----------------------------------------------------------}
begin
GrDriver := Detect;
InitGraph(GrDriver, GrMode, 'C:\TP\BGI');
SetColor(LightGray);
X := GetMaxX div 2; Y := GetMaxY div 2; {координаты центра экрана}
Rectangle(50, 425, 600, 460); {рисование рамки }
OutTextXY(120, 440, Instr);
MakeSight(X, Y); {рисование прицела в центре экрана}
while TRUE do {цикл работы программы до прерывания по клавише ESC}
begin
Ch := ReadKey;
case Ch of
#27: begin CloseGraph; Halt(1) end; {выход по клавише ESC}
#75: X := X - Step; {изменение координат x, y нажатием стрелок}
#77: X := X + Step; {"влево", "вправо", "вверх", "вниз" }
#72: Y := Y - Step;
#80: Y := Y + Step
end;
ClearViewPort; { очистка графического экрана }
SetColor(LightGray); {восстановление рамки с надписью}
Rectangle(50, 425, 600, 460);
OutTextXY(120, 440, Instr);
MakeSight(X, Y){рисование прицела в текущих координатах}
end; CloseGraph;
end. |
|
Программа рисует человечка, делающего утреннюю зарядку
| Pascal | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
| program Animation;
uses
Crt, Graph;
{подключение к программе библиотек Crt и Graph}
const{вертикальные и горизонтальные координаты положения рук}
Vert: Array[1..3] of Integer = (190, 157, 120);
Horizont: Array[1..3] of Integer = (200, 190, 200);
var
GrDriver, GrMode, GrError, i, j: Integer;
begin
GrDriver := Detect; InitGraph(GrDriver, GrMode, 'C:\TP\BGI');
GrError := GraphResult; if GrError <> GrOk then Halt;
SetColor(LightGray); { установка светлосерого цвета для рамки}
Rectangle(20, 20, 480, 400); {рисование рамки}
SetColor(LightCyan); {установка яркоголубого цвета для текста}
OutTextXY(200, 40, 'П Р И В Е Т !');
SetColor(LightGray); Circle(250, 130, 20); {голова}
SetColor(Yellow); Arc(250, 130, 0, 180, 26); {волосы}
Arc(250, 130, 0, 180, 24); Arc(250, 130, 0, 180, 22);
Line(250, 105, 244, 115); Line(250, 105, 250, 116); {чубчик}
Line(250, 105, 256, 115);
SetColor(LightCyan); Circle(241, 125, 4); {левый глаз }
Circle(259, 125, 4); {правый глаз}
SetColor(LightRed);
SetFillStyle(SolidFill, LightRed);
FillEllipse(250, 140, 6, 3); {рот }
Setcolor(Green);
Line(250, 152, 250, 220); {туловище }
Line(250, 220, 210, 290); {левая нога }
Line(250, 220, 290, 290); {правая нога}
repeat {цикл прерывается нажатием любой клавиши}
for i := 1 to 3 do {Последовательный вывод трех положений рук:}
begin{ вниз, на уровне плеч, вверх }
SetColor(LightCyan); Sound(200 * i);
Line(250, 157, Horizont[i], Vert[i]); {левая рука}
Line(250, 157, 500 - Horizont[i], Vert[i]); {правая рука}
Delay(300); {задержка}
SetColor(Black); {смена цвета на черный для повторного
pисования рук в том же положении
("стирания" их с экрана) }
Line(250, 157, Horizont[i], Vert[i]); {левая рука }
Line(250, 157, 500 - Horizont[i], Vert[i]); {правая рука}
end
until Keypressed;
SetColor(LightCyan);
Line(250, 157, Horizont[3], Vert[3]); {левая рука поднята }
Line(250, 157, 500 - Horizont[3], Vert[3]); {правая рука поднята}
for i := 1 to 10 do { звуковая трель }
begin
Sound(1000);
Delay(50);
Sound(1500);
Delay(50)
end;
NoSound; { выключение звука }
CloseGraph;
end. |
|
Эта программа демонстрирует возможности изображения объёмных предметов и столбиковых диаграмм
| Pascal | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
| program Design;
uses
Graph, Crt;{подключение к программе библиотек Crt и Graph}
const
Height: Array[1..8] of Integer = (40, 150, 90, 240, 190, 120, 50, 90);
{массив высот столбиков диаграммы}
var
Color: Word; {код цвета}
Key: Char;
i, x, y, y1, h: Integer;
GrDriver, GrMode: Integer; {тип и режим работы графического драйвера}
GrError: Integer;{код ошибки графики}
begin
GrDriver := Detect; InitGraph(GrDriver, GrMode, 'C:\TP\BGI');
GrError := GraphResult; if GrError <> GrOk then Halt;
y := 120; h := 50; y1 := 140;
SetTextStyle(DefaultFont, HorizDir, 2); {шрифт, направление, размер}
OutTextXY(160, 20, 'Конструируем интерьер');
SetFillStyle(5, LightRed); {тип штриховки и цвет (ярко красный)}
for i := 4 downto 1 do
begin{рисование параллелепипедов заданного размера}
Bar3D(75, y1 + i * h, 145, y1 + (i + 1) * h, 60, TopOff); Delay(200);
end;
Bar3D(75, y1, 145, y1 + h, 60, TopOn); Delay(200);
Bar3D(180, y, 290, y + h, 30, TopOn); Delay(200);
Bar3D(330, 225, 400, y + 4 * h, 30, TopOn); Delay(200);
Bar3D(300, y + 3 * h, 370, y + 5 * h, 30, TopOn); Delay(200);
Bar3D(370, y + 3 * h, 440, y + 5 * h, 30, TopOn); Delay(200);
Bar3D(300, y, 370, y + h, 30, TopOn); Delay(200);
Bar3D(370, y, 440, y + h, 30, TopOn); Delay(200);
Bar3D(442, y, 500, y + 5 * h, 30, TopOn); Delay(200);
Rectangle(135, 425, 470, 450); {рисование pамки для сообщения}
SetTextStyle(DefaultFont, HorizDir, 1);
OutTextXY(150, 435, 'Для продолжения нажмите любую клавишу !');
Key := ReadKey; ClearViewPort; {очистка окна}
{-----------------------------------------------------------------}
SetTextStyle(DefaultFont, HorizDir, 2);
OutTextXY(100, 20, 'Рисуем столбиковую диаграмму');
x := 50; Randomize; {инициализация датчика случайных чисел}
for i := 1 to 8 do {цикл по столбикам диаграммы}
begin
Color := Random(12) + 1; {задание кода цвета (кроме черного)}
SetFillStyle(i, Color); {задание типа штриховки и цвета}
SetColor(Color);
Bar3D(x, 350 - Height[i], x + 50, 380, 20, TopOn); {рисование столбика}
x := x + 70; {изменение координаты x };
Delay(200){задержка}
end;
Key := ReadKey; CloseGraph; {Закрытие графического режима}
end. |
|
Эта программа демонстрирует работу с пикселами, случайными эллипсами и секторами.
| Pascal | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
| program RandomFigures;
uses
Graph, Crt;
var
Key: Char;
GrDriver, GrMode: Integer;
Radius, MaxX, MaxY, Ugol: Word;{параметры процедур}
begin
GrDriver := Detect; {автоопределение типа графического драйвера}
InitGraph(GrDriver, GrMode, 'C:\TP\BGI'); {установка графического режима}
SetTextStyle(DefaultFont, HorizDir, 2);
{установка шрифта, направления и размера символов}
OutTextXY(160, 50, 'Рисуем звездное небо');
Rectangle(110, 90, 520, 380); {рисование рамки }
Randomize; {инициализация датчика случайных чисел}
repeat {цикл прерывается нажатием любой клавиши}
PutPixel(Random(GetMaxX - 250) + 120, Random(GetMaxY - 210) + 100,
Random(15)); {вывод пикселя в области, ограниченной рамкой}
Delay(5){задержка}
until KeyPressed;
Key := ReadKey; ClearDevice; {очистка графического экрана}
{---------------------------------------------------------------}
SetColor(White); {цвет рисования}
OutTextXY(140, 30, 'Рисуем случайные эллипсы');
Rectangle(100, 70, 560, 420); { рисование рамки }
MaxX := GetMaxX;
MaxY := GetMaxY;
Radius := MaxY div 10;
SetLineStyle(0, 0, 1); {толщина и стиль линии}
SetViewPort(101, 71, 559, 419, ClipOn); {установка окна внутри рамки}
Randomize; {инициализация датчика случайных чисел}
repeat {цикл прерывается нажатием любой клавиши}
SetBkColor(Black); {цвет фона }
SetColor(Random(13) + 1); {цвет рисования}
SetFillStyle(Random(12), Random(13) + 1); {образец и цвет штриховки}
FillEllipse(Random(MaxX), Random(MaxY), {координаты центра эллипса}
Random(Radius), Random(Radius)); {полуоси эллипса}
until KeyPressed;
Key := ReadKey;
ClearDevice; {очистка графического экрана}
{------------------------------------------------------------------}
SetColor(White); SetViewPort(1, 1, GetMaxX, GetMaxY, ClipOn);
OutTextXY(140, 20, 'Рисуем случайные секторы');
Rectangle(90, 60, 570, 420); {рисование рамки}
SetViewPort(92, 62, 569, 419, ClipOn); {установка окна внутри рамки}
repeat {цикл прерывается нажатием любой клавиши}
SetFillStyle(Random(12), Random(13) + 1); {изменение штриховки и цвета}
Ugol := Random(360); {угол сектора}
Sector(Random(MaxX - 200), Random(MaxY - 180), Random(Ugol), Ugol,
Random(Radius * 2), Random(Radius * 2)); {рисование сектора}
until KeyPressed;
ClearViewPort; {очистка окна}
CloseGraph; {закрытие графического режима}
end. |
|
Программа изображает планету, вращающуюся вокруг Солнца на фоне мерцающих звезд и расходящейся галактики
| Pascal | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
| program Space;{составил студент Тетуев Р., мат.фак. КБГУ}
uses
Graph, Crt;
const
RadOrb = 250{радиус орбиты Земли}; RadSun = 70{радиус Солнца};
RadGal = 100{радиус галактики }; RadZem = 18{радиус Земли };
Naklon = 0.2{коэффициент наклона плоскости орбиты Земли};
PressZem = 0.65{коэффициент сплющенности полюсов Земли};
Compress = 0.8 {коэффициент сжатия при переходе из };
{расширения режима VGA в режим CGA }
var
ZemX, ZemY, UgMer, PixelY, DUgZem, UpDown,
XRad, Grad, UgZem, PixelX, StAngle, Ua, Ub,
ParallelY, Color, ZemPix, EndAngle,
VisualPage, GrMode, GrError, GrDriver, i: Integer;
Ugol, CompressZem, Expansion,
DUgol, Projection, PolUgol: Real;
begin
{установка графического режима и проверка возможных ошибок}
GrDriver := EGA; GrMode := EGAHi;
InitGraph(GrDriver, GrMode, 'C:\TP\BGI');
GrError := GraphResult; if GrError <> GrOk then Halt;
SetBkColor(Black);
SetFillStyle(1, Yellow); {установка стиля заполнения и цвета Cолнцa}
Ugol := 0; DUgol := 2 * Pi / 180; {орбитальное угловое смещение Земли}
UgZem := 0; DUgZem := 14; {осевое угловое смещение Земли}
{------------------------------------------------------------------}
VisualPage := 1;
repeat {цикл прерывается нажатием любой клавиши}
SetVisualPage(1 - (VisualPage mod 2));
{установка номера видимой видеостраницы}
VisualPage := VisualPage + 1; {листание видеостраниц}
SetActivePage(1 - (VisualPage mod 2));
{установка номера невидимой (активной) видеостраницы,}
{используемой для построения смещенного изображения }
ClearDevice; {очистка графического экрана}
{--------------------------------------------------------------}
{Рисование "расходящейся" галактики}
RandSeed := 1; {исходное значение датчика случайных чисел}
Expansion := VisualPage / 100; {cкорость расширения галактики}
for i := 1 to VisualPage do
begin
XRad := Trunc(Expansion * RadGal * Random);
{текущее расстояние от звезды до центра галактики}
PolUgol := 2 * Pi * Random - VisualPage / 30;
{текущий центральный угол положения звезды галактики}
PixelX := 370 + Trunc(XRad * cos(PolUgol + 1.8)); {координаты}
PixelY := 250 + Trunc(XRad * 0.5 * sin(PolUgol)); { звезды }
PutPixel(PixelX, PixelY, White){рисование звезды}
end;
{--------------------------------------------------------------}
{Рисование мерцающих звезд}
Randomize; {инициализация датчика случайных чисел}
for i := 1 to 70 do
PutPixel(Random(640), Random(350), White); {вспыхивающие звезды}
{--------------------------------------------------------------}
for i := 1 to 100 do {Рисование орбиты}
PutPixel(320 + Round(RadOrb * cos((i + VisualPage / 5) * Pi / 50 + 0.3)),
160 + Round(RadOrb * Naklon * sin((i + VisualPage / 5) * Pi / 50 - Pi / 2)), 15);
{--------------------------------------------------------------}
PieSlice(310, 160, 0, 360, RadSun); {Рисование Солнца}
{--------------------------------------------------------------}
{Рисование Земли (ее параллелей и меридианов)}
Ugol := Ugol + DUgol; {угол поворота Земли относительно Солнца}
Grad := Round(180 * Ugol / Pi) mod 360; {в рад.(Ugol) и в град.(Grad)}
ZemX := 320 + Round(RadOrb * cos((Ugol + Pi / 2 + 0.3))); { координаты }
ZemY := 160 + Round(RadOrb * Naklon * sin(Ugol)); {центра Земли}
CompressZem := 2.5 - cos(Ugol + 0.3);
{коэффициент учета удаленности Земли от наблюдателя}
ZemPix := Round(RadZem * CompressZem); {текущий радиус Земли}
UgZem := UgZem + DUgZem; {угол поворота Земли относительно своей оси}
for i := 0 to 11 do { рисование меридианов }
begin
UgMer := (UgZem + i * 30) mod 360;
if (90 < UgMer) and (UgMer < 270) {установка начального и конечного}
then begin StAngle := 90; EndAngle := 270 end { углов дуги }
else begin StAngle := 270; EndAngle := 90 end; {эллипса меридиана}
Ua := (Grad + 220) mod 360; Ub := (Grad + 400) mod 360;
{установка цветов рисования затененной и освещенной
частей меридиана}
Color := LightBlue;
if Ua <= Ub then if (Ua < UgMer) and (UgMer < Ub) then Color := White;
if Ua > Ub then if (Ua < UgMer) or (UgMer < Ub) then Color := White;
SetColor(Color);
XRad := round((ZemPix * cos(UgMer * Pi / 180)));
Ellipse(ZemX, ZemY, StAngle, EndAngle, abs(XRad), round(PressZem * ZemPix));
end;
for i := 2 to 7 do {рисование параллелей}
begin
XRad := abs(Round(ZemPix * sin(i * Pi / 9)));
{большая полуось эллипса параллели}
UpDown := Round(ZemPix * PressZem * cos(i * Pi / 9));
{высота параллели над плоскостью экватора}
ParallelY := ZemY + UpDown; {координата Y центра эллипса параллели}
SetColor(LightBlue);
Ellipse(ZemX, ParallelY, 0, 360, XRad, Round(Naklon * XRad));
{затененная часть параллели}
SetColor(White);
Ellipse(ZemX, ParallelY, Grad + 220, Grad + 400, XRad, Round(Naklon * XRad));
{освещенная часть параллели}
end;
{------------------------------------------------------------------}
{Повторное рисование Cолнца, если оно ближе к наблюдателю, чем Земля}
if CompressZem < 2 then PieSlice(310, 160, 0, 360, RadSun);
{------------------------------------------------------------------}
RandSeed := VisualPage mod 12;
for i := 1 to 250 do {Рисование протуберанцев}
begin
Projection := (1 - sqr(Random)) * Pi / 2;
XRad := RadSun + Round((20) * sin(Projection)) - 15;
PolUgol := 2 * Pi * Random + VisualPage / 20;
{PolUgol, XRad - полярные координаты протуберанца}
PixelX := 310 + Round( XRad * cos(PolUgol));
PixelY := 160 + Round( Compress * XRad * sin(PolUgol));
PutPixel(PixelX, PixelY, LightRed)
end;
until KeyPressed
end. |
|
Программа рисует прямоугольную систему координат, отображает в ней заданное множество точек и строит все возможные пары треугольников с вершинами в этом множестве такие, чтобы один треугольник лежал строго внутри другого
| Pascal | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
| program Triangles;{Составил студент Тезадов С., 1 к. мат. фак. КБГУ}
uses
Crt, Graph;
const
DemoN = 10;
DemoX: array [1..DemoN] of Integer = (20, 150, 90, 500, 50, 110, 370, 300, 70, 500);
DemoY: array [1..DemoN] of Integer = (20, 40, 300, 400, 380, 130, 290, 140, 60, 170);
var
X, Y: Array[1..50] of Integer; {координаты точек множества}
InX, InY: Array[1..50] of Integer; {координаты вершин внутренних}
Flag: Boolean; {треугольников}
Ch: Char;
Coord, Num: String;
i, j, k, p, i1, j1, k1, n, n1: Integer;
GrDriver, GrMode, GrError: Integer;
{--------------------------}
procedure InputOutput;{Описание процедуры считывания координат точек
множества из текстового файла dan.dat в массивы
X и Y и вывода точек на графический экран }
var
f: Text;
a, b: Real;
begin
Assign(f, 'dan.dat'); {установление связи между физическим }
{файлом dan.dat и файловой пеpеменной f}
{$I-} {- отключаем автоматическую проверку существования файла}
Reset(f); i := 0; {открытие файла f для чтения}
{$I+}
if IOResult = 0 then begin{если файл существует}
while not eof(f) do {цикл "пока не будет достигнут конца файла"}
begin
Read(f, a, b); Inc(i); {считывание из файла f пары координат}
X[i] := Trunc(a - 1); Y[i] := Trunc(428 - b){преобразование декартовых}
end; {координат в координаты графического экрана}
n := i; {n - количество введенных точек множества}
Close(f); {закрытие файла f}
end
Else begin{если файла не существует, то используем множество точек,}
n := DemoN; {заданное в DemoN, DemoX, DemoY.}
for i := 1 to DemoN do
begin
x[i] := DemoX[i];
y[i] := 428 - DemoY[i];
end;
end;
SetColor(LightCyan);
OutTextXY(200, 30, 'ИСХОДНОЕ МНОЖЕСТВО ТОЧЕК');
for i := 1 to n do {рисование и нумерация точек множества}
begin
Circle(X[i], Y[i], 2);
Str(i, Num); OutTextXY(X[i] + 4, Y[i] + 3, Num)
end;
Ch := ReadKey; ClearViewPort; {очистка графического окна}
end;{of InputOutput}
{--------------------------}
procedure Drawing_Axes;{описание процедуры рисования осей координат}
begin
SetColor(White);
MoveTo(30, 0); LineTo(30, 430); LineTo(639, 430); {оси ОХ,OY}
OutTextXY(27, 0, '^'); OutTextXY(630, 427, '>'); {стрелки осей OX, OY}
SetColor(LightGreen);
OutTextXY(18, 0, 'y'); OutTextXY(630, 434, 'x');
OutTextXY(25, 433, '0');
SetColor(LightMagenta); {установка розового цвета}
for i := 1 to 20 do {нанесение делений и числовых отметок на ось OY}
begin
Str(20 * (21 - i), Coord); j := i * 20 + 10;
OutTextXY(2, j - 5, Coord);
Line(28, j, 30, j)
end;
for i := 1 to 29 do {нанесение делений и числовых отметок на ось OX}
begin
Str(20 * i, Coord); j := i * 20 + 30;
if Odd(i) then OutTextXY(j - 8, 436, Coord); Line(j, 430, j, 432)
end;
SetViewPort(31, 4, 630, 429, FALSE){установка текущего графического окна}
end;{of Drawing_Axes}
{--------------------------}
function Inside(i, j, k, p: Integer ): Boolean;
{функция Inside возвращает TRUE, если точка с номером p
находится внутри треугольника с вершинами в точках i, j, k}
var
S1, S2: Real;
{---------------------------------------------------}
function Area(x1, y1, x2, y2, x3, y3: Real): Real;
{функция вычисления площади треугольника}
{с вершинами в точках (x1,y1), (x2,y2), (x3,y3)}
begin
Area := abs((x1 * (y2 - y3) + x2 * (y3 - y1) + x3 * (y1 - y2)) / 2)
end;{of Area}
{--------------------------------------------------------}
begin
S1 := Area(X[i], Y[i], X[j], Y[j], X[k], Y[k]);
{S1 - площадь треугольника с вершинами в точках i, j, k}
S2 := Area(X[i], Y[i], X[j], Y[j], X[p], Y[p]) +
Area(X[j], Y[j], X[k], Y[k], X[p], Y[p]) +
Area(X[k], Y[k], X[i], Y[i], X[p], Y[p]);
{S2 - сумма площадей трех треугольников с вершинами
в точках (i,j,p), (j,k,p), (i,k,p) }
Inside := S1 > S2 - 0.001
end;{of Inside}
{--------------------------}
procedure Triangle(x1, y1, x2, y2, x3, y3: Integer; Color: Byte);
begin{описание процедуры рисования треугольника цвета Color}
SetColor(Color);
Line(x1, y1, x2, y2);
Line(x2, y2, x3, y3);
Line(x3, y3, x1, y1)
end;{of Triangle}
{--------------------------}
begin
GrDriver := Detect;
InitGraph(GrDriver, GrMode, 'C:\TP\BGI');
GrError := GraphResult;
if GrError <> GrOk then begin WriteLn(' Ошибка графики!'); Halt end;
Drawing_Axes; {вызов процедуры рисования осей координат}
InputOutput; {вызов процедуры ввода и вывода исходных данных}
Flag := FALSE;
for i := 1 to n - 2 do {циклы по номерам вершин внешнего треугольника}
for j := i + 1 to n - 1 do
for k := j + 1 to n do
begin
SetColor(LightCyan); {установка яркоголубого цвета}
for p := 1 to n do {рисование и нумерация точек множества}
begin
Circle(X[p], Y[p], 2); {рисование точки}
Str(p, Num);
OutTextXY(X[p] + 4, Y[p] + 3, Num){вывод номера точки}
end;
n1 := 0; {занесение координат точек, находящихся
внутри треугольника, в массивы InX и InY}
for i1 := 1 to n do
begin
if (i1 <> i) and (i1 <> j) and (i1 <> k) and Inside(i, j, k, i1)
then begin
Inc(n1); InX[n1] := X[i1]; InY[n1] := Y[i1]
end;
end;
if n1 >= 3 then {если число точек внутри треугольника не меньше трех,}
begin
Flag := TRUE; {то строятся внутренние треугольники}
for i1 := 1 to n1 - 2 do {циклы по номерам вершин внутренних}
for j1 := i1 + 1 to n1 - 1 do {треугольников}
for k1 := j1 + 1 to n1 do
begin{рисование внешнего треугольника красным цветом}
Triangle(X[i], Y[i], X[j], Y[j], X[k], Y[k], LightRed);
{рисование внутреннего треугольника зеленым цветом}
Triangle(InX[i1], InY[i1], InX[j1], InY[j1], InX[k1], InY[k1],
LightGreen);
OutTextXY(80, 450, 'Найдено решение. Нажмите любую клавишу!');
Ch := ReadKey;
SetColor(Black); {"стирание" сообщения}
OutTextXY(80, 450, 'Найдено решение. Нажмите любую клавишу!');
{"стирание" внутреннего треугольника}
Triangle(InX[i1], InY[i1], InX[j1], InY[j1], InX[k1], InY[k1],
Black)
end{конец циклов по номерам вершин внутренних треугольников}
end;
{"стирание" внешнего треугольника}
Triangle(X[i], Y[i], X[j], Y[j], X[k], Y[k], Black)
end; {конец циклов по номерам вершин внешнего треугольника}
SetColor(White);
if not Flag then OutText('Для данного множества нет решений задачи')
else OutText('РАБОТА ПРОГРАММЫ ЗАВЕРШЕНА');
OutTextXY(80, 450, ' Нажмите любую клавишу ...');
Ch := ReadKey;
CloseGraph{закрытие графического режима}
end. |
|
3
|
Сообщение от domovou2.0
