1// SPDX-License-Identifier: LGPL-3.0-linking-exception 2 3var 4 blurRowY,blurRowX: packed array of UInt32or64; 5 iRadiusX,iRadiusY: Int32or64; 6 weightFactor: UInt32or64; 7 8 { Compute weights of pixels in a row } 9 procedure ComputeBlurRow; 10 var 11 i: Int32or64; 12 ofs: single; 13 begin 14 SetLength(blurRowX, 2*iRadiusX+1); 15 if frac(radiusX)=0 then ofs := 1 else ofs := frac(radiusX); 16 for i := 0 to iRadiusX do 17 begin 18 blurRowX[i] := round((i+ofs)*weightFactor); 19 blurRowX[high(blurRowX)-i] := blurRowX[i]; 20 end; 21 SetLength(blurRowY, 2*iRadiusY+1); 22 if frac(radiusY)=0 then ofs := 1 else ofs := frac(radiusY); 23 for i := 0 to iRadiusY do 24 begin 25 blurRowY[i] := round((i+ofs)*weightFactor); 26 blurRowY[high(blurRowY)-i] := blurRowY[i]; 27 end; 28 end; 29 30 31var 32 srcDelta,srcPixSize, 33 verticalWeightShift, horizontalWeightShift: Int32or64; 34 ys1,ys2: Int32or64; 35 36 { Compute blur result in a vertical direction } 37 procedure ComputeVerticalRow(psrc: PByte; var sums: TRowSum; pw: PNativeUInt; count: Int32or64); 38 begin 39 while count > 0 do 40 with sums do 41 begin 42 dec(count); 43 AccumulatePixel(psrc, pw^, sums, verticalWeightShift); 44 inc(pw); 45 inc(psrc,srcDelta); 46 end; 47 end; 48 49var 50 psum, psumEnd: PRowSum; 51 sums: packed array of TRowSum; 52 sumStartIndex: Int32or64; 53 total: TRowSum; 54 extendedTotal: TExtendedRowSum; 55 yb,xb,xs,x,xEnd: Int32or64; 56 pw: PNativeUInt; 57 psrc, pdest: PByte; 58 bmpWidth,bmpHeight : Int32or64; 59 accumulationFactor: double; 60 bounds: TRect; 61 highSum: Int32or64; 62 tempDest: TCustomUniversalBitmap; 63 destPixSize: Integer; 64 65begin 66 radiusX := round(radiusX*10)*0.1; 67 radiusY := round(radiusY*10)*0.1; 68 if (radiusX <= 0) and (radiusY <= 0) then 69 begin 70 ADestination.PutImage(0,0,bmp,dmSet); 71 exit; 72 end; 73 iRadiusX := ceil(radiusX); 74 iRadiusY := ceil(radiusY); 75 if (frac(radiusX)=0) and (frac(radiusY)=0) then 76 weightFactor:= 1 77 else 78 weightFactor:= 10; 79 bmpWidth := bmp.Width; 80 bmpHeight := bmp.Height; 81 //create output 82 if (ADestination.Width <> bmp.Width) or (ADestination.Height <> bmp.Height) then 83 raise exception.Create('Dimension mismatch'); 84 bounds := bmp.GetImageBounds; 85 if bounds.IsEmpty then exit; 86 bounds.Left := max(0, bounds.Left - iRadiusX); 87 bounds.Top := max(0, bounds.Top - iRadiusY); 88 bounds.Right := min(bmp.Width, bounds.Right + iRadiusX); 89 bounds.Bottom := min(bmp.Height, bounds.Bottom + iRadiusY); 90 bounds.Intersect(ABounds); 91 if bounds.IsEmpty then exit; 92 93 if radiusX*radiusY >= 100 then 94 begin 95 tempDest := ADestination.NewBitmap; 96 tempDest.SetSize(ADestination.Width,ADestination.Height); 97 FilterBlurBox(bmp,bounds,radiusX/3.2,radiusY/3.2,tempDest); 98 FilterBlurBox(tempDest,bounds,radiusX/2.9,radiusY/2.9,ADestination); 99 FilterBlurBox(ADestination,bounds,radiusX/3.2,radiusY/3.2,tempDest); 100 FilterBlurBox(tempDest,bounds,radiusX/2.3,radiusY/2.3,ADestination, ACheckShouldStop); 101 tempDest.Free; 102 exit; 103 end; 104 105 accumulationFactor := (iRadiusY+2)*(iRadiusY+1) div 2 + (iRadiusY+1)*iRadiusY div 2; 106 accumulationFactor := accumulationFactor * sqr(weightFactor); 107 verticalWeightShift := 0; 108 while accumulationFactor > (high(TRegularRowValue) shr BitMargin) + 1 do 109 begin 110 inc(verticalWeightShift); 111 accumulationFactor := accumulationFactor * 0.5; 112 end; 113 horizontalWeightShift:= 0; 114 accumulationFactor := accumulationFactor * 115 ((iRadiusX+2)*(iRadiusX+1) div 2 + (iRadiusX+1)*iRadiusX div 2) * 116 sqr(weightFactor); 117 while accumulationFactor > (high(TRegularRowValue) shr BitMargin) + 1 do 118 begin 119 inc(horizontalWeightShift); 120 accumulationFactor := accumulationFactor * 0.5; 121 end; 122 ComputeBlurRow; 123 //current vertical sums 124 setlength(sums, 2*iRadiusX+1); 125 highSum := high(Sums); 126 psumEnd := @sums[highSum]; 127 inc(psumEnd); 128 if bmp.LineOrder = riloTopToBottom then 129 srcDelta := bmp.RowSize else srcDelta := -bmp.RowSize; 130 srcPixSize := bmp.Colorspace.GetSize; 131 destPixSize := ADestination.Colorspace.GetSize; 132 bmp.LoadFromBitmapIfNeeded; 133 134 xEnd := bounds.left-iRadiusX+highSum; 135 if xEnd >= bmpWidth then xEnd := bmpWidth-1; 136 //loop through destination bitmap 137 for yb := bounds.top to bounds.bottom-1 do 138 begin 139 if (ACheckShouldStop <> nil) and ACheckShouldStop(yb) then break; 140 //evalute available vertical range 141 if yb - iRadiusY < 0 then 142 ys1 := iRadiusY - yb 143 else 144 ys1 := 0; 145 if yb + iRadiusY >= bmpHeight then 146 ys2 := bmpHeight-1 - yb + iRadiusY 147 else 148 ys2 := 2*iRadiusY; 149 150 { initial vertical rows are computed here. Later, 151 for each pixel, vertical sums are shifted, so there 152 is only one vertical sum to calculate } 153 fillchar(sums[0],sizeof(TRowSum)*length(sums),0); 154 x := bounds.left-iRadiusX; 155 if x < 0 then 156 begin 157 xs := -x; 158 x := 0; 159 end else 160 xs := 0; 161 psrc := bmp.GetPixelAddress(x, yb-iRadiusY+ys1); 162 psum := @sums[xs]; 163 pw := @blurRowY[ys1]; 164 while true do 165 begin 166 ComputeVerticalRow(psrc,psum^,pw,ys2-ys1+1); 167 inc(x); 168 inc(psrc, srcPixSize); 169 if x > xEnd then break; 170 inc(psum); 171 end; 172 sumStartIndex := 0; 173 174 pdest := ADestination.GetPixelAddress(bounds.Left, yb); 175 for xb := bounds.left to bounds.right-1 do 176 begin 177 //add vertical rows 178 pw := @blurRowX[0]; 179 psum := @sums[sumStartIndex]; 180 if horizontalWeightShift > 4 then 181 begin //we don't want to loose too much precision 182 fillchar({%H-}extendedTotal,sizeof(extendedTotal),0); 183 for xs := highSum downto 0 do 184 begin 185 AccumulateExtended(extendedTotal, psum, pw^); 186 inc(pw); 187 inc(psum); 188 if psum >= psumEnd then pSum := @sums[0]; 189 end; 190 ComputeExtendedAverage(extendedTotal, pdest); 191 end else 192 if horizontalWeightShift > 0 then 193 begin //lossy but efficient way 194 fillchar({%H-}total,sizeof(total),0); 195 for xs := highSum downto 0 do 196 begin 197 AccumulateShr(total, psum, pw^, horizontalWeightShift); 198 inc(pw); 199 inc(psum); 200 if psum >= psumEnd then pSum := @sums[0]; 201 end; 202 ComputeClampedAverage(total, pdest); 203 end else 204 begin //normal way 205 {$hints off} 206 fillchar(total,sizeof(total),0); 207 {$hints on} 208 for xs := highSum downto 0 do 209 begin 210 AccumulateNormal(total, psum, pw^); 211 inc(pw); 212 inc(psum); 213 if psum >= psumEnd then pSum := @sums[0]; 214 end; 215 ComputeAverage(total, pdest) 216 end; 217 inc(pdest, destPixSize); 218 //shift vertical rows 219 psum := @sums[sumStartIndex]; 220 fillchar(psum^,sizeof(TRowSum),0); 221 if x < bmpWidth then 222 begin 223 ComputeVerticalRow(psrc,psum^,@blurRowY[ys1],ys2-ys1+1); 224 inc(x); 225 inc(psrc, srcPixSize); 226 end; 227 inc(sumStartIndex); 228 if sumStartIndex > highSum then sumStartIndex := 0; 229 end; 230 end; 231 ADestination.InvalidateBitmap; 232end; 233 234