TODAY'S HEADLINES  |   ARTICLE ARCHIVE  |   FORUMS  |   TIP BANK
 Specialized Dev Zones Research Center eBook Library .NET Java C++ Web Dev Architecture Database Security Open Source Enterprise Mobile Special Reports 10-Minute Solutions DevXtra Blogs Slideshow

Language: VB5,VB6
Expertise: Intermediate
Oct 27, 2001

### WEBINAR:On-Demand

Building the Right Environment to Support AI, Machine Learning and Deep Learning

``````Private Declare Function RealizePalette Lib "gdi32" (ByVal hdc As Long) As Long

'
' STARTCOLOR is the starting color (applied to the corner)
' ENDCOLOR is the ending color (applied to the center point)
' NUMSTEPS is the optional number of stripes (default is 256)
' XC, XY are the coordinates of the center (default is the center of the form)
'
' Example: a vertical gradient from blue to Black
'   BackgroundCircularGradient Me, &HFF0000, 0, , 500, 200

Sub BackgroundCircularGradient(frm As Form, ByVal startColor As Long, _
ByVal endColor As Long, Optional ByVal numSteps As Integer = 256, _
Optional ByVal xc As Single = -1, Optional ByVal yc As Single = -1)
Dim startRed As Integer, startGreen As Integer, startBlue As Integer
Dim deltaRed As Integer, deltaGreen As Integer, deltaBlue As Integer
Dim r As Single, dr As Single
Dim stp As Long

Dim saveFillColor As Long
Dim saveFillStyle As Long

' Evaluate the coordinates of the center if omitted.
If xc = -1 And yc = -1 Then
xc = frm.ScaleWidth / 2
yc = frm.ScaleHeight / 2
End If

' The radius of the circle is equal to the distance from the farthest corner
If xc < frm.ScaleWidth / 2 Then
If yc < frm.ScaleHeight / 2 Then
r = Sqr((frm.ScaleWidth - xc) ^ 2 + (frm.ScaleHeight - yc) ^ 2)
Else
r = Sqr((frm.ScaleWidth - xc) ^ 2 + yc ^ 2)
End If
Else
If yc < frm.ScaleHeight / 2 Then
r = Sqr(xc ^ 2 + (frm.ScaleHeight - yc) ^ 2)
Else
r = Sqr(xc ^ 2 + yc ^ 2)
End If
End If

' Split the start color into its RGB components
startRed = startColor And &HFF
startGreen = (startColor And &HFF00&) \ 256
startBlue = (startColor And &HFF0000) \ 65536
' Split the end color into its RGB components
deltaRed = (endColor And &HFF&) - startRed
deltaGreen = (endColor And &HFF00&) \ 256 - startGreen
deltaBlue = (endColor And &HFF0000) \ 65536 - startBlue

RealizePalette frm.hdc

' Eval the delta of the radius at each step
dr = r / numSteps

' Remember current fill settings.
saveFillColor = Me.FillColor
saveFillStyle = Me.FillStyle
' enfore solid filling
Me.FillStyle = vbSolid

' Draw all circles, going from the outside in.
For stp = 0 To numSteps - 1
Me.FillColor = RGB(startRed + (deltaRed * stp) \ numSteps, _
startGreen + (deltaGreen * stp) \ numSteps, _
startBlue + (deltaBlue * stp) \ numSteps)
frm.Circle (xc, yc), r, Me.FillColor
r = r - dr
Next

' Restore original settings.
Me.FillColor = saveFillColor
Me.FillStyle = saveFillStyle
End Sub
``````
Francesco Balena

 Submit a Tip Browse "Application Design" Tips Browse All Tips
Comment and Contribute

(Maximum characters: 1200). You have 1200 characters left.

Thanks for your registration, follow us on our social networks to keep up-to-date