#pas
// Обработка этап 4  Поиск контуров
procedure TFm1.Button5Click(Sender: TObject);
Var X,Y,w,h,C:Integer;
  //Поиск границ контура
  // X,Y любая точка принадлежащая контуру
function ScanOBJ(Var image:tBitmap;x,y:integer):trect;
const    delta: array[1 .. 8] of record dx, dy: integer;
end =    (      (dx:0; dy:1),
                (dx:1; dy:0),
                (dx:0; dy:-1),
                (dx:-1; dy:0),
                (dx:1; dy:1),
                (dx:1; dy:-1),
                (dx:-1; dy:1),
                (dx:-1; dy:-1)    );
var
tempr:trect;
i,XC,YC,H,W: integer;
 R:TLazRegion;
begin
with result do
begin
 Left := x; Top := y;
 Right := x; Bottom := y;
end;
image.Canvas.Pixels[x, y] := clRed;
//Application.ProcessMessages;
w:=image.Width-1;
h:=image.Height-1;
for i := 1 to 8 do
begin
 XC:=x+delta[i].dx;
 YC:=y+delta[i].dy ;
  if not (xc in[0..w]) then  next;
  if not (yc in[0..h]) then  next;
if (Image.Canvas.Pixels[xc,yc] = clBlack) then
begin
  tempr := ScanOBJ(image, x+delta[i].dx,y+delta[i].dy);
  if tempr.Left <= result.left then result.Left := tempr.Left;
  if tempr.right >= result.right then result.right := tempr.right;
  if tempr.top <= result.top then result.top := tempr.top;
  if tempr.bottom >= result.bottom then result.bottom := tempr.bottom;
 end;
end;
end;
 Label L1,LE;
 Var
 B,b2:TBitmap;
 R:TRect;
 FL:Boolean;
 begin
 // ShowMessage('0') ;
 Imag1.Picture.Bitmap.Canvas.Brush.Color:=clWhite;
 Imag1.Picture.Bitmap.Canvas.FillRect(Imag1.Picture.Bitmap.Canvas.ClipRect);
 ClArBMP;
 FL:=false;
 Repeat
  B := TBitmap.Create;
  B.Assign(Image2.Picture.Bitmap);
  W:=B.Width;
  H:=B.Height;
// Поиск первой точки
For X:=0 to W-1 do
   For Y:=0 to H-1 do
   begin
    C:= B.Canvas.Pixels[X,Y];
    if C=clBlack then begin
      //Запуск рекурсивного поиска границ
    R:=ScanOBJ(B,x,y );
   // Application.ProcessMessages;
      Goto L1;
    end;
   // Application.ProcessMessages;
  end;
  FL:=true;
  GOTO LE;
L1:   // !!!
Image2.Picture.Bitmap.Clear;
Image2.Picture.Assign(B);
//Lab1.Caption:= format('X:%d, Y:%d, X1:%d, Y1:%d',
//           [r.left, r.Top, r.Right, r.Bottom] );
   if R.Right <W-1 then inc(R.Right,1) ;
   if R.Bottom <h-1 then inc(R.Bottom,1) ;
{-------------Нарезка блоков--------------------------- }
//Imag1.Picture.Assign(B);
b2:=TBitmap.Create;
B2.SetSize(r.Right-r.Left+1,r.Bottom-r.Top+1);
B2.Canvas. CopyRect(rect(0,0,b2.Width-1,b2.Height-1),bs.Canvas,r);
InsertBMP( b2);
B.Clear;

//============Визуализатция =======================
SELF.CheckBox1.Checked:=false;
B.Assign(Imag1.Picture.Bitmap);
  //B.Canvas.Brush.Color:=clRed;
  B.Canvas.Pen.Color:=clred;
  B.Canvas.Frame(r);
  B.Canvas.TextOut(r.Left,r.Top,intToStr(CB-1));
  Imag1.Picture.Assign(B);
//  Image3.Picture.Bitmap.Assign (b2);
  Image3.Picture.Bitmap.Assign (IC[CB-1]);
//  ShowMessage(intToStr(CB));
LE:  Until Fl;
 b.Free;
end;