Использование графики и звука в языке Turbo Pascal



Прежде, чем приступить к созданию графических программ на Turbo Pascal, необходимо ознакомиться с богатейшими графическими возможностями этого языка, сосредоточенными в стандартных модулях (библиотеках) GRAPH и CRT (название CRT происходит от Cathode-Ray Tube — электронно-лучевая трубка). Эти модули содержат описания стандартных констант, процедур и функций, используемых при работе с монитором в текстовом и графическом режимах.

Подключение модулей CRT и GRAPH к программе осуществляется с помощью ключевого слова Uses (англ. uses — использует) :
Uses Crt, Graph;

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


8.1. Модуль C R T

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

ClrScr   Очищает экран или окно и помещает курсор в верхний левый угол.
Delay(D: Word)   Приостанавливает работу программы на указанное число D миллисекунд. Практически время задержки зависит от тактовой частоты процессора.
GotoXY(X, Y: Byte)   Перемещает курсор в позицию X строки Y экрана.
NoSound   Выключает источник звука.
Sound(F: Word)   Запускает источник звука с частотой F (Гц).
TextBackGround(Color:Byte)   Устанавливает цвет фона.
TextColor(Color: Byte)   Устанавливает цвет символов.
Window(X1, Y1, X2, Y2: Byte)   Определяет текстовое окно на экране. X1, Y1 — координаты левого верхнего угла окна, X2, Y2 — правого нижнего угла окна.
 
Функции

KeyPressed: Boolean   Анализирует нажатие клавиши. Результат TRUE, если на клавиатуре нажата клавиша (кроме Alt, Ctrl и т.п.), и FALSE в противном случае. Не задерживает исполнение программы.
ReadKey: Char   Читает символ с клавиатуры без эхоповтора на экране. Приостанавливает исполнение программы до нажатия на любую клавишу, кроме Alt, Ctrl и т.п.


8.1. Модуль G R A P H


Модуль Graph содержит константы, процедуры 
и функции для управления графическим режимом работы монитора.
 
