Как вычислить прямоугольник прямой сборки растрового изображения?

Мне нужно вычислить прямоугольник прямой сборки для растрового изображения с помощью заданного цвета фона. На следующих рисунках вы можете увидеть, что значит быть близким. На левой стороне находится источник с правой стороны выходного изображения:

enter image description here

enter image description here

Как вы можете видеть, мне нужно найти самые верхние, самые левые, самые нижние и самые правые пиксели, которые отличаются по цвету от фона, чтобы построить прямоугольник закрытой обрезки. Итак, как найти эти разные внешние пиксели, чтобы получить прямоугольник сплошной культуры? Или, другими словами, как вычислить прямоугольник прямой сборки растрового изображения?

Ответ 1

Вы можете использовать этот код (вы можете следовать commented version этого сообщения):

procedure CalcCloseCrop(ABitmap: TBitmap; const ABackColor: TColor;
  out ACropRect: TRect);
var
  X: Integer;
  Y: Integer;
  Color: TColor;
  Pixel: PRGBTriple;
  RowClean: Boolean;
  LastClean: Boolean;
begin
  if ABitmap.PixelFormat <> pf24bit then
    raise Exception.Create('Incorrect bit depth, bitmap must be 24-bit!');

  LastClean := False;
  ACropRect := Rect(ABitmap.Width, ABitmap.Height, 0, 0);

  for Y := 0 to ABitmap.Height-1 do
  begin
    RowClean := True;
    Pixel := ABitmap.ScanLine[Y];
    for X := 0 to ABitmap.Width - 1 do
    begin
      Color := RGB(Pixel.rgbtRed, Pixel.rgbtGreen, Pixel.rgbtBlue);
      if Color <> ABackColor then
      begin
        RowClean := False;
        if X < ACropRect.Left then
          ACropRect.Left := X;
        if X + 1 > ACropRect.Right then
          ACropRect.Right := X + 1;
      end;
      Inc(Pixel);
    end;

    if not RowClean then
    begin
      if not LastClean then
      begin
        LastClean := True;
        ACropRect.Top := Y;
      end;
      if Y + 1 > ACropRect.Bottom then
        ACropRect.Bottom := Y + 1;
    end;
  end;

  if ACropRect.IsEmpty then
  begin
    if ACropRect.Left = ABitmap.Width then
      ACropRect.Left := 0;
    if ACropRect.Top = ABitmap.Height then
      ACropRect.Top := 0;
    if ACropRect.Right = 0 then
      ACropRect.Right := ABitmap.Width;
    if ACropRect.Bottom = 0 then
      ACropRect.Bottom := ABitmap.Height;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  R: TRect;
  Bitmap: TBitmap;
begin
  CalcCloseCrop(Image1.Picture.Bitmap, $00FFA749, R);
  Bitmap := TBitmap.Create;
  try
    Bitmap.SetSize(R.Width, R.Height);
    Bitmap.Canvas.CopyRect(Rect(0, 0, R.Width, R.Height), Image1.Canvas, R);
    Image1.Picture.Bitmap.Assign(Bitmap);
  finally
    Bitmap.Free;
  end;
end;