procedure BmpGBlur(Bmp: TBitmap; radius: Single);
Type
TRGB =
Packed Record b, g, r: Byte
End;
TRGBs =
Packed Record b, g, r: Single
End;
TRGBArray =
Array[0..0]
of TRGB;
Const
ZeroTRGBs: TRGBs=(b:0; g:0; r:0);
Var
MatrixRadius: Byte;
Matrix :
Array[-100..100]
of Single;
Procedure CalculateMatrix;
Var x: Integer; Divisor: Single;
Begin
radius:=radius+1;
// der mittel/nullpunkt muss mitgerechnet werden
MatrixRadius:=Trunc(radius);
If Frac(radius)=0
Then Dec(MatrixRadius);
Divisor:=0;
For x:=-MatrixRadius
To MatrixRadius
Do Begin
Matrix[x]:=radius-abs(x);
Divisor:=Divisor+Matrix[x];
End;
For x:=-MatrixRadius
To MatrixRadius
Do
Matrix[x]:=Matrix[x]/Divisor;
End;
Var
BmpSL : ^TRGBArray;
BmpRGB : ^TRGB;
BmpCopy :
Array of Array of TRGBs;
BmpCopyRGBs : ^TRGBs;
PixelRGBs : TRGBs;
BmpWidth, BmpHeight: Integer;
x, y, mx : Integer;
Begin
Bmp.PixelFormat:=pf24bit;
If radius<=0
Then radius:=1
Else If radius>99
Then radius:=99;
// radius bereich 0 < radius < 99
CalculateMatrix;
BmpWidth:=Bmp.Width;
BmpHeight:=Bmp.Height;
SetLength(BmpCopy,BmpHeight,BmpWidth);
// Alle Bildpunkte ins BmpCopy-Array schreiben und gleichzeitig HORIZONTAL blurren
For y:=0
To Pred(BmpHeight)
Do Begin
BmpSL:=Bmp.Scanline[y];
BmpCopyRGBs:=@BmpCopy[y,0];
For x:=0
to Pred(BmpWidth)
Do Begin
BmpCopyRGBs^:=ZeroTRGBs;
For mx:=-MatrixRadius
To MatrixRadius
Do Begin
If x+mx<=0
Then
BmpRGB:=@BmpSL^[0]
// erster Pixel
Else If x+mx>=BmpWidth
Then
BmpRGB:=@BmpSL^[Pred(BmpWidth)]
// letzter Pixel
Else
BmpRGB:=@BmpSL^[x+mx];
BmpCopyRGBs^.b:=BmpCopyRGBs^.b+BmpRGB^.b*Matrix[mx];
BmpCopyRGBs^.g:=BmpCopyRGBs^.g+BmpRGB^.g*Matrix[mx];
BmpCopyRGBs^.r:=BmpCopyRGBs^.r+BmpRGB^.r*Matrix[mx];
End;
Inc(BmpCopyRGBs);
End;
End;
// Alle Bildpunkte zurück ins Bmp-Bitmap schreiben und gleichzeitig VERTIKAL blurren
For y:=0
To Pred(BmpHeight)
Do Begin
BmpRGB:=Bmp.ScanLine[y];
For x:=0
to Pred(BmpWidth)
Do Begin
PixelRGBs:=ZeroTRGBs;
For mx:=-MatrixRadius
To MatrixRadius
Do Begin
If y+mx<=0
Then
BmpCopyRGBs:=@BmpCopy[0,x]
// erster Pixel
Else If y+mx>=BmpHeight
Then
BmpCopyRGBs:=@BmpCopy[Pred(BmpHeight),x]
// letzter Pixel
Else
BmpCopyRGBs:=@BmpCopy[y+mx,x];
PixelRGBs.b:=PixelRGBs.b+BmpCopyRGBs^.b*Matrix[mx];
PixelRGBs.g:=PixelRGBs.g+BmpCopyRGBs^.g*Matrix[mx];
PixelRGBs.r:=PixelRGBs.r+BmpCopyRGBs^.r*Matrix[mx];
End;
BmpRGB^.b:=Round(PixelRGBs.b);
BmpRGB^.g:=Round(PixelRGBs.g);
BmpRGB^.r:=Round(PixelRGBs.r);
Inc(BmpRGB);
End;
End;
End;