w := 100;  // Количество ячеек в таблице по горизонтали  
 h := 100;  // Количество ячеек в таблице по вертикали 
 [code=pascal]
 setlength(NumByXY,0,0);               setlength(NumByXY,w,h); 
 setlength(Nxy,0,0);                   setlength(Nxy,w*h,2);
 setlength(DegreeByXY,0,0,0,0);        setlength(DegreeByXY,w,h,4,2);
 setlength(PosDegree,0);               setlength(PosDegree,8); 
CikleStep := 0; // Порядковый номер выполненного цикла
 for Y1 := 0 to h-1 do
 begin
  for X1 := 0 to w-1 do
  if NumByXY[X1,Y1]=0 then // Если число не было помечено
  begin
   CikleStep := CikleStep+1; // Порядковый номер выполненного цикла
   Nxy[0,0] := X1; // Начальная координата X 
   Nxy[0,1] := Y1; // Начальная координата Y
   Step1 := 0; // Номер действия

    NumByXY[X1,Y1] := CikleStep; // Номер детали в ячейке "X1, Y1" (Координата помечена – отсчет деталей от 1)
   Repeat // НАЙТИ СМЕЖНЫЕ ЯЧЕЙКИ, СО ЗНАЧЕНИЯМИ "NewNum"
    Nx := Nxy[Step1,0]; // Копируем координату X
    Ny := Nxy[Step1,1]; // Копируем координату Y
    Step1 := Step1-1;
     for StepDegree1 := 0 to 7 do PosDegree[StepDegree1] := 0; // Обновление массива
    for h1 := 0 to 2 do
    begin
     h2 := h1-1;
     Ny1 := Ny+h2;
     if (Ny1>-1) and (Ny1<h) then
     for w1 := 0 to 2 do
     begin
      w2 := w1-1;
      Nx1 := Nx+w2;
      if ((h2<>0) or (w2<>0)) and (Nx1>-1) and (Nx1<w) then
      begin

       begin
        if NumByXY[Nx1,Ny1]=0 then // Если ячейка "Nx1,Ny1" не была помечена
        begin
         Step1 := Step1+1;
         Nxy[Step1,0] := Nx1; // ЗНАЧЕНИЕ КООРДИНАТЫ "X"
         Nxy[Step1,1] := Ny1; // ЗНАЧЕНИЕ КООРДИНАТЫ "Y"

        end;
        if h1=0 then NCell1 := w1 else
        if h1=1 then NCell1 := 2*(2-w1)+3 else
        if h1=2 then NCell1 := 2*(2-w1)+3+w2; // Порядковый номер позиции вокруг ячейки, от 0 до 7
        if NCell1>3 then NCell1 := 11-NCell1 else
         NCell1 := 3-NCell1; //Выровнять позиции под угловую систему координат (180=лево, 0=право, 90=верх, 270=низ)
        PosDegree[NCell1] := 1; // 1-Если под угловой позицией "NCell1" есть схожая ячейка
       end;
      end;
     end;
    end;
    SByS1 := -1; // С учетом кол-ва ячеек, 360 градусов возможно поделить максимум на 4 отдельные части (диапазон от 0 до 3)
    SlPos1 := 1; // 1-Начало отсчета, 0-счет прерван
    for StepDegree1 := 0 to 7 do
    begin
     if PosDegree[StepDegree1]=0 then // 1-Считать углы от совпадающих ячеек, 0-от несовпадающих ячеек (+ поменять 1 на 0 ниже)
     begin
      if SlPos1=1 then // Если начало отсчета
      begin
       SByS1 := SByS1+1;

       SlPos1 := 0;
      end;

      if (StepDegree1=7) and (PosDegree[0]=0) then // Если 315 градусов и 0 градусов, являются одной частью(+поменять 1 на 0 выше)
      begin
       if SByS1>0 then // Если найдено две части или больше
       begin

        SByS1 := SByS1-1;

      end;
     end
     else SlPos1 := 1;
    end;
    if SByS1<3 then
    for SByS2 := SByS1+1 to 3 do

   Until Step1<0;
  end;
 end;

 [code=pascal]
