Solved

# Radial Blur Zoom

Posted on 2004-04-22

Hi, i programmed a function to radial blur (zoom) pictures in Vb6 (with a force from zero to 100% and a point of blur), it works well (better quality than photoshop) but it's a little slower.

my function is easy and i would like to know how to accelerate the process to get the same quality faster

i need a vb6 or C++ function.

here's my function :

'cx, cy = Center X and Center Y

'k = Force (0 to 100%)

'Quality = Quality : 1 = Best | 2 = Good | 4 = Medium | 16 = Bad

Public Sub RadialBlurZoom(ByVal cx As Long, ByVal cy As Long, ByVal k As Single, ByVal Quality as Long)

Dim j As Long

Dim i As Long

Dim l As Long

Dim nX As Long

Dim nY As Long

Dim dX As Long

Dim dY As Long

Dim Alpha As Single

Dim Hypotenuse As Long

Dim vMax As Long

Dim TotalR As Long

Dim TotalG As Long

Dim TotalB As Long

Dim Dividor As Long

Dim NewBits() As Byte

'in the form, PicBits is a private array which contains bitmapbits (from GetBitmapBits)

ReDim NewBits(LBound(PicBits) To UBound(PicBits))

If K = 0 Then K = 1

If K > 100 Then K = 100

K = K / 400

'shpSelection is a Shape which contains the rectangle area to be processed

For j = shpSelection.Top + 1 To shpSelection.Top + shpSelection.Height

dY = Abs(j - cY)

For i = shpSelection.Left + 1 To shpSelection.Left + shpSelection.Width

dX = Abs(i - cX)

If dX = 0 Then dX = 1

Alpha = Atn(dY / dX)

Hypotenuse = Sqr(dX * dX + dY * dY)

TotalR = 0

TotalG = 0

TotalB = 0

Dividor = 0

vMax = Hypotenuse * K

For l = -vMax To vMax Step Quality

If i < cX Then

nX = i + (Cos(Alpha) * l)

ElseIf i >= cX Then

nX = i - (Cos(Alpha) * l)

Else

nX = 0

End If

If j < cY Then

nY = j + (Sin(Alpha) * l)

ElseIf j >= cY Then

nY = j - (Sin(Alpha) * l)

Else

nY = 0

End If

'in this form, Matrix is a private array which contains indexes of

'bits in PicBits to retrieve a point with X and Y values.

If nX > 0 And nY > 0 And nX <= UBound(Matrix) And nY <= UBound(Matrix, 2) Then

TotalR = TotalR + PicBits(Matrix(nX, nY))

TotalG = TotalG + PicBits(Matrix(nX, nY) + 1)

TotalB = TotalB + PicBits(Matrix(nX, nY) + 2)

Dividor = Dividor + 1

End If

Next l

If Dividor > 0 Then

NewBits(Matrix(i, j)) = TotalR \ Dividor

NewBits(Matrix(i, j) + 1) = TotalG \ Dividor

NewBits(Matrix(i, j) + 2) = TotalB \ Dividor

Else

NewBits(Matrix(i, j)) = PicBits(Matrix(i, j))

NewBits(Matrix(i, j) + 1) = PicBits(Matrix(i, j) + 1)

NewBits(Matrix(i, j) + 2) = PicBits(Matrix(i, j) + 2)

End If

Next i

Next j

'P is the name of a pictureBox where the picture was loaded

'sets the new bits to P.Image

SetBitmapBits P.Image, UBound(NewBits), NewBits(1)

End Function