unit filterBlur ;
(* ***** BEGIN LICENSE BLOCK *****
* Copyright (C) 2004 Durand Emmanuel
* Copyright (C) 2004 Burgel Eric
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version.
*
* This library is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*
* Contact :
* filters@edurand.com
* filters@burgel.com
*
* ***** END LICENSE BLOCK ***** *)
{
eburgel (filters@burgel.com)
}
interface
uses
filter, fparameters, image;
type
TFilterBlur = class(TFilter)
public
constructor Create; override;
procedure Run(); override;
procedure RunGaussian() ;
procedure RunFastBlur() ;
procedure RunFastAnisotropicBlur();
private
parameterImageIn, parameterImageOut : TParameterImage;
parameterRadius : TParameterInteger ;
parameterBlurType : TParameterInteger ;
hMultA : array of Integer ;
vMultA : array of Integer ;
imgIn, imgOut : PBitmap32 ;
procedure blurHLineAnisotropic(pDest, pSrc :PColor32Array ; width:Integer ; radius:Integer) ;
procedure blurVLineAnisotropic(pDest, pSrc :PColor32Array ; width, height:Integer ; radius:Integer) ;
end;
implementation
uses Windows, Math ;
constructor TFilterBlur.Create;
begin
inherited;
parameterImageIn:=addParameterImage('inImage', 'input image to blur');
parameterImageOut:=addParameterImage('outImage', 'blur result image');
parameterRadius := addParameterInteger('radius', 'radius', 0, 255, 128) ;
parameterBlurType := addParameterInteger('mode', 'blur type', 0, 2, 0) ;
end;
procedure TFilterBlur.Run();
Begin
imgIn := parameterImageIn.Image ;
imgOut := parameterImageOut.Image ;
if (imgIn<>nil) and (imgOut<>nil) then begin
case parameterBlurType.Value of
0 : RunFastBlur();
1 : RunFastAnisotropicBlur();
2 : RunGaussian() ;
end;
end ;
End ;
// rather fast Blur
procedure blurLine(pDest, pSrc :PColor32Array ; width:Integer ; radius:Cardinal) ;
Var
x : Cardinal ;
red, green, blue : Cardinal ;
cumulRed, cumulGreen, cumulBlue : Cardinal ;
multA, multB : Cardinal ;
color : Cardinal ;
Begin
multA := radius ;
multB := $100-radius ;
//cumulRed := ((pSrc^[0] shr 16) and $FF)*$100 ;
cumulRed := ((pSrc^[0] shr 16) and $FF) ;
cumulGreen := (pSrc^[0] shr 8) and $FF ;
cumulBlue := pSrc^[0] and $FF ;
for x:=0 to Width-1 do Begin
// Horizontal blur
//red := (pSrc^[0] shr 8) and $FF00 ;
red := (pSrc^[0] shr 16) and $FF ;
green := (pSrc^[0] shr 8) and $FF ;
blue := pSrc^[0] and $FF ;
cumulRed := (cumulRed * multA + red * multB+$80) div $100 ;
cumulGreen := (cumulGreen * multA + Green * multB+$80) div $100 ;
cumulBlue := (cumulBlue * multA + Blue * multB+$80) div $100 ;
color := ((cumulRed) shl 16) or (cumulGreen shl 8) or (cumulBlue) ;
pDest^[0] := color ;
inc(pSrc) ;
inc(pDest) ;
End ;
dec(pDest) ;
pSrc := pDest ;
cumulRed := ((pSrc^[0] shr 16) and $FF) ;
cumulGreen := (pSrc^[0] shr 8) and $FF ;
cumulBlue := pSrc^[0] and $FF ;
for x:=Width-1 Downto 0 do Begin
// Horizontal blur
red := (pSrc^[0] shr 16) and $FF ;
green := (pSrc^[0] shr 8) and $FF ;
blue := pSrc^[0] and $FF ;
//DivMod((cumulRed * multA + red * multB), $1000, cumulRed,
cumulRed := (cumulRed * multA + red * multB+$80) div $100 ;
cumulGreen := (cumulGreen * multA + Green * multB+$80) div $100 ;
cumulBlue := (cumulBlue * multA + Blue * multB+$80) div $100 ;
color := (cumulRed shl 16) or (cumulGreen shl 8) or (cumulBlue) ;
pDest^[0] := color ;
dec(pSrc) ;
dec(pDest) ;
End ;
End ;
procedure TFilterBlur.RunFastBlur();
var
pSrc, PDest, PLine : PColor32Array;
x, y, maxX, maxY : Cardinal ;
color : Cardinal ;
radius : Cardinal ;
multA, multB : Cardinal ;
red, green, blue : Cardinal ;
cumulRed, cumulGreen, cumulBlue : Cardinal ;
imgIn_Hline : PColor32Array;
begin
maxX := scanWidth(imgIn)-1 ;
maxY := scanHeight(imgIn)-1 ;
setlength(hMultA, maxX+1) ;
setlength(vMultA, maxY+1) ;
radius := parameterRadius.Value ;
multA := radius ;
multB := 256-radius ;
//pLine := imgIn.Hline ;
//pSrc := scanLine(imgIn, 0) ;
//pDest := scanLine(imgOut, 0) ;
GetMem(imgIn_Hline, imgIn.Width*SizeOf(TColor32)) ;
FillChar(imgIn_Hline^, imgIn.Width*SizeOf(TColor32), 0);
for y:=0 to maxY do Begin
pSrc := scanLine(imgIn, y) ;
pDest := scanLine(imgOut, y) ;
pLine := imgIn_Hline ;
blurLine(pDest, pSrc, maxX+1, radius) ;
for x:=RegionOfInterest.Left to maxX do Begin
cumulRed := (pLine^[0] shr 16) and $FF ;
cumulGreen := (pLine^[0] shr 8) and $FF ;
cumulBlue := pLine^[0] and $FF ;
// Vertical blur
red := (((pDest^[0] shr 16) and $FF) * multB + cumulRed * multA) div $100 ;
green := (((pDest^[0] shr 8) and $FF) * multB + cumulGreen * multA) div $100 ;
blue := ((pDest^[0] and $FF) * multB + cumulBlue * multA) div $100 ;
color := (red shl 16) or (green shl 8) or (blue) ;
pLine^[0] := color ;
//pDest^[0] := pLine^[0] ;
pDest^[0] := color ;
inc(pDest) ;
//inc(pSrc) ;
inc(pLine) ;
End ;
end ;
for y:=maxY downto 0 do Begin
// pSrc := scanLine(imgIn, y) ;
pDest := scanLine(imgOut, y) ;
pLine := imgIn_Hline ;
for x:=RegionOfInterest.Left to maxX do Begin
cumulRed := (pLine^[0] shr 16) and $FF ;
cumulGreen := (pLine^[0] shr 8) and $FF ;
cumulBlue := pLine^[0] and $FF ;
// Vertical blur
red := (((pDest^[0] shr 16) and $FF) * multB + cumulRed * multA) div $100 ;
green := (((pDest^[0] shr 8) and $FF) * multB + cumulGreen * multA) div $100 ;
blue := ((pDest^[0] and $FF) * multB + cumulBlue * multA) div $100 ;
color := (red shl 16) or (green shl 8) or (blue) ;
pLine^[0] := color ;
pDest^[0] := color ;
inc(pDest) ;
// inc(pSrc) ;
inc(pLine) ;
End ;
End ;
FreeMem( imgIn_Hline );
end;
{************************************************************************
* Anisotropic version of fast blur *
************************************************************************}
// Anisotropic version
procedure TFilterBlur.blurHLineAnisotropic(pDest, pSrc :PColor32Array ; width:Integer ; radius:Integer) ;
Var
x : Cardinal ;
red, green, blue : Integer ;
cumulRed, cumulGreen, cumulBlue : Integer ;
color : Cardinal ;
multA, multB : Integer ;
diffIntensity, curIntensity, prevIntensity : Integer ;
pSrcVar : PColor32Array ;
Begin
prevIntensity := 1000 ;
pSrcVar := pSrc ;
for x:=0 to Width-1 do Begin
curIntensity := Intensity(pSrcVar^[0]) ;
diffIntensity := Abs(curIntensity-prevIntensity) ;
multA := radius - diffIntensity*4 ;
if multA > 200 then multA := 200 else if multA < 0 then multA := 0 ;
hMultA[x] := multA ;
prevIntensity := curIntensity ;
inc(pSrcVar) ;
end ;
cumulRed := ((pSrc^[0] shr 16) and $FF) ;
cumulGreen := (pSrc^[0] shr 8) and $FF ;
cumulBlue := pSrc^[0] and $FF ;
for x:=0 to Width-1 do Begin
// Horizontal blur
// color extraction
red := (pSrc^[0] shr 16) and $FF ;
green := (pSrc^[0] shr 8) and $FF ;
blue := pSrc^[0] and $FF ;
multA := hMultA[x] ;
multB := $100-multA ;
cumulRed := (cumulRed * multA + red * multB+$80) div $100 ;
cumulGreen := (cumulGreen * multA + Green * multB+$80) div $100 ;
cumulBlue := (cumulBlue * multA + Blue * multB+$80) div $100 ;
color := ((cumulRed) shl 16) or (cumulGreen shl 8) or (cumulBlue) ;
pDest^[0] := color ;
inc(pSrc) ;
inc(pDest) ;
End ;
dec(pDest) ;
pSrc := pDest ;
cumulRed := ((pSrc^[0] shr 16) and $FF) ;
cumulGreen := (pSrc^[0] shr 8) and $FF ;
cumulBlue := pSrc^[0] and $FF ;
for x:=Width-1 Downto 0 do Begin
// Horizontal blur
red := (pSrc^[0] shr 16) and $FF ;
green := (pSrc^[0] shr 8) and $FF ;
blue := pSrc^[0] and $FF ;
multA := hMultA[x] ;
multB := $100-multA ;
//DivMod((cumulRed * multA + red * multB), $1000, cumulRed,
cumulRed := (cumulRed * multA + red * multB+$80) div $100 ;
cumulGreen := (cumulGreen * multA + Green * multB+$80) div $100 ;
cumulBlue := (cumulBlue * multA + Blue * multB+$80) div $100 ;
color := (cumulRed shl 16) or (cumulGreen shl 8) or (cumulBlue) ;
pDest^[0] := color ;
dec(pSrc) ;
dec(pDest) ;
End ;
End ;
procedure TFilterBlur.blurVLineAnisotropic(pDest, pSrc :PColor32Array ; width, height:Integer ; radius:Integer) ;
Var
y : Cardinal ;
red, green, blue : Integer ;
cumulRed, cumulGreen, cumulBlue : Integer ;
color : Cardinal ;
multA, multB : Integer ;
diffIntensity, curIntensity, prevIntensity : Integer ;
pSrcVar : PColor32Array ;
Begin
prevIntensity := 1000 ;
pSrcVar := pSrc ;
for y:=0 to Height-1 do Begin
curIntensity := Intensity(pSrcVar^[0]) ;
diffIntensity := Abs(curIntensity-prevIntensity) ;
multA := radius - diffIntensity*4 ;
if multA > 200 then multA := 200 else if multA < 0 then multA := 0 ;
vMultA[y] := multA ;
prevIntensity := curIntensity ;
inc(pSrcVar, width) ;
end ;
cumulRed := ((pSrc^[0] shr 16) and $FF) ;
cumulGreen := (pSrc^[0] shr 8) and $FF ;
cumulBlue := pSrc^[0] and $FF ;
for y:=0 to Height-1 do Begin
// Vertical blur
// color extraction
red := (pSrc^[0] shr 16) and $FF ;
green := (pSrc^[0] shr 8) and $FF ;
blue := pSrc^[0] and $FF ;
multA := vMultA[y] ;
multB := $100-multA ;
cumulRed := (cumulRed * multA + red * multB+$80) div $100 ;
cumulGreen := (cumulGreen * multA + Green * multB+$80) div $100 ;
cumulBlue := (cumulBlue * multA + Blue * multB+$80) div $100 ;
color := ((cumulRed) shl 16) or (cumulGreen shl 8) or (cumulBlue) ;
pDest^[0] := color ;
inc(pSrc, width) ;
inc(pDest, width) ;
End ;
dec(pDest, width) ;
pSrc := pDest ;
cumulRed := ((pSrc^[0] shr 16) and $FF) ;
cumulGreen := (pSrc^[0] shr 8) and $FF ;
cumulBlue := pSrc^[0] and $FF ;
for y:=Height-1 Downto 0 do Begin
// Vertical blur
red := (pSrc^[0] shr 16) and $FF ;
green := (pSrc^[0] shr 8) and $FF ;
blue := pSrc^[0] and $FF ;
multA := vMultA[y] ;
multB := $100-multA ;
//DivMod((cumulRed * multA + red * multB), $1000, cumulRed,
cumulRed := (cumulRed * multA + red * multB+$80) div $100 ;
cumulGreen := (cumulGreen * multA + Green * multB+$80) div $100 ;
cumulBlue := (cumulBlue * multA + Blue * multB+$80) div $100 ;
color := (cumulRed shl 16) or (cumulGreen shl 8) or (cumulBlue) ;
pDest^[0] := color ;
dec(pSrc, width) ;
dec(pDest, width) ;
End ;
End ;
procedure TFilterBlur.RunFastAnisotropicBlur();
var
pSrc, PDest : PColor32Array;
x, y, maxX, maxY : Cardinal ;
radius : Cardinal ;
begin
maxX := scanWidth(imgIn)-1 ;
maxY := scanHeight(imgIn)-1 ;
setlength(hMultA, maxX+1) ;
setlength(vMultA, maxY+1) ;
radius := parameterRadius.Value ;
//pSrc := scanLine(imgIn, 0) ;
//pDest := scanLine(imgOut, 0) ;
// Horizontal blur
for y:=0 to maxY do Begin
pSrc := scanLine(imgIn, y) ;
pDest := scanLine(imgOut, y) ;
blurHLineAnisotropic(pDest, pSrc, maxX+1, radius) ;
end ;
// Vertical blur
pSrc := scanLine(imgOut, 0) ;
inc(pSrc, RegionOfInterest.Left) ;
for x:=0 to maxX do Begin
blurVLineAnisotropic(pSrc, pSrc, maxX+1, maxY+1, radius) ;
inc(pSrc) ;
end ;
end;
{************************************************************************
* Implementation of *
* An efficient algorithm for Gaussian blur using finite-state machines *
* Frederick M. Waltza and John W. V. Millerb *
************************************************************************}
procedure TFilterBlur.RunGaussian();
var
pSrc, PDest : PColor32Array;
x, y, maxX, maxY : Integer ;
bw, blurWidth, blurW_1, blurW_2, blurW_d2 : Integer ;
SR : Array of Cardinal ;
SC : Array of Array of Cardinal ;
//color : TColorRec ;
tmp1, tmp2 : Cardinal ;
//divisor : Cardinal ;
begin
maxX := scanWidth(imgIn)-1 ;
maxY := scanHeight(imgIn)-1 ;
blurWidth := (parameterRadius.Value * 13 div 256)*2+1 ;
if blurWidth < 3 then blurWidth := 3 ;
blurW_1 := blurWidth -1 ;
blurW_2 := blurWidth -2 ;
blurW_d2 := blurWidth div 2 ;
setLength(SR, blurW_1) ; // rows
SetLength(SC, blurW_1, maxX+1) ; // columns
for x:=0 to maxX do begin
for bw:=0 to blurW_2 do Begin
SC[bw, x] := 0 ;
end ;
end ;
for y:=-blurW_d2 to maxY+blurW_d2 do begin
if y<0 then
pSrc := scanLine(imgIn, 0)
else if y<=MaxY then
pSrc := scanLine(imgIn, y)
else
pSrc := scanLine(imgIn, maxY) ;
if y<0 then
pDest := scanLine(imgOut, 0)
else if y>=blurW_d2 then
pDest := scanLine(imgOut, y-blurW_d2)
else
pDest := scanLine(imgOut, 0) ;
//**** Horizontal blur
for bw:=0 to blurW_2 do Begin
SR[bw] := 0 ;
end ;
// initialization (left side)
for x:=1 to blurW_d2 do begin
tmp1 := Intensity(pSrc^[0]) ;
for bw:=0 to blurW_2 do Begin
tmp2 := SR[bw] + tmp1 ;
SR[bw] := tmp1 ;
tmp1 := tmp2 ;
end ;
inc(pSrc) ;
end ;
for x:=blurW_d2 to maxX do begin
//horizontal
tmp1 := Intensity(pSrc^[0]) ;
for bw:=0 to blurW_2 do Begin
tmp2 := SR[bw] + tmp1 ;
SR[bw] := tmp1 ;
tmp1 := tmp2 ;
end ;
// Vertical
tmp1 := tmp1 shr blurW_1 ;
for bw:=0 to blurW_2 do Begin
tmp2 := SC[bw, x] + tmp1 ;
SC[bw, x] := tmp1 ;
tmp1 := tmp2 ;
end ;
pDest^[0] := gray32(tmp1 shr blurW_1) ;
inc(pDest) ;
inc(pSrc) ;
end ;
for x:=1 to blurW_d2 do begin
tmp1 := Intensity(pSrc^[0]) ;
for bw:=0 to blurW_2 do Begin
tmp2 := SR[bw] + tmp1 ;
SR[bw] := tmp1 ;
tmp1 := tmp2 ;
end ;
// Vertical
tmp1 := tmp1 shr blurW_1 ;
for bw:=0 to blurW_2 do Begin
tmp2 := SC[bw, x-1] + tmp1 ;
SC[bw, x-1] := tmp1 ;
tmp1 := tmp2 ;
end ;
pDest^[0] := gray32(tmp1 shr blurW_1) ;
inc(pDest) ;
end ;
end ;
end;
end.