setlength(NumByXY2,0,0);              setlength(NumByXY2,w,h);
setlength(DegreeByXY2,0,0,0,0);       setlength(DegreeByXY2,w,h,4,2);
setlength(MChanged1,0);               setlength(MChanged1,CikleStep+1);

for Y1 := 0 to h-1 do
 begin
  for X1 := 0 to w-1 do
  begin

   for StepDegree1 := 0 to 3 do
   begin

   end;
  end;
 end;

ToOneLine1 := 0; // Если =1 значит идет процесс сведения толстой промежуточной линии в однопиксельную сплошную линию

 repeat
  for StepDegree1 := 0 to CikleStep do
   MChanged1[StepDegree1] := 0; // Обновление массива
  Changed1 := 0; // 1-Если в процессе, хоть одна позиция изменена
  // Перемещение ячеек
  for Y1 := 0 to h-1 do
  begin
   for X1 := 0 to w-1 do
   if (NumByXY2[X1,Y1]>0) and (DegreeByXY2[X1,Y1,0,0]>-1)
       and (DegreeByXY2[X1,Y1,1,0]=-1)
       and (DegreeByXY2[X1,Y1,0,1]<360)
       and (DegreeByXY2[X1,Y1,0,0]<>DegreeByXY2[X1,Y1,0,1])
   then
   begin
    if DegreeByXY2[X1,Y1,0,0]<=DegreeByXY2[X1,Y1,0,1] then Deg2:=0 else Deg2:=360;
    Deg1 := (((DegreeByXY2[X1,Y1,0,1]+Deg2)-DegreeByXY2[X1,Y1,0,0])/2)+DegreeByXY2[X1,Y1,0,0]; // Найти среднее значение угла
    if Deg1>=360 then Deg1 := Deg1-360;
    // В каком направлении перемещать ячейку
    if (Deg1<=22.5) or (Deg1=337.5) then begin MoveX1 := -1; MoveY1 := 0; end else
    if Deg1=45 then      begin MoveX1 := -1; MoveY1 := 1;  end else
    if Deg1<=112.5 then  begin MoveX1 := 0;  MoveY1 := 1;  end else
    if Deg1=135 then     begin MoveX1 := 1;  MoveY1 := 1;  end else
    if Deg1<=202.5 then  begin MoveX1 := 1;  MoveY1 := 0;  end else
    if Deg1=225 then     begin MoveX1 := 1;  MoveY1 := -1; end else
    if Deg1<=292.5 then  begin MoveX1 := 0;  MoveY1 := -1; end else
    if Deg1=315 then     begin MoveX1 := -1; MoveY1 := -1; end;
    Nx1 := X1+MoveX1;     Ny1 := Y1+MoveY1; // Координаты смещенной ячейки

    ToOneLine2 := 1;
    if ToOneLine1=1 then if NumByXY2[Nx1,Ny1]<0 then ToOneLine2 := -1;  // Для сведения промежуточной в сплошную линию 

    if (Nx1>-1) and (Nx1<w) and (Ny1>-1) and (Ny1<h) then
    if abs(NumByXY2[Nx1,Ny1])*ToOneLine2=NumByXY2[X1,Y1] then // Если фрагменты совпадают
    begin
     OppositeD := 1;
     if (DegreeByXY2[Nx1,Ny1,0,0]=-1) or (ToOneLine1=1) then // Если нет направлений для смещения или сведение в сплошн. линию
     begin
      OppositeD := 0; // 1-Если в выбранной ячейке, направление перемещения противоположно первоначальному напр. "Deg1"
     end
     else
     begin
      Step1 := -1;
      for StepDegree1 := 0 to 3 do
      if DegreeByXY2[Nx1,Ny1,StepDegree1,0]>-1 then
       Step1 := Step1+1
      else break;
      if (Step1>-1) and (Step1<2) then
      begin
       OppositeD := 0;
       for StepDegree1 := 0 to Step1 do
       begin
        if DegreeByXY2[Nx1,Ny1,StepDegree1,0]<=DegreeByXY2[Nx1,Ny1,StepDegree1,1]
        then Deg3:=0 else Deg3:=360;
        Deg2 := (((DegreeByXY2[Nx1,Ny1,StepDegree1,1]+Deg3)-DegreeByXY2[Nx1,Ny1,StepDegree1,0])/2)+
                                                            DegreeByXY2[Nx1,Ny1,StepDegree1,0]; // Найти среднее значение угла
        if Deg2>=360 then Deg2 := Deg2-360;
         if Deg2<=225 then Deg3 := 0 else Deg3 := 360;
          dBord1 := (Deg2+112.5)-Deg3;
         if Deg2>=112.5 then Deg3 := 0 else Deg3 := 360;
          dBord2 := Deg3+(Deg2-112.5);
        if dBord2>dBord1 then // Если границы второй ячейки в диапазоне "к примеру" - от 112.5 до 247.5
        begin
         if (Deg1>=dBord1) AND (Deg1<=dBord2) then OppositeD := 1; // 1-Если в выбранной ячейке, направление перемещения противоположно первоначальному направлению "Deg1"
        end
        else // Если границы второй ячейки в диапазоне "к примеру" - от 292.5 до 67.5
        begin
         if (Deg1>=dBord1) OR (Deg1<=dBord2) then OppositeD := 1;
        end;
       end;
      end;
     end; 

     if OppositeD=0 then // Если в выбранной ячейке, направление перемещения схоже с первоначальным направлением
     begin
      MChanged1[NumByXY2[X1,Y1]] := 1; // Пометить измененный фрагмент
      Changed1 := 1; // 1-Если в процессе, хоть одна позиция изменена

     end;
    end;
   end;
  end;

  if ToOneLine1=1 then Changed1 := 0; 
  if (Changed1=0) and (ToOneLine1=0) then // Начать процесс сведения промежуточной линии в однопиксельную сплошную линию
  begin
   Changed1 := 1;
   ToOneLine1 := 1;
  end;

  if Changed1=0 then
  for StepDegree1 := 0 to CikleStep do
   MChanged1[StepDegree1] := 1; // Обновить угловые позиции для всех фрагментов, перед выходом из цикла
  // Определение углов
  for Y1 := 0 to h-1 do
  begin
   for X1 := 0 to w-1 do
   // Если найдена часть фрагмента и хотябы одна ячейка в этом фрагменте была передвинута
   if (NumBYXY2[X1,Y1]>0) and (MChanged1[NumByXY2[X1,Y1]]=1) then
   begin
    NewNum := NumByXY2[X1,Y1]; // Номер фрагмента для сравнения
    for StepDegree1 := 0 to 7 do PosDegree[StepDegree1] := 0; // Обновление массива
    if Changed1=0 then // Выделить промежуточную линию, по коорд. "X1,Y1"
    begin

    end;
    for h1 := 0 to 2 do
    begin
     h2 := h1-1;
     Ny1 := Y1+h2;
     if (Ny1>-1) and (Ny1<h) then
     for w1 := 0 to 2 do
     begin
      w2 := w1-1;
      Nx1 := X1+w2;
      if ((h2<>0) or (w2<>0)) and (Nx1>-1) and (Nx1<w) then
      if NumByXY2[Nx1,Ny1]=NewNum then // Если фрагменты совпадают
      begin
       if h1=0 then NCell1 := w1 else
       if h1=1 then NCell1 := 2*(2-w1)+3 else
       if h1=2 then NCell1 := 2*(2-w1)+3+w2; // Порядковый номер позиции вокруг ячейки, от 0 до 7
       if NCell1>3 then NCell1 := 11-NCell1 else
        NCell1 := 3-NCell1; //Выровнять позиции под угловую систему координат (180=лево, 0=право, 90=верх, 270=низ)
       PosDegree[NCell1] := 1; // 1-Если под угловой позицией "NCell1" есть схожая ячейка
      end;
     end;
    end;

    SByS1 := -1; // С учетом кол-ва ячеек, 360 градусов возможно поделить максимум на 4 отдельные части (диапазон от 0 до 3)
    SlPos1 := 1; // 1-Начало отсчета, 0-счет прерван
    for StepDegree1 := 0 to 7 do
    begin
     if PosDegree[StepDegree1]=ToOneLine1 then // 1-Считать углы от совпадающих, 0-от несовп. ячеек (+ поменять 1 на 0 ниже)
     begin
      if SlPos1=1 then // Если начало отсчета
      begin
       SByS1 := SByS1+1;

       SlPos1 := 0;
      end;

      if (StepDegree1=7) and (PosDegree[0]=ToOneLine1) then // Если 315 и 0 град. являются одной частью (+ поменять 1 на 0 выше)
      begin
       if SByS1>0 then // Если найдено две части или больше
       begin

        SByS1 := SByS1-1;

      end;
     end
     else SlPos1 := 1;
    end;

    if SByS1<3 then
    for SByS2 := SByS1+1 to 3 do

   end;
  end;
 until Changed1=0;

 [code=pascal]