Константы цвета
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. 
{Заполнение цветом фона} 
{Сплошная штриховка} 
{Горизонтальная штриховка} 
{/// штриховка} 
{/// штриховка толстыми линиями} 
{\\\ штриховка толстыми линиями} 
{\\\ штриховка} 
{Заполнение прямой клеткой} 
{Заполнение косой клеткой} 
{Заполнение частой сеткой} 
{Заполнение редкими точками} 
{Заполнение частыми точками} 
{Тип задается пользователем} 
 
Процедуры

Arc(X, Y: Integer; U1, U2, R: Word)   Строит дугу окружности текущим цветом с текущими параметрами линии. X, Y — координаты центра дуги, U1 — угол до начальной точки дуги, отсчитываемый против часовой стрелки от горизонтальной оси, направленной слева направо, U2 — угол до конечной точки дуги, отсчитываемый так же, как U1, R — радиус дуги.
Bar(X1, Y1, X2, Y2: Integer)   Строит прямоугольник, закрашенный текущим цветом с использованием текущего стиля (орнамента, штриховки). X1, Y1, X2, Y2 — координаты левого верхнего и правого нижнего углов прямоугольника.
Bar3D(X1, Y1, X2, Y2: Integer; Glubina: Word; Top: Boolean)   Строит параллелепипед, используя текущий стиль и цвет. X1, Y1, X2, Y2 — координаты левого верхнего и правого нижнего углов передней грани; Glubina — ширина боковой грани (отсчитывается по горизонтали), Top — признак включения верхней грани (если True — верхняя грань вычерчивается, False — не вычерчивается).
Circle(X, Y: Integer; R: Word)   Рисует текущим цветом окружность радиуса R c центром в точке (X,Y).
ClearDevice   Очищает графический экран, закрашивает его в цвет фона.
ClearViewPort   Очищает выделенное графическое окно, закрашивает его в цвет фона.
CloseGraph   Закрывает графический режим, т.е. освобождает память, распределенную под драйверы графики и файлы шрифтов, и восстанавливает текстовый режим работы экрана.
Ellipse(X, Y: Integer; U1, U2, XR, YR: Word)   Рисует дугу эллипса текущим цветом; X, Y — координаты центра эллипса; U1, U2 — углы до начальной и конечной точек дуги эллипса (см. процедуру Arc); XR, YR — горизонтальная и вертикальная полуоси эллипса.
FillEllipse(X, Y: Integer; XR, YR: Word)   Рисует заштрихованный эллипс, используя X,Y как центр и XR,YR как горизонтальную и вертикальную полуоси эллипса.
FillPoly(N: Word; Var PolyPoints)   Рисует и штрихует многоугольник, содержащий N вершин с координатами в PolyPoints.
InitGraph(Var Driver, Mode: Integer; Path: String)   Организует переход в графический режим. Переменные Driver и Mode содержат тип графического драйвера и его режим работы. Третий параметр определяет маршрут поиска графического драйвера. Если строка пустая (т.е. равна ''), считается, что драйвер находится в текущем каталоге.
Line(X1, Y1, X2, Y2: Integer)   Рисует линию от точки X1, Y1 до точки X2,Y2.
LineTo(X, Y: Integer)   Рисует линию от текущего указателя к точке X,Y.
MoveTo(X, Y: Integer)   Смещает текущий указатель к точке X,Y.
OutTextXY(X, Y: Integer; TextString: String)   Выводит текст в заданное место экрана.
PieSlice(X, Y: Integer; U1, U2, Radius: Word)   Строит сектор круга, закрашенный текущей штриховкой и цветом заполнения. X, Y — координаты центра сектора круга; U1 и U2 — начальный и конечный углы сектора, отсчитываемые против часовой стрелки от горизонтальной оси, направленной вправо; Radius — радиус сектора.
PutPixel(X, Y: Integer; Color: Word)   Выводит точку цветом Color с координатами X, Y.
Rectangle(X1, Y1, X2, Y2)   Рисует контур прямоугольника, используя текущий цвет и тип линии. X1, Y1 — координаты левого верхнего угла прямоугольника, X2, Y2 — координаты правого нижнего угла прямоугольника.
Sector(X, Y: Integer; U1, U2, XR, YR: Word)   Рисует и штрихует сектор эллипса радиусами XR, YR с центром в X, Y от начального угла U1 к конечному углу U2.
SetBkColor(Соlor: Word)   Устанавливает цвет фона.
SetColor(Соlor: Word)   Устанавливает основной цвет, которым будет осуществляться рисование.
SetFillStyle(Pattern, Color: Word)   Устанавливает образец штриховки и цвет.
SetLineStyle(LineStile, Pattern, Thickness: Word)   Устанавливает толщину и стиль линии.
SetTextStyle(Font, Direction, CharSize: Word)   Устанавливает текущий   шрифт, направление (горизонтальное или вертикальное) и размер текста.
SetViewPort(X1, Y1, X2, Y2: Integer; ClipOn: Boolean)   Устанавливает прямоугольное окно на графическом экране. Параметр ClipOn определяет "отсечку" элементов изображения, не умещающихся в окне.
 
Функции

GetMaxX и GetMaxY   Возвращает значения максимальных координат экрана в текущем режиме работы, соответственно, по горизонтали и вертикали.
GraphResult   Возвращает значение GrOk, соответствующее коду 0, если все графические операции программы выполнились без ошибок, или возвращает числовой код ошибки (от —1 до —14).
 


8.3. Примеры графических программ


Эти примеры иллюстрируют основные моменты, возникающие при написании графических программ: Даются окончательные подробно откомментированные тексты программ, которые могут служить основой для программ читателя. Для их работы необходимо наличие библиотечного файла GRAPH.TPU, драйвера видеорежима EGAVGA.BGI (или другого, в зависимости от типа монитора) и файлов шрифтов (*.chr).
Из-за недостатка места некоторые программы не содержат действий по выдаче сообщений о возможных ошибках графики, хотя они очень важны.
 
Пример 8.1. Эта программа демонстрирует работу процедур управления текстовым выводом на экран дисплея.
 
Демонстрация
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.
Пример 8.2. Эта программа демонстрирует возможности изображения линий в графическом режиме.
 
 
Демонстрация
 
Внимание: будет работать только если Turbo Pascal установлен в каталог C:\TP и каталог C:\TP\BGI содержит необходимый файл egavga.bgi.
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.
Пример 8.3. Эта программа демонстрирует возможности изображения символов в графическом режиме (требует наличия в текущем каталоге файлов шрифтов *.chr).
 
 
Демонстрация
 
Внимание: будет работать только если Turbo Pascal установлен в каталог C:\TP и каталог C:\TP\BGI содержит необходимый файл egavga.bgi.
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.
Пример 8.4. Эта программа рисует закрашенный прямоугольник, меняя случайным образом цвет, тип штриховки и высоту тона звукового сопровождения.
 
Демонстрация
 
Внимание: будет работать только если Turbo Pascal установлен в каталог C:\TP и каталог C:\TP\BGI содержит необходимый файл egavga.bgi.
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.
Пример 8.5. Эта программа рисует на экране звезду и закрашивает её, используя 12 типов штриховки.
 
 
Демонстрация
 
Внимание: будет работать только если Turbo Pascal установлен в каталог C:\TP и каталог C:\TP\BGI содержит необходимый файл egavga.bgi.
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.
Пример 8.6. Программа демонстрирует получение эффекта движения изображения прицела под управлением клавишей-стрелок клавиатуры с выводом координат центра прицела.
 
 
Демонстрация
 
Внимание: будет работать только если Turbo Pascal установлен в каталог C:\TP и каталог C:\TP\BGI содержит необходимый файл egavga.bgi.
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.
Пример 8.7. Программа рисует человечка, делающего утреннюю зарядку.
 
 
Демонстрация
 
Внимание: будет работать только если Turbo Pascal установлен в каталог C:\TP и каталог C:\TP\BGI содержит необходимый файл egavga.bgi.
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.
 
Пример 8.8. Эта программа демонстрирует возможности изображения объёмных предметов и столбиковых диаграмм.
 
 
Демонстрация
 
Внимание: будет работать только если Turbo Pascal установлен в каталог C:\TP и каталог C:\TP\BGI содержит необходимый файл egavga.bgi.
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.
Пример 8.9. Эта программа демонстрирует работу с пикселами, случайными эллипсами и секторами.
 
Демонстрация
 
Внимание: будет работать только если Turbo Pascal установлен в каталог C:\TP и каталог C:\TP\BGI содержит необходимый файл egavga.bgi.
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.10. Программа изображает планету, вращающуюся вокруг Солнца на фоне мерцающих звезд и расходящейся галактики.

Перемещение и изменение размеров изображений на экране можно организовать по разному. Так, в примере 8.6 эффект движения изображения достигается следующим образом: выводится изображение, затем оно стирается с экрана с помощью процедуры ClearViewPort, повторно выводится с некоторым перемещением и т.д.

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

Оба способа имеют одинаковый недостаток —
движение изображения является прерывистым и вызывает мелькание экрана.

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

Изображение сначала создается на странице с нулевым номером, видимой по умолчанию, а на невидимой странице с номером 1 формируется изображение с небольшим перемещением. Затем страница с номером 1 делается видимой, а новое изображение формируется на ставшей невидимой странице с нулевым номером и т.д.

Демонстрация
 
Внимание: будет работать только если Turbo Pascal установлен в каталог C:\TP и каталог C:\TP\BGI содержит необходимый файл egavga.bgi.
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  x 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 быть не должно.

 
Демонстрация
 
Внимание: будет работать только если Turbo Pascal установлен в каталог C:\TP и каталог C:\TP\BGI содержит необходимый файл egavga.bgi.

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.