Вопрос , связанный с потерей данных.

[Rin]

тема была изложена здесь
http://programmersforum.ru/showthread.php?t=98793

но я немного ошибся, и поэтому создаю новую тему. Прошу прощения модераторов, за свой косяк.

[Rin]

Ау, кто нить знает в чём дело?

[Rin]

Излагаю алгоритм. Значит сначала заполняем массив mas_point с помощью щелчков кнопки мыши по форме. Далее заполняем массив треугольников. Берём их по два из массива mas_trey и проверяем на пересечение, и если они пересекаются, то заполняем элемент массива треугольников новыми координатами так, чтобы не было этого пересечения. (см рис.1). Сколько точек ты поставишь, столько вершин и будет у многоугольника. Кто хочет просмотрерь алгоритм полностью, в выше выложенной ссылке выложен исходник.

вот такой существует тип у меня и глобальные переменные

  type

  TLine=array of TPoint;

  trey = record
  ab,ac,bc:TLine;
  PA,PB,PC:TPoint;
  A_N,B_N,C_N:integer;
  end;

var 

 mas_Point: array of TPoint;
  mas_Treyg: array of TForm1.trey;
  n:integer;
  i,j:integer;
  peresechenie:boolean;
  Nomer_Trey:integer;

далее процедура заполнения координат одной стороны треугольника

procedure TForm1.zapolnenie(var Line:TLine;
 A1,A2:TPoint;var N_Nomber:Integer);
var dx,dy,x,y,ii:integer;
begin
  setLength(Line,1);
  ii:=0;
  dx:=A2.x-A1.x;   dy:=A2.y-A1.y;
  if dx<0 then x:=dx*(-1) else x:=dx;
  if dy<0 then y:=dy*(-1) else y:=dy;
  if x>=y then
  begin
    if A1.x>A2.x then swapP(A1,A2);
    N_Nomber:=A2.x-A1.x;
  if (A2.x-A1.x)<>0 then  setLength(Line,N_Nomber);
    for x:=A1.x to A2.x do
    begin
      Line[ii].x:=x;
      Line[ii].y:=round((x-A1.x)*dy/dx)+A1.y;
      ii:=ii+1;
    end;
  end
  else
  begin
    if A1.y>A2.y then swapP(A1,A2);
    N_Nomber:=A2.y-A1.y;
    setLength(Line,N_Nomber);
    for y:=A1.y to A2.y do
    begin
      Line[ii].y:=y;
      Line[ii].x:=round((y-A1.y)*dx/dy)+A1.x;
      ii:=ii+1;
    end;
  end;
end;

теперь заполнение всех сторон треугольника

procedure TForm1.Zapolnenie_Trey( var Triangl:Trey);
begin
  zapolnenie(Triangl.ab,Triangl.PA,Triangl.PB,Triangl.A_N);
  zapolnenie(Triangl.bc,Triangl.PB,Triangl.PC,Triangl.B_N);
  zapolnenie(Triangl.ac,Triangl.PA,Triangl.PC,Triangl.C_N);
end;

вот здесь он тупо не хочет работать с передаваемыми параметрами, то есть Т1 и Т2. Они не определены, если проходить по трассировке, хотя 2 треугольника в массиве треугольников уже заполнены.

