devxlogo

BackgroundCircularGradient – Paint a circular background gradient

BackgroundCircularGradient – Paint a circular background gradient

Private Declare Function RealizePalette Lib "gdi32" (ByVal hdc As Long) As Long' Paint a circular gradient'' 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, 200Sub 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 = saveFillStyleEnd Sub

See also  How to Avoid Money Transfer Scams  
devxblackblue

About Our Editorial Process

At DevX, we’re dedicated to tech entrepreneurship. Our team closely follows industry shifts, new products, AI breakthroughs, technology trends, and funding announcements. Articles undergo thorough editing to ensure accuracy and clarity, reflecting DevX’s style and supporting entrepreneurs in the tech sphere.

See our full editorial policy.

About Our Journalist