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.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.

Для работы программы необходимо предварительно создать в текущем каталоге текстовый файл dan.dat, содержащий координаты точек множества. Файл должен иметь структуру:
x₁  y₁  x₂  y₂ ...  x_n  y_n , где 0 < x_i < 400, 0 < y_i < 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.