Прежде, чем приступить к созданию графических программ на Turbo Pascal,
необходимо ознакомиться с богатейшими графическими возможностями этого
языка, сосредоточенными в стандартных модулях (библиотеках)
GRAPH и
CRT (название
CRT происходит от Cathode-Ray Tube — электронно-лучевая трубка).
Эти модули содержат описания стандартных констант, процедур и функций,
используемых при работе с монитором в текстовом и графическом режимах.
В системе программирования Turbo Pascal имеется хорошо развитая встроенная служба помощи, позволяющая получать подробное описание стандартных подпрограмм с примерами их применения. Поэтому ниже приведены только названия, описание параметров и назначение наиболее употребительных процедур и функций.
|
|
|
|
| Black = 0; {Черный}
Blue = 1; {Синий} Green = 2; {Зеленый} Cyan = 3; {Голубой} Red = 4; {Красный} Magenta = 5; {Фиолетовый} Brown = 6; {Коричневый} LightGray = 7; {Светлосерый} |
DarkGray = 8; {Темносерый}
LightBlue = 9; {Яркосиний} LightGreen = 10; {Яркозеленый} LightCyan = 11; {Яркоголубой} LightRed = 12; {Розовый} LightMagenta = 13; {Малиновый} Yellow = 14; {Желтый} White = 15; {Белый} |
| SolidLn = 0; {Сплошная}
DottedLn = 1; {Точечная} CenterLn = 2; {Штрихпунктирная} |
DashedLn = 3; {Пунктирная}
NormWidth=1; {Нормальная толщина} ThickWidth = 3; {Тройная толщина} |
| EmptyFill = 0;
SolidFill = 1; LineFill = 2; LtSlashFill = 3; SlashFill = 4; BkSlashFill = 5; LtBkSlashFill = 6; HatchFill = 7; XHatchFill = 8; InterleaveFill = 9; WideDotFill = 10; CloseDotFill = 11; UserFill = 12. |
{Заполнение цветом фона}
{Сплошная штриховка} {Горизонтальная штриховка} {/// штриховка} {/// штриховка толстыми линиями} {\\\ штриховка толстыми линиями} {\\\ штриховка} {Заполнение прямой клеткой} {Заполнение косой клеткой} {Заполнение частой сеткой} {Заполнение редкими точками} {Заполнение частыми точками} {Тип задается пользователем} |
Program ColorTable;
Uses Crt; {подключение к программе библиотеки Crt}
Const P = ' ';
Var i, j : Integer;
BEGIN
ClrScr; {очистка экрана}
Window(1, 1, 80, 7); {определение окна для заголовочной части таблицы}
TextColor(Yellow); {установка желтого цвета символов}
GoToXY(24, 1); WriteLn('ТЕКСТОВЫЙ ВЫВОД НА ЭКРАН ДИСПЛЕЯ');
GoToXY(30, 2); WriteLn('ТАБЛИЦА ЦВЕТНОСТИ');
TextColor(LightCyan); {установка яркоголубого цвета символов}
WriteLn('0-Черный ',P,'4-Красный ',P,'8-Темносерый ',P,'12-Розовый ');
WriteLn('1-Синий ',P,'5-Фиолетовый ',P,'9-Яркосиний ',P,'13-Малиновый ');
WriteLn('2-Зеленый ',P,'6-Коричневый ',P,'10-Яркозеленый ',P,'14-Желтый ');
Write ('3-Голубой ',P,'7-Светлосерый',P,'11-Яркоголубой',P,'15-Белый ');
TextColor(3+128); WriteLn(' i+128-Мерцание'); TextColor(White);
For i := 0 to 9 do {цикл по цветам фона таблицы цветности}
begin
Window(i*8+1, 7, i*8+8, 25); {oпределение окна для столбца таблицы}
GoToXY(1, 1); {курсор в верхнем левом углу окна}
TextBackGround(Black); {установка черного цвета фона}
WriteLn(' Фон', i:2);
WriteLn('----------');
TextBackGround(i); {установка текущего цвета фона окна }
For j := 0 to 15 do
begin
TextColor(j); {установка текущего цвета надписей в окне }
WriteLn('цвет', j:2);
end;
end; NormVideo; ReadLn
END.
Program Lines;
Uses Graph, Crt; {подключение к программе библиотек Crt и Graph}
Var
Key : Char;
LineStyle : Word; {номер стиля рисования линии}
Style : String; {название стиля }
GrDriver, GrMode : Integer; {тип и режим работы графического драйвера}
GrError : Integer; {код ошибки графики}
BEGIN
GrDriver := Detect; {автоопределение типа графического драйвера}
InitGraph(GrDriver, GrMode, 'C:\TP\BGI'); {установка графического режима}
GrError := GraphResult;
If GrError<>GrOk then begin Writeln('Обнаружена ошибка!'); Halt
end;
SetBkColor(LightGray); SetColor(Red); {цвет фона и цвет рисования }
{------------------------------------------------------------}
OutTextXY(120, 100, 'Рисуем линию от точки (200,200) к точке (400,280)');
Line(200, 200, 400, 280);
Key:=ReadKey; {приостановление исполнения программы}
ClearViewPort; {очистка окна}
{-----------------------------------------------------------}
OutTextXY(240, 80, 'Рисуем ломанную');
Rectangle(110, 120, 520, 400); {рисование рамки }
MoveTo(Round(GetMaxX/2), Round(GetMaxY/2)); {указатель в центре окна}
Repeat {цикл прерывается нажатием любой клавиши}
LineTo(Random(GetMaxX-250)+120, Random(GetMaxY-210)+120);
Delay(100);
until KeyPressed;
Key := ReadKey; ClearViewPort;
{-----------------------------------------------------------}
OutTextXY(190, 80, 'Mеняем стили рисования линий');
For LineStyle := 0 to 3 do
begin
SetLineStyle(LineStyle, 0, 1);
Case LineStyle of
0: Style:='Сплошная';
1: Style:='Точечная';
2: Style:='Штрихпунктирная';
3: Style:='Пунктирная'
end;
Line(120, 150+LineStyle*50, 430, 150+LineStyle*50);
OutTextXY(450, 145+LineStyle*50, Style);
end;
Key:=ReadKey; ClearViewPort; {очистка окна}
{-----------------------------------------------------------}
OutTextXY(180, 80, 'Меняем толщину рисования линий');
SetLineStyle(0, 0, 1); {толщина 1 пиксел }
Line(140, 200, 430, 200); OutTextXY(450, 195, 'Нормальная');
SetLineStyle(0, 0, 3); {толщина 3 пиксела}
Line(140, 250, 430, 250); OutTextXY(450, 245, 'Тройная');
ReadLn; CloseGraph; {закрытие графического режима}
END.
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.
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.
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.
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.
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.
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.
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.
Перемещение и изменение размеров изображений на экране можно организовать по разному. Так, в примере 8.6 эффект движения изображения достигается следующим образом: выводится изображение, затем оно стирается с экрана с помощью процедуры ClearViewPort, повторно выводится с некоторым перемещением и т.д.
В примере 8.7 применяется другой способ. Сначала на экран выводится рисунок, затем тот же рисунок повторно изображается цветом фона, отчего он становится невидимым, далее рисунок выводится в исходном цвете, но с некоторым перемещением и т.д.
Оба способа имеют одинаковый недостаток —
движение изображения является
прерывистым и вызывает мелькание экрана.
В этой программе для организации более плавного движения изображения по экрану используется возможность формировать изображение на разных страницах видеопамяти (обычно их две или четыре, в зависимости от типа графического адаптера).
Изображение сначала создается на странице с нулевым номером, видимой по умолчанию, а на невидимой странице с номером 1 формируется изображение с небольшим перемещением. Затем страница с номером 1 делается видимой, а новое изображение формируется на ставшей невидимой странице с нулевым номером и т.д.
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.
Пример 8.11. Программа рисует прямоугольную систему координат, отображает в ней заданное множество точек и строит все возможные пары треугольников с вершинами в этом множестве такие, чтобы один треугольник лежал строго внутри другого.
Для работы программы необходимо предварительно создать в текущем каталоге
текстовый файл dan.dat, содержащий координаты точек множества. Файл
должен иметь структуру:
x1 y1
x2 y2
... xn yn
, где 0 < xi <
400, 0 < yi <
600.
Пример файла dan.dat, содержащего координаты десяти точек:
20 20 150 40 90 300 500 400 50 380 110 130 370 290 300 140 70 60 500
170
Пустых строк в файле dan.dat быть не должно.
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.