procedure TForm1.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&#252;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;

procedure TForm1.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;
 PArrayX = ^ArrayX;
 ArrayX  =  array [0..0] of TRGBs;

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;
 arr, pRow          : PArrayX;
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);

 try
 GetMem(Arr, (BmpWidth * BmpHeight) * SizeOf(TRGBs));
 // Alle Bildpunkte ins BmpCopy-Array schreiben und gleichzeitig HORIZONTAL blurren
 For y:=0 To Pred(BmpHeight) Do Begin
   pRow := @Arr[Y * BmpWidth];
   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;
     pRow[x].b:=b;  // Farbwerte werden im Typ Single zwischengespeichert !
     pRow[x].g:=G;
     pRow[x].r:=R;
//      Inc(BmpCopyRGB);
   End;
 End;

 // Alle Bildpunkte zur&#252;ck ins Bmp-Bitmap schreiben und gleichzeitig VERTIKAL blurren
 For y:=0 To Pred(BmpHeight) Do Begin
   BmpRGB:=Bmp.ScanLine[y];
   pRow := @Arr[Y * BmpWidth];
   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:=@pRow[0]//@BmpCopy[0]                // erster Pixel
       Else If y+mx>=BmpHeight Then
         BmpCopyRGB:=@pRow[Pred(BmpHeight)]//@BmpCopy[Pred(BmpHeight)]  // letzter Pixel
       Else
         BmpCopyRGB:=@pRow[y+mx];//@BmpCopy[y+mx];
       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);
     BmpRGB^.b:=Round(pRow[x].b);
     BmpRGB^.g:=Round(pRow[x].g);
     BmpRGB^.r:=Round(pRow[x].r);
     Inc(BmpRGB);
   End;
 End;

 finally
   FreeMem(Arr, (BmpWidth * BmpHeight) * SizeOf(TRGBs));
 end;