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
by: mokulePosted on 2004-04-23 at 01:25:54ID: 10897278
Maybe I can try. In case You would explain better in words what it should do.