setlength(MassPointFromAtoB,0,0);     setlength(MassPointFromAtoB,w,h); 

 // *Пояснение массива PointFromAtoB, расписано в конце алгоритма
 for StepDegree1 := 0 to length(PointFromAtoB)-1 do //  От “0” до “Количество помеченных точек – 1”
 begin // Действия ниже нужны чтобы в процессе цикла не перемещать указанные точки
  if (PointFromAtoB[StepDegree1,0]>-1) and (PointFromAtoB[StepDegree1,1]>-1) then //Если для точки “StepDegree1” указаны коорд.
  MassPointFromAtoB[ PointFromAtoB[StepDegree1,0] , PointFromAtoB[StepDegree1,1] ] := StepDegree1+1; //Передать точку в массив
 end;

setlength(NumByXY2,0,0);              setlength(NumByXY2,w,h);
setlength(DegreeByXY2,0,0,0,0);       setlength(DegreeByXY2,w,h,4,2);
setlength(MChanged1,0);               setlength(MChanged1,CikleStep+1);
  // Скопировать массивы
for Y1 := 0 to h-1 do
 begin
  for X1 := 0 to w-1 do
  begin
   NumByXY2[X1,Y1] := NumByXY[X1,Y1];
   for StepDegree1 := 0 to 3 do
   begin
    DegreeByXY2[X1,Y1,StepDegree1,0] := DegreeByXY[X1,Y1,StepDegree1,0];
    DegreeByXY2[X1,Y1,StepDegree1,1] := DegreeByXY[X1,Y1,StepDegree1,1];
   end;
  end;
 end;

