Размыть изображение

Материал из DRKB


Размытие по соседним точкам[править | править код]

В этом способе цвету каждой точки присваивается среднее значение цветов соседних точек.


procedure TForm1.Button1Click(Sender: TObject);
const
  width = 100;
  height = 60;
  d = 2;

var
  x, y: Integer;
  i, j: Integer;
  c: Integer;
  Pix: array [0..width-1, 0..height-1] of Byte;
begin
  Randomize;
  with Form1.Canvas do
  begin
    Font.Name := 'Arial';
    Font.Size := 30;
    TextOut(d, d, 'Text');

    for y := 0 to height - 1 do
      for x := 0 to width - 1 do
        Pix[x, y] := GetRValue(Pixels[x, y]);
    for y := d to height - d - 1 do
    begin
      for x := d to width - d - 1 do
      begin
        c := 0;
        for i := -d to d do
          for j := -d to d do
            c := c + Pix[x+i, y+j];
        c := Round(c / sqr(2 * d + 1));

        Pixels[x, y] := RGB(c, c, c);
      end;
      Application.ProcessMessages;
    end;
  end;
end;


Author: Даниил Карапетян
Author: Алексей Денисов
ID: 03856



Фильтр размытия по Гауссу (Gaussian Blur)[править | править код]

Ну вот, добрались и до фильтров. В неформальных испытаниях этот код оказался вдвое быстрее, чем это делает Adobe Photoshop. Мне кажется есть множество фильтров, которые можно переделать или оптимизировать для быстроты обработки изображений.

Ядро гауссовой функции exp(-(x^2 + y^2)) есть разновидность формулы f(x) * g(y), которая означает, что мы можем выполнить двумерную свертку, делая последовательность одномерных сверток - сначала мы свертываем каждую строчку изображения, затем - каждую колонку. Хороший повод для ускорения (N^2 становится N*2). Любая свертка требует некоторого место для временного хранения результатов - ниже в коде программа BlurRow как раз распределяет и освобождает память для каждой колонки. Вероятно это должно ускорить обработку изображения, правда не ясно насколько.

Поле "size" в записи TKernel ограничено значением 200. Фактически, если вы хотите использовать еще больший радиус, это не вызовет проблем - попробуйте со значениями radius = 3, 5 или другими. Для большого количества данных методы свертки на поверку оказываются эффективнее преобразований Фурье (как показали опыты).

Еще один комментарий все же необходим: гауссово размывание имеет одно магическое свойство, а именно - вы можете сначала размыть каждую строчку (применить фильтр), затем каждую колонку - фактически получается значительно быстрее, чем двумерная свертка. Во всяком случае вы можете сделать так


unit GBlur2;

interface

uses Windows, Graphics;

type
  PRGBTriple = ^TRGBTriple;

  TRGBTriple = packed record
    b: Byte; //легче для использования чем типа rgbtBlue...
    g: Byte;
    r: Byte;
  end;

  PRow = ^TRow;
  TRow = array[0..1000000] of TRGBTriple;

  PPRows = ^TPRows;
  TPRows = array[0..1000000] of PRow;


const
  MaxKernelSize = 100;

type
  TKernelSize = 1..MaxKernelSize;

  // идея заключается в том, что при использовании TKernel мы игнорируем
  // Weights (вес), за исключением Weights в диапазоне -Size..Size.
  TKernel = record
    Size: TKernelSize;
    Weights: array[-MaxKernelSize..MaxKernelSize] of single;
  end;

procedure GBlur(theBitmap: TBitmap; radius: double);

implementation

uses SysUtils;

// Делаем K (гауссово зерно) со среднеквадратичным отклонением = radius.
// Для текущего приложения мы устанавливаем переменные MaxData = 255,
// DataGranularity = 1. Теперь в процедуре установим значение
// K.Size так, что при использовании K мы будем игнорировать Weights (вес)
// с наименее возможными значениями. (Малый размер нам на пользу,
// поскольку время выполнения напрямую зависит от
// значения K.Size.)
procedure MakeGaussianKernel(var K: TKernel;
  radius: Double; MaxData, DataGranularity: Double);
var
  j: Integer;
  temp, delta: Double;
  KernelSize: TKernelSize;
begin
  for j := Low(K.Weights) to High(K.Weights) do
  begin
    temp := j / radius;
    K.Weights[j] := exp(-temp * temp / 2);
  end;

  // делаем так, чтобы sum(Weights) = 1:
  temp := 0;
  for j := Low(K.Weights) to High(K.Weights) do
    temp := temp + K.Weights[j];
  for j := Low(K.Weights) to High(K.Weights) do
    K.Weights[j] := K.Weights[j] / temp;

  // теперь отбрасываем (или делаем отметку "игнорировать"
  // для переменной Size) данные, имеющие относительно небольшое значение -
  // это важно, в противном случае смазавание происходим с малым радиусом и
  // той области, которая "захватывается" большим радиусом...
  KernelSize := MaxKernelSize;
  delta := DataGranularity / (2 * MaxData);
  temp := 0;
  while (temp < delta) and (KernelSize > 1) do
  begin
    temp := temp + 2 * K.Weights[KernelSize];
    Dec(KernelSize);
  end;
  K.Size := KernelSize;

  // теперь для корректности возвращаемого результата проводим ту же
  // операцию с K.Size, так, чтобы сумма всех данных была равна единице:
  temp := 0;
  for j := -K.Size to K.Size do
    temp := temp + K.Weights[j];
  for j := -K.Size to K.Size do
    K.Weights[j] := K.Weights[j] / temp;
end;

function TrimInt(Lower, Upper, theInteger: Integer): Integer;
begin
  if (theInteger <= Upper) and (theInteger >= Lower) then
    Result := theInteger
  else
  if theInteger > Upper then
    Result := Upper
  else
    Result := Lower;
end;

function TrimReal(Lower, Upper: Integer; x: Double): Integer;
begin
  if (x < Upper) and (x >= Lower) then
    Result := trunc(x)
  else
  if x > Upper then
    Result := Upper
  else
    Result := Lower;
end;

procedure BlurRow(var theRow: array of TRGBTriple; K: TKernel; P: PRow);
var
  j, n, LocalRow: Integer;
  tr, tg, tb: Double; // tempRed и др.
  w: Double;
begin
  for j := 0 to High(theRow) do
  begin
    tb := 0;
    tg := 0;
    tr := 0;
    for n := -K.Size to K.Size do
    begin
      w := K.Weights[n];

      // TrimInt задает отступ от края строки...
      with theRow[TrimInt(0, High(theRow), j - n)] do
      begin
        tb := tb + w * b;
        tg := tg + w * g;
        tr := tr + w * r;
      end;
    end;
    with P[j] do
    begin
      b := TrimReal(0, 255, tb);
      g := TrimReal(0, 255, tg);
      r := TrimReal(0, 255, tr);
    end;
  end;

  Move(P[0], theRow[0], (High(theRow) + 1) * SizeOf(TRGBTriple));
end;

procedure GBlur(theBitmap: TBitmap; radius: Double);
var
  Row, Col: Integer;
  theRows: PPRows;
  K: TKernel;
  ACol: PRow;
  P: PRow;
begin
  if (theBitmap.HandleType <> bmDIB) or (theBitmap.PixelFormat <> pf24Bit) then
    raise Exception.Create('GBlur может работать только с 24-битными изображениями');

  MakeGaussianKernel(K, radius, 255, 1);
  GetMem(theRows, theBitmap.Height * SizeOf(PRow));
  GetMem(ACol, theBitmap.Height * SizeOf(TRGBTriple));

  // запись позиции данных изображения:
  for Row := 0 to theBitmap.Height - 1 do
    theRows[Row] := theBitmap.Scanline[Row];

  // размываем каждую строчку:
  P := AllocMem(theBitmap.Width * SizeOf(TRGBTriple));
  for Row := 0 to theBitmap.Height - 1 do
    BlurRow(Slice(theRows[Row]^, theBitmap.Width), K, P);

  // теперь размываем каждую колонку
  ReAllocMem(P, theBitmap.Height * SizeOf(TRGBTriple));
  for Col := 0 to theBitmap.Width - 1 do
  begin
    // считываем первую колонку в TRow:
    for Row := 0 to theBitmap.Height - 1 do
      ACol[Row] := theRows[Row][Col];

    BlurRow(Slice(ACol^, theBitmap.Height), K, P);

    // теперь помещаем обработанный столбец на свое место в данные изображения:
    for Row := 0 to theBitmap.Height - 1 do
      theRows[Row][Col] := ACol[Row];
  end;

  FreeMem(theRows);
  FreeMem(ACol);
  ReAllocMem(P, 0);
end;

end.


Пример использования:

procedure TForm1.Button1Click(Sender: TObject);
var
  b: TBitmap;
begin
  if not openDialog1.Execute then exit;
  b := TBitmap.Create;
  b.LoadFromFile(OpenDialog1.Filename);
  b.PixelFormat := pf24Bit;
  Canvas.Draw(0, 0, b);
  GBlur(b, StrToFloat(Edit1.text));
  Canvas.Draw(b.Width, 0, b);
  b.Free;
end;


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


ID: 03857
ID: 03860