Набор треугольников, Выявить пересекающиеся Опции

[Ольга]

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

[Lapp]

Как я уже писал выше, для каждой пары треугольников проверь, пересекаются ли их стороны (попарно, 9 пар, но реально, похоже, достаточно проверить 8). Текст процедуры для проверки перескаемости отрезков здесь.
Пиши и приноси на проверку..

[-Оля-]

Принесла на проверку! Посмотрите пожалуйста, может будут какие-нибудь замечания.

Код

program treug1;
uses crt,graph;
type point = record
         x,y:integer;
     end;
     ptreug = ^treug;
     treug = record
         ver:array[0..2]of point;
         per:boolean;
         next:ptreug;
     end;
var mas:ptreug;
    gdriver,gmode:integer;
    key:char;
    select:integer;
{процедура очистки памяти}
procedure Free(var t:ptreug);
begin
   if t<>nil then begin
      Free(t^.next);
      freemem(t,sizeof(treug));
      t:=nil;
   end;
end;
{проверка на пересечение отрезков}
function ver(x1,y1,x2,y2,x3,y3,x4,y4:integer):boolean;
var b1,b2,x:real;
    flag2,flag1:boolean;
    z,z1,z2:real;
begin
  {проверка на паралельность оси оу 1 прямой}
  if (x1<>x2)then begin
   b1:=(-x1*(y2-y1))/(x2-x1)+y1;
   z1:=(y2-y1)/(x2-x1);
  end else begin
   b1:=0;
   z1:=0;
  end;
  {проверка на паралельность оси оу 2 прямой}
  if (x3<>x4)then begin
   b2:=(-x3*(y4-y3))/(x4-x3)+y3;
   z2:=(y4-y3)/(x4-x3);
  end else begin
   b2:=0;
   z2:=0;
  end;
  {находим знаменатель}
  z:=z1-z2;
  ver:=false;
  {если отрезки паралельны то выходим}
  if z=0 then exit;
  {координата x пересечения 2х прямых}
  x:=(b2-b1)/(z);
  flag1:=false;
  {проверяем координаты х ???}
  if x1>x2 then begin
   if (x<=x1)and(x>=x2) then flag1:=true;
  end else begin
   if (x>=x1)and(x<=x2) then flag1:=true;
  end;
  flag2:=false;
  if x3>x4 then begin
   if (x<=x3)and(x>=x4) then flag2:=true;
  end else begin
   if (x>=x3)and(x<=x4) then flag2:=true;
  end;
  ver:=(flag1 and flag2);
end;
{процедура поиска и вывода результата}
procedure vivod;
var i,j,i1,j1:integer;
    t,t1:ptreug;
    s:string;
    f:text;
begin
    cleardevice;
    {оси координат}
    outtextxy(100,196,'vvedite ima faila dla zapisi resultata');
    gotoxy(60,13);
    readln(s);
    cleardevice;
    line(20,240,620,240);
    line(620,240,610,250);
    line(620,240,610,230);
    line(320,20,320,460);
    line(320,20,310,30);
    line(320,20,330,30);
    t:=mas;
    {перебор треугольников}
    while t^.next<>nil do begin
      t1:=t^.next;
      while t1<>nil do begin
        for i:=0 to 1 do for j:=i+1 to 2 do{1 треугольник}
        for i1:=0 to 1 do for j1:=i1+1 to 2 do{2 треугольник}
          if ver(t^.ver[i].x,t^.ver[i].y,
                 t^.ver[j].x,t^.ver[j].y,
                 t1^.ver[i1].x,t1^.ver[i1].y,
                 t1^.ver[j1].x,t1^.ver[j1].y) then begin{если пересекаются}
            {отметим оба}
            t^.per:=true;
            t1^.per:=true;
          end;
          {след треуг}
          t1:=t1^.next;
      end;
      {след треуг}
      t:=t^.next;
    end;
    assign(f,s);
    rewrite(f);
    t:=mas;
    {вывод всех треугольников}
    while t<>nil do begin
      {отметим цветом пересекающиеся}
      if t^.per then begin
        setcolor(10);
        writeln(f,'(',t^.ver[0].x:4,
                t^.ver[0].y:4,')(',
                t^.ver[1].x:4,
                t^.ver[1].y:4,')(',
                t^.ver[2].x:4,
                t^.ver[2].y:4,')');
      end else setcolor(6);
      line(t^.ver[0].x+320,240-t^.ver[0].y,t^.ver[1].x+320,240-t^.ver[1].y);
      line(t^.ver[0].x+320,240-t^.ver[0].y,t^.ver[2].x+320,240-t^.ver[2].y);
      line(t^.ver[1].x+320,240-t^.ver[1].y,t^.ver[2].x+320,240-t^.ver[2].y);
      t:=t^.next;
    end;
    close(f);
    setcolor(6);
end;
{заполнение случайными значениями}
procedure mrandom;
var i:integer;
    t:ptreug;
    n:integer;
begin
    cleardevice;
    gotoxy(50,13);
    outtextxy(100,196,'Введите количество треугольников:');
    readln(n);
    getmem(mas,sizeof(treug));
    t:=mas;
    for i:=0 to n-1 do begin
        t^.ver[0].x:=random(300)-150;
        t^.ver[0].y:=random(300)-150;
        t^.ver[1].x:=random(300)-150;
        t^.ver[1].y:=random(300)-150;
        t^.ver[2].x:=random(300)-150;
        t^.ver[2].y:=random(300)-150;
        t^.per:=false;
        if i<n-1 then begin
          getmem(t^.next,sizeof(treug));
          t:=t^.next;
        end;
    end;
    t^.next:=nil;
    vivod;
    free(mas);
    readln;
end;
procedure minput;
var i:integer;
    s,s1:string;
    t:ptreug;
    n:integer;
begin
    cleardevice;
    gotoxy(50,13);
    outtextxy(100,200,'Введите количество треугольников:');
    readln(n);
    getmem(mas,sizeof(treug));
    t:=mas;
    for i:=0 to n-1 do begin
        cleardevice;
        str(i+1,s1);

        s:='Введите координаты первой точки '+s1+' треугольника:';
        outtextxy(100,196,s);
        gotoxy(60,13);
        readln(t^.ver[0].x,t^.ver[0].y);

        cleardevice;
        s:='Введите координаты второй точки '+s1+' треугольника:';
        outtextxy(100,196,s);
        gotoxy(60,13);
        readln(t^.ver[1].x,t^.ver[1].y);

        cleardevice;
        s:='Введите координаты третьей точки '+s1+' треугольника:';
        outtextxy(100,196,s);
        gotoxy(60,13);
        readln(t^.ver[2].x,t^.ver[2].y);

        t^.per:=false;
        if i<n-1 then begin
          getmem(t^.next,sizeof(treug));
          t:=t^.next;
        end;
    end;
    t^.next:=nil;
    vivod;{поиск и вывод}
    free(mas);{освободим память}
    readln;
end;
{чтение данных из файла}
procedure mfile;
var s,s1:string;
    f:text;
    i,code:integer;
    t:ptreug;
begin
    cleardevice;
    gotoxy(50,13);
    outtextxy(100,200,'Введите имя файла:');
    readln(s);
    assign(f,s);
    reset(f);
    getmem(mas,sizeof(treug));
    t:=mas;
    while not eof(f) do begin
        readln(f,s);
        if s[length(s)]<>' ' then s:=s+' ';
        for i:=0 to 2 do begin
          s1:=copy(s,1,pos(' ',s)-1);
          delete(s,1,pos(' ',s));
          val(s1,t^.ver[i].x,code);
          s1:=copy(s,1,pos(' ',s)-1);
          delete(s,1,pos(' ',s));
          val(s1,t^.ver[i].y,code);
        end;
        t^.per:=false;
        if not eof(f) then begin
          getmem(t^.next,sizeof(treug));
          t:=t^.next;
        end;
    end;
    close(f);
    t^.next:=nil;
    vivod;
    free(mas);
    readln;
    end;
begin
    mas:=nil;
    randomize;
    gmode:=0;
    gdriver:=detect;
    initgraph(gdriver,gmode,'');
    {цвет текста}
    setcolor(6);
    textcolor(5);
    {цвет фона}
    setbkcolor(0);
    REPEAT
    cleardevice;
    outtextxy(100,200,'Случайные значения');
    outtextxy(100,240,'Ввести с клавиатуры');
    outtextxy(100,280,'Открыть файл');
    outtextxy(100,320,'Выход');
    moveto(30,190+select*40);
    lineto(45,205+select*40);
    lineto(30,220+select*40);
    key:=#0;
    repeat
        if keypressed then begin
            key:=readkey;
        end;
    until (key=chr(27))or
          (key=chr(72))or
          (key=chr(80))or
          (key=chr(13));
    case key of
        chr(72):begin
            select:=select-1;
            if select<0 then select:=3;
        end;
        chr(80):begin
            select:=select+1;
            if select>3 then select:=0;
        end;
        chr(13):begin
            case select of
                0:mrandom;
                1:minput;
                2:mfile;
                3:key:=#27;
            end;
        end;
    end;{case}
    UNTIL key=#27;
    closegraph;
end.