[AND_REY]

Ой наворотил , но работает.

Код:

Var
  InBmp, OutBmp: TBitmap;
  InP, OutP: Array of PByteArray;

Function GetPixelInP(x, y: Integer): Boolean;
begin
 Result:= ((InP[y]^[x Div 8] Shr (7 - (x Mod 8))) And 1) = 1;
end;

Function GetPixelOutP(x, y: Integer): Boolean;
begin
 Result:= ((OutP[y]^[x Div 8] Shr (7 - (x Mod 8))) And 1) = 1;
end;

Procedure ChangePixelInP(x, y: Integer);
begin
 InP[y]^[x Div 8]:= (Inp[y]^[x Div 8]) Xor (1 Shl (7 - (x Mod 8)));
end;

Procedure ChangePixelOutP(x, y: Integer);
begin
 OutP[y]^[x Div 8]:= (OutP[y]^[x Div 8]) Xor (1 Shl (7 - (x Mod 8)));
end;

Procedure RekursBmp(x, y: Integer);
begin
 if Not GetPixelInP(x, y) Then Exit;
 ChangePixelInP(x, y);
 ChangePixelOutP(x, y);
 if (x-1) >= 0 Then
  if GetPixelInP(x-1, y) Then RekursBmp(x-1, y);
 if (y-1) >= 0 Then
  if GetPixelInP(x, y-1) Then RekursBmp(x, y-1);
 if (x+1) <= InBmp.Width Then
  if GetPixelInP(x+1, y) Then RekursBmp(x+1, y);
 if (y+1) <= InBmp.Height Then
  if GetPixelInP(x, y+1) Then RekursBmp(x, y+1);
 if ((x-1) >= 0) And ((y-1) >= 0) Then
  if GetPixelInP(x-1, y-1) Then RekursBmp(x-1, y-1);
 if ((x+1) <= InBmp.Width) And ((y+1) <= InBmp.Height) Then
  if GetPixelInP(x+1, y+1) Then RekursBmp(x+1, y+1);
 if ((x-1) >= 0) And ((y+1) <= InBmp.Height) Then
  if GetPixelInP(x-1, y+1) Then RekursBmp(x-1, y+1);
 if ((x+1) <= InBmp.Width) And ((y-1) >= 0) Then
  if GetPixelInP(x+1, y-1) Then RekursBmp(x+1, y-1);
end;

Procedure ClearOutP;
Var
 i, j: Integer;
begin
 For j:= 0 To OutBmp.Height - 1 Do
  For i:= 0 To OutBmp.Height - 1 Do
   if GetPixelOutP(i, j) Then ChangePixelOutP(i, j);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 i, j, n: Integer;
begin
 n:= 1;
 InBmp:= TBitmap.Create;
 OutBmp:= TBitmap.Create;
 InBmp.PixelFormat:= pf1bit;
 InBmp.LoadFromFile('1.bmp');
 OutBmp.PixelFormat:= pf1bit;
 OutBmp.Width:= InBmp.Width;
 OutBmp.Height:= InBmp.Height;
 OutBmp.Canvas.Brush.Color:= 0;
 OutBmp.Canvas.Pen.Color:= 0;
 SetLength(InP, InBmp.Height);
 SetLength(OutP, OutBmp.Height);
 For j:= 0 To InBmp.Height - 1 Do
  begin
   InP[j]:= InBmp.ScanLine[j];
   OutP[j]:= OutBmp.ScanLine[j];
  end;
 For j:= 0 To InBmp.Height - 1 Do
  For i:= 0 To InBmp.Width - 1 Do
   if GetPixelInP(i, j) Then
    begin
     ClearOutP;
     RekursBmp(i, j);
     OutBmp.SaveToFile('Рис. №'+IntToStr(n)+'.bmp');
     Label1.Caption:= 'Штук = '+IntToStr(n);
     Application.ProcessMessages;
     Inc(n);
    end;
 OutBmp.Free;
 InBmp.Free;
end;