ToOneLine1 := 0; // Если =1 значит идет процесс сведения толстой промежуточной линии в однопиксельную сплошную линию

 repeat
  for StepDegree1 := 0 to CikleStep do
   MChanged1[StepDegree1] := 0; // Обновление массива
  Changed1 := 0; // 1-Если в процессе, хоть одна позиция изменена
  // Перемещение ячеек
  for Y1 := 0 to h-1 do
  begin
   for X1 := 0 to w-1 do
   if (NumByXY2[X1,Y1]>0) and (DegreeByXY2[X1,Y1,0,0]>-1)
       and (DegreeByXY2[X1,Y1,1,0]=-1)
       and (DegreeByXY2[X1,Y1,0,1]<360)
       and (DegreeByXY2[X1,Y1,0,0]<>DegreeByXY2[X1,Y1,0,1])
   then
   begin
    if DegreeByXY2[X1,Y1,0,0]<=DegreeByXY2[X1,Y1,0,1] then Deg2:=0 else Deg2:=360;
    Deg1 := (((DegreeByXY2[X1,Y1,0,1]+Deg2)-DegreeByXY2[X1,Y1,0,0])/2)+DegreeByXY2[X1,Y1,0,0]; // Найти среднее значение угла
    if Deg1>=360 then Deg1 := Deg1-360;
    // В каком направлении перемещать ячейку
    if (Deg1<=22.5) or (Deg1=337.5) then begin MoveX1 := -1; MoveY1 := 0; end else
    if Deg1=45 then      begin MoveX1 := -1; MoveY1 := 1;  end else
    if Deg1<=112.5 then  begin MoveX1 := 0;  MoveY1 := 1;  end else
    if Deg1=135 then     begin MoveX1 := 1;  MoveY1 := 1;  end else
    if Deg1<=202.5 then  begin MoveX1 := 1;  MoveY1 := 0;  end else
    if Deg1=225 then     begin MoveX1 := 1;  MoveY1 := -1; end else
    if Deg1<=292.5 then  begin MoveX1 := 0;  MoveY1 := -1; end else
    if Deg1=315 then     begin MoveX1 := -1; MoveY1 := -1; end;
    Nx1 := X1+MoveX1;     Ny1 := Y1+MoveY1; // Координаты смещенной ячейки
    ToOneLine2 := 1;
    if ToOneLine1=1 then if NumByXY2[Nx1,Ny1]<0 then ToOneLine2 := -1;  // Для сведения промежуточной в сплошную линию 
    if (Nx1>-1) and (Nx1<w) and (Ny1>-1) and (Ny1<h) then
    if (abs(NumByXY2[Nx1,Ny1])*ToOneLine2=NumByXY2[X1,Y1]) // Если фрагменты совпадают
       and (MassPointFromAtoB[X1,Y1]=0) // Если точка не помечена
    then   
    begin
     OppositeD := 1;
     if (DegreeByXY2[Nx1,Ny1,0,0]=-1) or (ToOneLine1=1) then // Если нет направлений для смещения или сведение в сплошн. линию
     begin
      OppositeD := 0; // 1-Если в выбранной ячейке, направление перемещения противоположно первоначальному напр. "Deg1"
     end
     else
     begin
      Step1 := -1;
      for StepDegree1 := 0 to 3 do
      if DegreeByXY2[Nx1,Ny1,StepDegree1,0]>-1 then
       Step1 := Step1+1
      else break;
      if (Step1>-1) and (Step1<2) then
      begin
       OppositeD := 0;
       for StepDegree1 := 0 to Step1 do
       begin
        if DegreeByXY2[Nx1,Ny1,StepDegree1,0]<=DegreeByXY2[Nx1,Ny1,StepDegree1,1]
        then Deg3:=0 else Deg3:=360;
        Deg2 := (((DegreeByXY2[Nx1,Ny1,StepDegree1,1]+Deg3)-DegreeByXY2[Nx1,Ny1,StepDegree1,0])/2)+
                                                            DegreeByXY2[Nx1,Ny1,StepDegree1,0]; // Найти среднее значение угла
        if Deg2>=360 then Deg2 := Deg2-360;
         if Deg2<=225 then Deg3 := 0 else Deg3 := 360;
          dBord1 := (Deg2+112.5)-Deg3;
         if Deg2>=112.5 then Deg3 := 0 else Deg3 := 360;
          dBord2 := Deg3+(Deg2-112.5);
        if dBord2>dBord1 then // Если границы второй ячейки в диапазоне "к примеру" - от 112.5 до 247.5
        begin
         if (Deg1>=dBord1) AND (Deg1<=dBord2) then OppositeD := 1; // 1-Если в выбранной ячейке, направление перемещения противоположно первоначальному направлению "Deg1"
        end
        else // Если границы второй ячейки в диапазоне "к примеру" - от 292.5 до 67.5
        begin
         if (Deg1>=dBord1) OR (Deg1<=dBord2) then OppositeD := 1;
        end;
       end;
      end;
     end; 

     if OppositeD=0 then // Если в выбранной ячейке, направление перемещения схоже с первоначальным направлением
     begin
      MChanged1[NumByXY2[X1,Y1]] := 1; // Пометить измененный фрагмент
      Changed1 := 1; // 1-Если в процессе, хоть одна позиция изменена

     end;
    end;
   end;
  end;

  if ToOneLine1=1 then Changed1 := 0; 

  if (Changed1=0) and (ToOneLine1=0) then // Начать процесс сведения промежуточной линии в однопиксельную сплошную линию
  begin
   Changed1 := 1;
   ToOneLine1 := 1;
  end;

  if Changed1=0 then
  for StepDegree1 := 0 to CikleStep do
   MChanged1[StepDegree1] := 1; // Обновить угловые позиции для всех фрагментов, перед выходом из цикла
  // Определение углов
  for Y1 := 0 to h-1 do
  begin
   for X1 := 0 to w-1 do
   // Если найдена часть фрагмента и хотябы одна ячейка в этом фрагменте была передвинута
   if (NumBYXY2[X1,Y1]>0) and (MChanged1[NumByXY2[X1,Y1]]=1) then
   begin
    NewNum := NumByXY2[X1,Y1]; // Номер фрагмента для сравнения
    for StepDegree1 := 0 to 7 do PosDegree[StepDegree1] := 0; // Обновление массива
    if Changed1=0 then // Выделить промежуточную линию, по коорд. "X1,Y1"
    begin

    end;
    for h1 := 0 to 2 do
    begin
     h2 := h1-1;
     Ny1 := Y1+h2;
     if (Ny1>-1) and (Ny1<h) then
     for w1 := 0 to 2 do
     begin
      w2 := w1-1;
      Nx1 := X1+w2;
      if ((h2<>0) or (w2<>0)) and (Nx1>-1) and (Nx1<w) then
      if NumByXY2[Nx1,Ny1]=NewNum then // Если фрагменты совпадают
      begin
       if h1=0 then NCell1 := w1 else
       if h1=1 then NCell1 := 2*(2-w1)+3 else
       if h1=2 then NCell1 := 2*(2-w1)+3+w2; // Порядковый номер позиции вокруг ячейки, от 0 до 7
       if NCell1>3 then NCell1 := 11-NCell1 else
        NCell1 := 3-NCell1; //Выровнять позиции под угловую систему координат (180=лево, 0=право, 90=верх, 270=низ)
       PosDegree[NCell1] := 1; // 1-Если под угловой позицией "NCell1" есть схожая ячейка
      end;
     end;
    end;

    SByS1 := -1; // С учетом кол-ва ячеек, 360 градусов возможно поделить максимум на 4 отдельные части (диапазон от 0 до 3)
    SlPos1 := 1; // 1-Начало отсчета, 0-счет прерван
    for StepDegree1 := 0 to 7 do
    begin
     if PosDegree[StepDegree1]=ToOneLine1 then // 1-Считать углы от совпадающих, 0-от несовп. ячеек (+ поменять 1 на 0 ниже)
     begin
      if SlPos1=1 then // Если начало отсчета
      begin
       SByS1 := SByS1+1;

       SlPos1 := 0;
      end;

      if (StepDegree1=7) and (PosDegree[0]=ToOneLine1) then // Если 315 и 0 град. являются одной частью (+ поменять 1 на 0 выше)
      begin
       if SByS1>0 then // Если найдено две части или больше
       begin

        SByS1 := SByS1-1;

      end;
     end
     else SlPos1 := 1;
    end;

    if SByS1<3 then
    for SByS2 := SByS1+1 to 3 do

   end;
  end;
 until Changed1=0;