It takes ~35 ms for a 800x800 px image.
Code: Select all
Type tImage
As Integer width, height, pitch
As Long Ptr pixels
End Type
Declare Function FastBlur(img As tImage, iRadius As Ubyte) As Any Ptr
Declare Function BlurPass(img As tImage, iRadius As Ubyte, iW as UShort, iH as UShort) As Any Ptr
Const w = 800, h = 800 ' <<<<<<< change dimension accordingly before starting
ScreenRes w, h, 32
Dim pImage As Any Ptr = ImageCreate(w, h, 0, 32)
Bload("Kapuzineraeffchen.bmp", pImage) ' <<<<<<< change filename before starting
Dim As tImage img
Imageinfo(pImage, img.Width, img.height, , img.pitch, img.pixels)
Dim As Double fEnd, fStart = Timer
Dim pImgBlurred As Any Ptr = FastBlur(img, 10)
fEnd = Timer - fStart
Windowtitle("Image blurred in " & fEnd * 1000 & " ms")
Put (0, 0), pImgBlurred
'BSave("Result_FastBlur.bmp", pImgBlurred)
ImageDestroy(pImage)
ImageDestroy(pImgBlurred)
Sleep
'https://gist.github.com/mattdesl/4383372
'Copyright (c) 2007, Romain Guy All rights reserved.
Function FastBlur(img As tImage, iRadius As Ubyte) As Any Ptr
iRadius = Iif(iRadius < 1, 1, iRadius)
Dim pImgPassH As Any Ptr = BlurPass(img, iRadius, img.width, img.height) 'horizontal pass
Dim As tImage img2
Imageinfo(pImgPassH, img2.Width, img2.height, , img2.pitch, img2.pixels)
Dim pImgPassW As Any Ptr = BlurPass(img2, iRadius, img.height, img.Width) 'vertical pass
ImageDestroy(pImgPassH)
Return pImgPassW
End Function
Function BlurPass(img As tImage, iRadius As Ubyte, iW as UShort, iH as UShort) As Any Ptr
dIM AS UShort iW1 = iW - 1, iH1 = iH - 1
Dim As Ulong Ptr srcPixels = img.pixels
Dim pImage_blurred As Any Ptr = Imagecreate(img.height, img.width, 0, 32)
Dim As tImage img_b
Imageinfo(pImage_blurred, img_b.Width, img_b.height, , img_b.pitch, img_b.pixels)
Dim As Ulong Ptr dstPixels = img_b.pixels
Dim As Long previousPixelIndex, sumAlpha, sumRed, sumGreen, sumBlue, i
Dim As Ulong pixel, windowSize = iRadius * 2 + 1, radiusPlusOne = iRadius + 1, _
srcIndex = 0, sumLookupTable(256 * windowSize), indexLookupTable(radiusPlusOne), _
dstIndex, x, y, nextPixelIndex, nextPixel, previousPixel
Dim as Integer pitch_img = img.pitch Shr 2, pitch_b = img_b.pitch Shr 2
For i = 0 To Ubound(sumLookupTable) - 1
sumLookupTable(i) = i \ windowSize
Next
If iRadius < iW Then
For i = 0 To Ubound(indexLookupTable) - 1
indexLookupTable(i) = i
Next
Else
For i = 0 To iW - 1
indexLookupTable(i) = i
Next
For i = iW To Ubound(indexLookupTable) - 1
indexLookupTable(i) = iW1
Next
Endif
For y = 0 To iH1
sumAlpha = 0: sumRed = 0: sumGreen = 0: sumBlue = 0
dstIndex = y
pixel = srcPixels[srcIndex]
sumAlpha += radiusPlusOne * ((pixel Shr 24) And &hFF)
sumRed += radiusPlusOne * ((pixel Shr 16) And &hFF)
sumGreen += radiusPlusOne * ((pixel Shr 8) And &hFF)
sumBlue += radiusPlusOne * ( pixel And &hFF)
For i = 1 To iRadius
pixel = srcPixels[srcIndex + indexLookupTable(i)]
sumAlpha += ((pixel Shr 24) And &hFF)
sumRed += ((pixel Shr 16) And &hFF)
sumGreen += ((pixel Shr 8) And &hFF)
sumBlue += ( pixel And &hFF)
Next
For x = 0 To iW1
dstPixels[dstIndex] = sumLookupTable(sumAlpha) Shl 24 Or _
sumLookupTable(sumRed) Shl 16 Or _
sumLookupTable(sumGreen) Shl 8 Or _
sumLookupTable(sumBlue)
'dstPixels[dstIndex] = Rgba(sumLookupTable(sumRed), sumLookupTable(sumGreen), sumLookupTable(sumBlue), sumLookupTable(sumAlpha))
dstIndex += pitch_b
nextPixelIndex = x + radiusPlusOne
If nextPixelIndex >= iW Then nextPixelIndex = iW1
previousPixelIndex = x - iRadius
If previousPixelIndex < 0 Then previousPixelIndex = 0
nextPixel = srcPixels[srcIndex + nextPixelIndex]
previousPixel = srcPixels[srcIndex + previousPixelIndex]
sumAlpha += (nextPixel Shr 24) And &hFF
sumAlpha -= (previousPixel Shr 24) And &hFF
sumRed += (nextPixel Shr 16) And &hFF
sumRed -= (previousPixel Shr 16) And &hFF
sumGreen += (nextPixel Shr 8) And &hFF
sumGreen -= (previousPixel Shr 8) And &hFF
sumBlue += (nextPixel ) And &hFF
sumBlue -= (previousPixel ) And &hFF
Next
srcIndex += pitch_img
Next
Return pImage_Blurred
End Function