Binaryworld - BackgroundCircularGradient - Paint a circular background gradient ... [ VB -> Graphics ]

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