Phantom1 - Mi 03.12.03 17:52
Titel: Soften/(Gaussian-)Blur/AntiAliasing (TBitmap)
Hi,
Ich habe eine Procedure geschrieben die ähnlich wie GaussianBlur arbeit, 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 werden dabei ebenfalls automatisch berechnet, hier mal zwei beispiele zum besseren verständniss:
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 allerdings kein assembler).
So und hier der sourcecode:
Delphi-Quelltext
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79:
| 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; 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; Matrix[y,x]:=f; end; End;
Begin Bmp.PixelFormat:=pf24bit; If radius<=0 Then radius:=1 Else If radius>=50 Then radius:=50; CalculateMatrix; BmpWidth:=Bmp.Width; BmpHeight:=Bmp.Height; SetLength(BmpCopy,BmpHeight,BmpWidth); 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; 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; 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^; G:=G+BmpCopyRGB^.g*Faktor^; R:=R+BmpCopyRGB^.r*Faktor^; Divisor:=Divisor+Faktor^; Inc(BmpCopyRGB); Inc(Faktor); End; Inc(MatrixY); Inc(BmpCopyY); End; BmpRGB.b:=Round(B/Divisor); BmpRGB.g:=Round(G/Divisor); BmpRGB.r:=Round(R/Divisor); Inc(BmpRGB); End; End; End; |