VPF::Подрезать изображение - Форум программистов

Leos239

Дата 16.6.2007, 11:35 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 28
Регистрация: 26.11.2006

Репутация: нет
Всего: нет

Допустим есть изоражение: на большом белом фоне есть небольшая картинка. Необходимо автоматически обрезвать белые края, чтобы на рисунке осталось только изображение. Подскажите пожалуйста как можно это быстро сделать?
т.е. сделать что-то вроде аналогичного Trim в фотошопе.

Это сообщение отредактировал(а) Leos239 - 16.6.2007, 11:36

Alexeis

Дата 17.6.2007, 15:18 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

Сканировать изображение

Код


procedure TForm1.Button1Click(Sender: TObject);
var
  B, b2 : TBitMap;
  p : array of PbyteArray;
  i, j : Integer;
  fl : boolean;
  fromtop, fromleft, fromright, frombottom : integer;

begin
  B := TBitMap.Create;
  B.LoadFromFile('H:\Рисунки\фон\Копия Облака.bmp');
  b.PixelFormat := pf24Bit;
  setLength(p, b.Height);

  for i := 0 to b.Height - 1
  do
    p[i] := b.ScanLine[i];

  for i := 0 to b.Height - 1
  do
    Begin
      fl := true;
      for j := 0 to b.Width * 3 - 1
      do
        if p[i][j] <> 255
        then
          Begin
            fl      := false;
            fromtop := i;
            break;
          end;

        if not fl
        then
          break;
    end;

  for I := b.Height - 1 downto 0
  do
    Begin
      fl := true;
      for j := 0 to b.Width * 3 - 1
      do
        if p[i][j] <> 255
        then
          Begin
            fl         := false;
            frombottom := i;
            break;
          end;
      
      if not fl
      then
        break;
    end;

  for j := 0 to b.Width - 1
  do
    Begin
      fl := true;
      for I := 0 to b.Height - 1
      do
        if (p[i][j*3]   <> 255) or
           (p[i][j*3+1] <> 255) or
           (p[i][j*3+2] <> 255)
        then
          Begin
            fl         := false;
            fromLeft := j;
            break;
          end;

      if not fl
      then
        break;
    end;

  for j := b.Width - 1 downto 0
  do
    Begin
      fl := true;
      for I := 0 to b.Height - 1
      do
        if (p[i][j*3]   <> 255) or
           (p[i][j*3+1] <> 255) or
           (p[i][j*3+2] <> 255)
        then
          Begin
            fl        := false;
            fromRight := j;
            break;
          end;

      if not fl
      then
        break;
    end;

  b2 := TBitMap.Create;
  b2.Width  := fromRight  - fromLeft + 1;
  b2.Height := frombottom - fromtop + 1;
  b2.Canvas.CopyRect(Rect(0, 0,
                          fromRight  - fromLeft+2,
                          frombottom - fromtop+1),
                     b.Canvas, Rect(fromLeft, fromtop,
                             fromRight+1, frombottom+1));
  b2.SaveToFile('H:\Рисунки\фон\Копия Облака2.bmp');
  b2.Free;
  b.Free;
end;

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

Leos239

Дата 17.6.2007, 22:49 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 28
Регистрация: 26.11.2006

Репутация: нет
Всего: нет

Спасибо! Вроде всё понятно. Подработаю и сделаю, чтобы любой цвет можно было подрезать (ну цвет пикселя с угла).

А нет случайно более быстрого способа?

Alexeis

Дата 17.6.2007, 23:05 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

Есть. Бинарный поиск. Начать с левой половины, ее разделить на 2 четверти. Проверить раздельную линию. Если она белая то берем левую половину для поиска иначе правую. Потом опять делим сегмент. Но это все будет работать если внутри изображения нет чисто белых строк или столбцов. Скорость поиска тогда Log2N, что намного быстрее чем N.

--------------------

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »