 Mirror

Gaussian Blur in Delphi (Views: 108)

 Problem/Question/Abstract:Gaussian Blur in DelphiAnswer:The gaussian kernel exp(-(x^2 + y^2)) is of the form f(x)*g(y), which means that you can perform a two-dimensional convolution by doing a sequence of one-dimensional convolutions - first you convolve each row and then each column. This is much faster (an N^2 becomes an N*2). Any convolution requires some temporary storage - below the BlurRow routine allocates and frees the memory, meaning that it gets allocated and freed once for each row. Probably changing this would speed it up some, it's not entirely clear how much.The kernel "size" is limited to 200 entries. In fact if you use radius anything like that large it will take forever - you want to try this with a radius = 3 or 5 or something. For a kernel with that many entries a straight convolution is the thing to do, while when the kernel gets much larger Fourier transform techniques will be better (I couldn't say what the actual cutoff is.)One comment that needs to be made is that a gaussian blur has the magical property that you can blur each row one by one and then blur each column - this is much faster than an actual 2-d convolution.Anyway, you can do this:unit GBlur2;interfaceuses  Windows, Graphics;type  PRGBTriple = ^TRGBTriple;  TRGBTriple = packed record    b: byte; {easier to type than 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 = record    Size: TKernelSize;    Weights: array[-MaxKernelSize..MaxKernelSize] of single;  end;  {the idea is that when using a TKernel you ignore the Weights except  for Weights in the range -Size..Size.}procedure GBlur(theBitmap: TBitmap; radius: double);implementationuses  SysUtils;procedure MakeGaussianKernel(var K: TKernel; radius: double; MaxData, DataGranularity: double);{makes K into a gaussian kernel with standard deviation = radius. For the current applicationyou set MaxData = 255 and DataGranularity = 1. Now the procedure sets the value of K.Size sothat when we use K we will ignore the Weights that are so small they can't possibly matter. (SmallSize is good because the execution time is going to be propertional to K.Size.)}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;  {now divide by constant so 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;  {now discard (or rather mark as ignorable by setting Size) the entries that are too small to matter.  This is important, otherwise a blur with a small radius will take as long as with a large radius...}  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;  {now just to be correct go back and jiggle again so the sum of the entries we'll be using is exactly 1}  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, etc}  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];      {the TrimInt keeps us from running off the edge of the row...}      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, theRow, (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 only works for 24-bit bitmaps');  MakeGaussianKernel(K, radius, 255, 1);  GetMem(theRows, theBitmap.Height * SizeOf(PRow));  GetMem(ACol, theBitmap.Height * SizeOf(TRGBTriple));  {record the location of the bitmap data:}  for Row := 0 to theBitmap.Height - 1 do    theRows[Row] := theBitmap.Scanline[Row];  {blur each row:}  P := AllocMem(theBitmap.Width * SizeOf(TRGBTriple));  for Row := 0 to theBitmap.Height - 1 do    BlurRow(Slice(theRows[Row]^, theBitmap.Width), K, P);  {now blur each column}  ReAllocMem(P, theBitmap.Height * SizeOf(TRGBTriple));  for Col := 0 to theBitmap.Width - 1 do  begin    {first read the column into a TRow:}    for Row := 0 to theBitmap.Height - 1 do      ACol[Row] := theRows[Row][Col];    BlurRow(Slice(ACol^, theBitmap.Height), K, P);    {now put that row, um, column back into the data:}    for Row := 0 to theBitmap.Height - 1 do      theRows[Row][Col] := ACol[Row];  end;  FreeMem(theRows);  FreeMem(ACol);  ReAllocMem(P, 0);end;end.Example: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;Note that displaying 24-bit bitmaps on a 256-color system requires some special tricks - if this looks funny at 256 colors it doesn't prove the blur is wrong.

<< Back to main page