Blur Bitmap

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;
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;
  BmpCopyRGB : ^TRGBs;
  R, G, B : Single;
  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];
    BmpCopyRGB:=@BmpCopy[y,0];
    For x:=0 to Pred(BmpWidth) Do Begin
      R:=0; G:=0; B:=0;
      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];
        B:=B+BmpRGB^.b*Matrix[mx];
        G:=G+BmpRGB^.g*Matrix[mx];
        R:=R+BmpRGB^.r*Matrix[mx];
      End;
      BmpCopyRGB^.b:=B; // Farbwerte werden im Typ Single zwischengespeichert !
      BmpCopyRGB^.g:=G;
      BmpCopyRGB^.r:=R;
      Inc(BmpCopyRGB);
    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
      R:=0; G:=0; B:=0;
      For mx:=-MatrixRadius To MatrixRadius Do Begin
        If y+mx<=0 Then
          BmpCopyRGB:=@BmpCopy[0,x] // erster Pixel
        Else If y+mx>=BmpHeight Then
          BmpCopyRGB:=@BmpCopy[Pred(BmpHeight),x] // letzter Pixel
        Else
          BmpCopyRGB:=@BmpCopy[y+mx,x];
        B:=B+BmpCopyRGB^.b*Matrix[mx];
        G:=G+BmpCopyRGB^.g*Matrix[mx];
        R:=R+BmpCopyRGB^.r*Matrix[mx];
      End;
      BmpRGB^.b:=Round(B);
      BmpRGB^.g:=Round(G);
      BmpRGB^.r:=Round(R);
      Inc(BmpRGB);
    End;
  End;
End;

Beispiel :

procedure TForm1.Button1Click(Sender: TObject);
begin
  BmpGBlur(Image1.Picture.Bitmap,
           2);     // HIER DEN RADIUS DES BLUR EFFEKTES ANGEBEN
end;