Autor |
Beitrag |
Phantom1
Beiträge: 390
|
Verfasst: Mi 03.12.03 17:52
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:
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; |
|
|
obbschtkuche
Gast
Erhaltene Danke: 1
|
Verfasst: Mi 03.12.03 18:22
Hier habe ich noch eine procedure die das Selbe macht (habe ich irgendwann mal gefunden ;)) allerdings ist sie ein wenig schneller und blurt bei halbem Radius mit gleicher Stärke.
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: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142:
| unit gblur;
interface
uses Graphics, SysUtils;
const MaxKernelSize = 100;
type PRGBTriple = ^TRGBTriple; TRGBTriple = packed record b: byte; g: byte; r: byte; end; PRow = ^TRow; TRow = array[0..1000000] of TRGBTriple; PPRows = ^TPRows; TPRows = array[0..1000000] of PRow; TKernelSize = 1..MaxKernelSize; TKernel = record Size: TKernelSize; Weights: array[-MaxKernelSize..MaxKernelSize] of single; end;
procedure GaussianBlur(theBitmap: TBitmap; radius: double);
implementation
procedure MakeGaussianKernel(var K: TKernel; radius: double; MaxData, DataGranularity: double); var j: integer; temp, delta: double; KernelSize: TKernelSize; begin for j:= Low(K.Weights) to High(K.Weights) do begin temp:= j/radius; K.Weights[j]:= exp(- temp*temp/2); end; temp:= 0; for j:= Low(K.Weights) to High(K.Weights) do temp:= temp + K.Weights[j]; for j:= Low(K.Weights) to High(K.Weights) do K.Weights[j]:= K.Weights[j] / temp; KernelSize:= MaxKernelSize; delta:= DataGranularity / (2*MaxData); temp:= 0; while (temp < delta) and (KernelSize > 1) do begin temp:= temp + 2 * K.Weights[KernelSize]; dec(KernelSize); end; K.Size:= KernelSize; temp:= 0; for j:= -K.Size to K.Size do temp:= temp + K.Weights[j]; for j:= -K.Size to K.Size do K.Weights[j]:= K.Weights[j] / temp; end;
function TrimInt(Lower, Upper, theInteger: integer): integer; begin if (theInteger <= Upper) and (theInteger >= Lower) then result:= theInteger else if theInteger > Upper then result := Upper else result := Lower; end;
function TrimReal(Lower, Upper: integer; x: double): integer; begin if (x < upper) and (x >= lower) then result:= trunc(x) else if x > Upper then result:= Upper else result:= Lower; end;
procedure BlurRow(var theRow: array of TRGBTriple; K: TKernel; P: PRow); var j, n, LocalRow: integer; tr, tg, tb: double; w: double; begin for j:= 0 to High(theRow) do begin tb:= 0; tg:= 0; tr:= 0; for n:= -K.Size to K.Size do begin w:= K.Weights[n]; with theRow[TrimInt(0, High(theRow), j - n)] do begin tb:= tb + w * b; tg:= tg + w * g; tr:= tr + w * r; end; end; with P[j] do begin b:= TrimReal(0, 255, tb); g:= TrimReal(0, 255, tg); r:= TrimReal(0, 255, tr); end; end; Move(P[0], theRow[0], (High(theRow) + 1) * Sizeof(TRGBTriple)); end;
procedure GaussianBlur(theBitmap: TBitmap; radius: double); var Row, Col: integer; theRows: PPRows; K: TKernel; ACol, P: PRow; begin if (theBitmap.HandleType <> bmDIB) or (theBitmap.PixelFormat <> pf24Bit) then raise exception.Create('GBlur only works for 24-bit bitmaps'); MakeGaussianKernel(K, radius, 255, 1); GetMem(theRows, theBitmap.Height * SizeOf(PRow)); GetMem(ACol, theBitmap.Height * SizeOf(TRGBTriple)); for Row:= 0 to theBitmap.Height - 1 do theRows[Row]:= theBitmap.Scanline[Row]; P:= AllocMem(theBitmap.Width*SizeOf(TRGBTriple)); for Row:= 0 to theBitmap.Height - 1 do BlurRow(Slice(theRows[Row]^, theBitmap.Width), K, P); ReAllocMem(P, theBitmap.Height*SizeOf(TRGBTriple)); for Col:= 0 to theBitmap.Width - 1 do begin for Row:= 0 to theBitmap.Height - 1 do ACol[Row]:= theRows[Row][Col]; BlurRow(Slice(ACol^, theBitmap.Height), K, P); for Row:= 0 to theBitmap.Height - 1 do theRows[Row][Col]:= ACol[Row]; end; FreeMem(theRows); FreeMem(ACol); ReAllocMem(P, 0); end;
end. |
|
|
Phantom1
Beiträge: 390
|
Verfasst: Mi 03.12.03 20:11
hi obbschtkuche,
habs eben mal getestet, bei einen radius von 3 bei meiner procedure und radius von 1.5 bei dem von dir geposteten procedure ist blurfaktor und die geschwindigkeit fast gleich! bei niedrigeren radien ist dagegen meine wesentlich schneller und bei höheren die andere procedure. Ich glaube das liegt daran das ich eine dynamische matrix verwende und die andere eine feste hat.
|
|
obbschtkuche
Gast
Erhaltene Danke: 1
|
Verfasst: Mi 03.12.03 20:22
sorry, ich habs nur mit 10 getestet. Also am besten beide verwenden, nur eben die eine für Große radien und die andere für kleine ;)
|
|
Phantom1
Beiträge: 390
|
Verfasst: Mi 03.12.03 21:18
desweiteren produziert die von dir gepostete procedure bei radien unter 0.5 ziemlich viele pixelfehler :-/
naja mal sehen ich werde meine procedure auch noch weiter verbessern und vieleicht kann ich ein paar ideen von deiner procedure mit einbauen
|
|
Phantom1
Beiträge: 390
|
Verfasst: Do 04.12.03 14:27
So habe meine procedure nochmal komplett überarbeitet. Die procedure ist jetzt etwa doppelt so schnell wie die beiden bisher geposteten proceduren zusammen !!!! Pixelfehler gibts bei mir auch nicht.
Hier der Code:
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: 80: 81: 82: 83: 84: 85:
| 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; 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; CalculateMatrix; BmpWidth:=Bmp.Width; BmpHeight:=Bmp.Height; SetLength(BmpCopy,BmpHeight,BmpWidth); 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] Else If x+mx>=BmpWidth Then BmpRGB:=@BmpSL^[Pred(BmpWidth)] 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; BmpCopyRGB^.g:=G; BmpCopyRGB^.r:=R; Inc(BmpCopyRGB); End; End; 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] Else If y+mx>=BmpHeight Then BmpCopyRGB:=@BmpCopy[Pred(BmpHeight),x] 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; |
|
|
|