procedure TForm1.proverka(var T1,T2:trey);
var
z,ii:integer;
begin
  repeat
    z:=0;
    for ii:= 0 to T2.A_N do
    begin
      if (z<=T1.A_N)and(T1.ab[z].x=T2.ab[ii].x)and(T1.ab[z].y=T2.ab[ii].y) then
      begin peresechenie:=true;   exit; end;
      if (z<=T1.B_N)and(T1.bc[z].x=T2.ab[ii].x)and(T1.bc[z].y=T2.ab[ii].y) then
      begin peresechenie:=true;   exit; end;
      if (z<=T1.C_N)and(T1.ac[z].x=T2.ab[ii].x)and(T1.ac[z].y=T2.ab[ii].y) then
      begin peresechenie:=true;   exit; end;
    end;
    for ii:= 0 to T2.B_N do
    begin
      if (z<=T1.A_N)and(T1.ab[z].x=T2.bc[ii].x)and(T1.ab[z].y=T2.bc[ii].y) then
      begin peresechenie:=true;   exit; end;
      if (z<=T1.B_N)and(T1.bc[z].x=T2.bc[ii].x)and(T1.bc[z].y=T2.bc[ii].y) then
      begin peresechenie:=true;   exit; end;
      if (z<=T1.C_N)and(T1.ac[z].x=T2.bc[ii].x)and(T1.ac[z].y=T2.bc[ii].y) then
      begin peresechenie:=true;   exit; end;
    end;
    for ii:= 0 to T2.C_N do
    begin
      if (z<=T1.A_N)and(T1.ab[z].x=T2.ac[ii].x)and(T1.ab[z].y=T2.ac[ii].y) then
      begin peresechenie:=true;   exit; end;
      if (z<=T1.B_N)and(T1.bc[z].x=T2.ac[ii].x)and(T1.bc[z].y=T2.ac[ii].y) then
      begin peresechenie:=true;   exit; end;
      if (z<=T1.C_N)and(T1.ac[z].x=T2.ac[ii].x)and(T1.ac[z].y=T2.ac[ii].y) then
      begin peresechenie:=true;   exit; end;
    end;
    z:=z+1;
  until (z>T1.A_N)and(z>T1.B_N)and(z>T1.C_N);
end;

В FormMouseDown я заполняю массив точек . То есть куда нажал мышкой, те координаты и запомнил в элемент массива.

procedure TForm1.FormCreate(Sender: TObject);
begin
n:=0;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  n:=n+1;
  setLength(mas_point,n);
  mas_Point[n-1].x:=x;
  mas_Point[n-1].y:=y;
  Form1.Canvas.Pixels[x,y]:=RGB(0,0,0);
end;

[Rin]

а вот собственно и подходим к проблеме.

procedure TForm1.Button1Click(Sender: TObject);
var
da:boolean;
peremena,ii:integer;
begin
while da do// сортирую точки по OX
begin
  da:=false;
  for ii := 0 to n-2 do
  if mas_point[ii].X>mas_point[ii+1].x then
  begin
    swapP(mas_point[ii],mas_point[ii+1]);
    da:=true;
  end;
end;// закончил сортировку
  nomer_trey:=1;
  i:=0;
  setLength(mas_Treyg,nomer_trey);// массив пока будет состоять из одного элемента
// запоминаем точки этого треугольника
  mas_treyg[nomer_trey-1].PA:=Mas_Point[i];
  mas_treyg[nomer_trey-1].PB:=Mas_Point[i+1];
  mas_treyg[nomer_trey-1].PC:=Mas_Point[i+2];
// заполняем стороны треугольника координатами
  Zapolnenie_Trey(mas_Treyg[Nomer_trey-1]);
if n>3 then // если мы поставили на форме больше , чем 3 точки, то
  repeat
    inc(nomer_trey);
    inc(i);
    setLength(mas_treyg,nomer_trey);// теперь массив будет состоять из 2 треугольников
    //запоминаем точки этого треугольника
    mas_treyg[nomer_trey-1].PA:=mas_Point[i];
    mas_treyg[nomer_trey-1].PB:=mas_Point[i+1];
    mas_treyg[nomer_trey-1].PC:=mas_Point[i+2];
// заполняем стороны треугольника координатами
    Zapolnenie_Trey(mas_Treyg[Nomer_trey-1]);
// а здесь при передаче благополучно заполненных параметров прога не хочет работать с этими элементами массива
    proverka(mas_Treyg[Nomer_trey-2],mas_Treyg[Nomer_trey-1]);
// строки, которые ниже, уже не важны, т.к. proverka не выполняется
    if peresechenie then
    begin
      mas_Treyg[Nomer_trey-1].PA:=Mas_Point[i-1];
      mas_treyg[nomer_trey-1].PB:=mas_Point[i+1];
      mas_treyg[nomer_trey-1].PC:=mas_Point[i+2];
      Zapolnenie_Trey(mas_Treyg[Nomer_trey-1]);
      peresechenie:=false;
    end;
  until i+2=n-1;
  // заполнение нашего многоугольника
  for i:= 0 to Nomer_trey-1 do
  trey_full(mas_treyg[i].PA,mas_treyg[i].PB,mas_treyg[i].PC);
  i:=0;
  nomer_trey:=0;
  n:=0;
end;