Bildereffekt

[Phantom1]

Sieht nach einen einfachen Blureffekt aus. Ich habe dafür schon vor einiger Zeit mal eine Procedure geschrieben (geschwindigkeitsoptimiert), du kannst sie ja mal probieren:

Delphi-Quellcode:

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;

Wenn du ein normales Image benutzt müsste es so gehen: BmpGBlur(Image1.Picture.Bitmap, 1.0);
Mit radius ist übrigens der Pixelradius gemeint, je größer der ist um so mehr wird geblurrt. Normal ist so 0.5 bis 5.0