Option Explicit
Private Sub Form_Load()
gradCircle 4000, 4000, 1000, 0, 250, 0, Me
End Sub
Public Function gradCircle(ByVal X As Single, ByVal Y As Single, ByVal circleRadius As Single, _
ByVal colorRed As Byte, ByVal colorGreen As Byte, ByVal colorBlue As Byte, deForm As Form)
Dim redColor As Single
Dim blueColor As Single
Dim greenColor As Single
Dim defaultAutoRedraw As Boolean
Dim topCol As Long, subBy As Single
Dim I As Long
Dim redDone As String, blueDone As String, greenDone As String
'Define some variables
Dim cirStop As Integer
cirStop = 50
'If function works fine, result is 0
gradCircle = 0
'Get color numbers (0-255)
redColor = colorRed
blueColor = colorBlue
greenColor = colorGreen
'Get current AutoRedraw property
defaultAutoRedraw = deForm.AutoRedraw
'Set AuroRedraw so circle can be created
deForm.AutoRedraw = True
deForm.DrawWidth = 2
'Check for illegal numbers
If redColor > 255 Or redColor < 0 Or blueColor > 255 Or blueColor < 0 Or greenColor > 256 Or greenColor < 0 Then
gradCircle = 1
Exit Function
End If
If redColor >= blueColor And redColor >= greenColor Then topCol = redColor
If blueColor >= redColor And blueColor >= greenColor Then topCol = blueColor
If greenColor >= redColor And greenColor >= blueColor Then topCol = greenColor
If topCol = 0 Then topCol = 255
'Obtain proper subtraction number for gradient
If cirStop = 0 Then
subBy = topCol / circleRadius
Else
subBy = cirStop / circleRadius
End If
'Draw circle
For I = 1 To circleRadius
deForm.Circle (X, Y), I, RGB(redColor, greenColor, blueColor)
'Check if red has reached the stop number
If redColor > cirStop Then
redColor = redColor - subBy
Else
redDone = "yes"
End If
'Check if blue has reached the stop number
If blueColor > cirStop Then
blueColor = blueColor - subBy
Else
blueDone = "yes"
End If
'Check if green has reached the stop number
If greenColor > cirStop Then
greenColor = greenColor - subBy
Else
greenDone = "yes"
End If
'If all colors have reached the stop number, exit loop
If redDone = "yes" And blueDone = "yes" And greenDone = "yes" Then Exit For
Next I
'Reset the AutoRedraw property to normal
deForm.AutoRedraw = defaultAutoRedraw
End Function