Login | Register   
Twitter
RSS Feed
Download our iPhone app
TODAY'S HEADLINES  |   ARTICLE ARCHIVE  |   FORUMS  |   TIP BANK
Browse DevX
Sign up for e-mail newsletters from DevX


Tip of the Day
Language: VB5,VB6
Expertise: Intermediate
Oct 27, 2001

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, 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
 
Comment and Contribute

 

 

 

 

 


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

 

 

Sitemap