Пример 8.11. Программа рисует прямоугольную систему координат, отображает в ней заданное множество точек и строит все возможные пары треугольников с вершинами в этом множестве такие, чтобы один треугольник лежал строго внутри другого.




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

Другие записи

10.06.2016. 8.1. Библиотека C R T
Библиотека (модуль) CRT содержит константы, переменные,   процедуры и функции, обеспечивающие управление текстовым режимом работы монитора и звуковым генератором. Процедуры ClrScr Очищает экран…