Hi,
erstmal muss ich sagen das du den code wirklich gut optimiert hast, allerdings ist das ganze etwas unflexibel und die matrix muss man leider immer von hand eingeben. Da ich vor einigen monaten eine ähnliche prozedure geschrieben habe, möchte ich dir diese nicht vorenthalten, vieleicht kannst du sie ja gebrauchen ;O)
Die Procedure arbeit ähnlich wie GaussianBlur, man kann sie aber auch fürs Soften/Blurren/AntiAliasing benutzten.
Man kann einen Pixelradius angeben (von 0.0000001 bis 50 pixel). Je größer der Wert desto mehr wird geblurrt. (achtung große werte können sehr viel rechenzeit beanspruchen!)
Die Matrix und der divisor wird ebenfalls automatisch berechnet, hier mal zwei beispiele:
bei einem radius von 2,0
0,17|0,76|1,00|0,76|0,17
0,76|1,60|2,00|1,60|0,76
1,00|2,00|3,00|2,00|1,00
0,76|1,60|2,00|1,60|0,76
0,17|0,76|1,00|0,76|0,17
und radius 3,6
0,00|0,00|0,13|0,48|0,60|0,48|0,13|0,00|0,00
0,00|0,36|0,99|1,40|1,60|1,40|0,99|0,36|0,00
0,13|0,99|1,80|2,40|2,60|2,40|1,80|0,99|0,13
0,48|1,40|2,40|3,20|3,60|3,20|2,40|1,40|0,48
0,60|1,60|2,60|3,60|4,60|3,60|2,60|1,60|0,60
0,48|1,40|2,40|3,20|3,60|3,20|2,40|1,40|0,48
0,13|0,99|1,80|2,40|2,60|2,40|1,80|0,99|0,13
0,00|0,36|0,99|1,40|1,60|1,40|0,99|0,36|0,00
0,00|0,00|0,13|0,48|0,60|0,48|0,13|0,00|0,00
Desweiteren habe ich die procedure ebenfalls sogut ich konnte optimiert (ich kann leider auch kein assembler).
Die Randpixel werden bei meiner procedure mitgerechnet!
So und hier der sourcecode:
Delphi-Quellcode:
procedure BmpGBlur(Bmp: TBitmap; radius: Single);
Type
TRGB = Packed Record b, g, r: Byte End;
ArrTRGB = Array of TRGB;
ArrSingle = Array of Single;
Var
MatrixDim, MatrixRadius: Byte;
Matrix : Array of ArrSingle;
MatrixY : ^ArrSingle;
Faktor : ^Single;
BmpCopy : Array of ArrTRGB;
BmpCopyY : ^ArrTRGB;
BmpRGB, BmpCopyRGB: ^TRGB;
BmpWidth, BmpHeight, x, y, dx, dy: Integer;
StartDx, CountDx, StartDy, CountDy: Integer;
R, G, B, Divisor: Single;
Procedure CalculateMatrix;
Var x,y: Integer; MxRadius, f: Single;
Begin
radius:=radius+1; // der mittel/nullpunkt muss mitgerechnet werden
If Frac(radius)=0 Then MatrixDim:=Pred(Trunc(radius)*2) Else MatrixDim:=Succ(Trunc(radius)*2);
SetLength(Matrix,MatrixDim,MatrixDim);
MxRadius:=MatrixDim div 2;
For y:=0 To Pred(MatrixDim) Do
For x:=0 To Pred(MatrixDim) Do begin
f:=radius-Sqrt(Sqr(x-MxRadius)+Sqr(y-MxRadius));
If f<0 Then f:=0; // punkte die außerhalb des radius liegen löschen
Matrix[y,x]:=f;
end;
End;
Begin
Bmp.PixelFormat:=pf24bit;
If radius<=0 Then radius:=1 Else If radius>=50 Then radius:=50; // radius bereich 0.0 < radius < 50.0
CalculateMatrix;
BmpWidth:=Bmp.Width;
BmpHeight:=Bmp.Height;
SetLength(BmpCopy,BmpHeight,BmpWidth);
// Kopie des Bitmaps erstellen im zweidimensionalen Array (BmpCopy)
For y:=0 To Pred(BmpHeight) Do
Move(Bmp.ScanLine[y]^,BmpCopy[y,0],BmpWidth*3);
MatrixRadius:=Pred(MatrixDim) Div 2;
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; Divisor:=0;
// Matrixpixel außerhalb des Bitmaps weglassen
If y<MatrixRadius Then StartDy:=y Else StartDy:=MatrixRadius;
If y>Pred(BmpHeight)-MatrixRadius Then CountDy:=Pred(BmpHeight)-y+StartDy
Else CountDy:=MatrixRadius+StartDy;
If x<MatrixRadius Then StartDx:=x Else StartDx:=MatrixRadius;
If x>Pred(BmpWidth)-MatrixRadius Then CountDx:=Pred(BmpWidth)-x+StartDx
Else CountDx:=MatrixRadius+StartDx;
// Bildpunkte mit der Matrix multiplizieren
MatrixY:=@Matrix[MatrixRadius-StartDy];
BmpCopyY:=@BmpCopy[y-StartDy];
For dy:=0 To CountDy Do Begin
Faktor:=@MatrixY^[MatrixRadius-StartDx];
BmpCopyRGB:=@BmpCopyY^[x-StartDx];
For dx:=0 To CountDx Do Begin
B:=B+BmpCopyRGB^.b*Faktor^; // blau
G:=G+BmpCopyRGB^.g*Faktor^; // grün
R:=R+BmpCopyRGB^.r*Faktor^; // rot
Divisor:=Divisor+Faktor^;
Inc(BmpCopyRGB);
Inc(Faktor);
End;
Inc(MatrixY);
Inc(BmpCopyY);
End;
// neuen berechneten Bildpunkt schreiben
BmpRGB.b:=Round(B/Divisor);
BmpRGB.g:=Round(G/Divisor);
BmpRGB.r:=Round(R/Divisor);
Inc(BmpRGB);
End;
End;
End;