demo of a simple function to Apply a gaussian blur

[scalion]

Hello all,

As part of a graphical file generator for developing sudoku software, I needed a Gaussian blur (to create shadows in textures).
I put you here the function with a small demo.
I hope it can help you.
Have a nice day.

Global Long i
Global String txt
OpenW 1 : Void SetForegroundWindow(Me.hWnd) : AutoRedraw = 1
Me.Adjust 300, 300 : Me.Center True : Me.BackColor = 0
FontBold = 1 : FontName = "arial" : FontSize = 20
RGBColor &hFFFFFF : PCircle _X / 2, _Y / 2, Min(_X, _Y) / 3
GraphMode , TRANSPARENT
For i = 1 To 10
 RGBColor Rol(&HFFF, i * 1.6) And &hFFFFFF
 txt = "Gaussian Blur level " & Trim(11 - i)
 Text _X / 2 - TextWidth(txt) / 2, i * _Y / 12, txt
 If GaussianBlur(0, 0, _X / 2, _Y, 11 - i) = False Message "no pixel to process"
Next i
Do : Sleep : Loop Until Me Is Nothing
Function GaussianBlur(x1%, y1%, x2%, y2%, blurlevel#) As Boolean Naked
 
 Local Long r, g, b, Bmp, i, w, h, Adr, vswap
 Local Long  X, Y, XX, YY, ir, isize, AdrEnd, vadr
 Local Double vh
 
 ' rationalize the coordinates
 If x1 > x2 vswap = x1 : x1 = x2 : x2 = vswap
 If y1 > y2 vswap = y1 : y1 = y2 : y2 = vswap
 x1 = Max(0, Min(_X - 1, x1)) : x2 = Max(0, Min(_X - 1, x2))
 y1 = Max(0, Min(_Y - 1, y1)) : y2 = Max(0, Min(_Y - 1, y2))
 
 ' if no pixel to process return false, that's not an error
 If (x1 = x2 And y1 = y2) Or blurlevel < 1 Return False
 
 ' Get bitmap data of zone to process
 Get x1, y1, x2, y2, Bmp
 w = 1 + x2 - x1 : h = 1 + y2 - y1 : isize = w * h * 4
 Adr = mAlloc(isize) : AdrEnd = Adr + isize - 4
 Void GetBitmapBits(Bmp, isize, Adr)
 
 ' Create a memory for sums
 Local Dim frgb(w, h, 3) As Double
 ArrayFill frgb(), 0
 
 ' Calculate sums, vh is the multiplicator depending of the distance
 ir = blurlevel + 1
 For YY = -ir To ir
   For XX = -ir To ir
     vh = Sqr(XX * XX + YY * YY)
     If vh <= blurlevel
       vh = (blurlevel - vh) / blurlevel
       vadr = Adr + Mul(XX , 4) + Mul(YY , 4 * w)
       For i = Max(Adr, vadr) To Min(AdrEnd, vadr + isize - 4) Step 4
         X = Mod(Div(i - Adr, 4), w) - XX
         If X >= 0
           If X < w
             Y = Div(Div(i - Adr, 4), w) - YY
             If Y >= 0
               If Y < h
                 frgb(X, Y, 0) += Peek(i) * vh
                 frgb(X, Y, 1) += Peek(i + 1) * vh
                 frgb(X, Y, 2) += Peek(i + 2) * vh
                 frgb(X, Y, 3) += vh
               EndIf
             EndIf
           EndIf
         EndIf
       Next i
     EndIf
   Next XX
 Next YY
 
 ' Divide each sum by the number of added pixel values
 ' store result in data bitmap and erase sums table
 i = Adr
 For Y = 0 To h - 1
   For X = 0 To w - 1
     r = frgb(X, Y, 0) / frgb(X, Y, 3)
     g = frgb(X, Y, 1) / frgb(X, Y, 3)
     b = frgb(X, Y, 2) / frgb(X, Y, 3)
     LPoke i, RGB(r, g, b)
     Add i, 4
   Next X
 Next Y
 Erase frgb()
 
 ' Transfer of data in the bitmap and erase data
 Void SetBitmapBits(Bmp, isize, Adr) : Void mFree(Adr)
 
 ' Show result and erase bitmap
 Put x1, y1, Bmp : FreeBmp Bmp
 
 Return True
 
EndFunc