Public Sub GradientFill(Obj As Form, lTopColor As Long, lBottomColor As Long)

The below sample describes how to use the GradientFill routine. It assumes you have created a form and added the following code to it. Make sure the AutoRedraw property is False for this sample.

Private Sub Form_Load()
    Me.Show
End Sub

Private Sub Form_Paint()
    GradientFill Me, vbRed, vbWhite
End Sub

Just create a new Module and then paste this source code into it. You should name the class basFormEffects.

'----------------------------------------------------------------------
'
'   Module Name:    basFormEffects
'   Written By:     C&D Programming Corp.
'   Create Date:    1/99
'   Copyright:      Copyright 1999 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit

Option Explicit

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

' This routine works with these color selections.
'    vbBlack
'    vbRed
'    vbGreen
'    vbYellow
'    vbBlue
'    vbMagenta
'    vbCyan
'    vbWhite
Public Sub GradientFill(Obj As Form, lTopColor As Long, lBottomColor As Long)
    Dim lRow As Long
    Dim sngRedDiff As Single
    Dim sngBlueDiff As Single
    Dim sngGreenDiff As Single
    Dim sngRed As Single
    Dim sngBlue As Single
    Dim sngGreen As Single
    Dim lRet As Long

    ' set scale to force palette to a "nice" size.
    Obj.Scale (0, 255)-(1, 0)

    lRet = RealizePalette(Obj.hdc)
    If lRet <> 0 Then
        Err.Raise 5, "GradientFill", "Could not realize palette."
    End If

    sngRed = Red(lTopColor)
    sngBlue = Blue(lTopColor)
    sngGreen = Green(lTopColor)

    sngRedDiff = ColorDivisor(Red(lTopColor) - Red(lBottomColor))
    sngGreenDiff = ColorDivisor(Green(lTopColor) - Green(lBottomColor))
    sngBlueDiff = ColorDivisor(Blue(lTopColor) - Blue(lBottomColor))

    For lRow = 0 To 255
        Obj.Line (0, lRow)-(1, lRow - 1), RGB(CInt(sngRed), CInt(sngGreen), CInt(sngBlue)), BF
        sngRed = ColorShift(sngRed, sngRedDiff)
        sngBlue = ColorShift(sngBlue, sngBlueDiff)
        sngGreen = ColorShift(sngGreen, sngGreenDiff)
    Next
End Sub

Private Function ColorDivisor(lColor As Long) As Single
    ColorDivisor = IIf(lColor = 0, 0, lColor / 256)
End Function
'
'   We use singles to allow for partial colors (not the extremes)
'
Private Function ColorShift(sngColor As Single, sngDiff As Single) As Single
    sngColor = sngColor + sngDiff
    If sngColor > 255.5 Then
        ColorShift = 0
    Else
        If sngColor < 0 Then
            ColorShift = 255
        Else
            ColorShift = sngColor
        End If
    End If
End Function
'
'   An easy trick to isolate a single color into a value from 0 to 255.
'
Private Function Red(lColor As Long) As Integer
    Red = CInt("&h" & Left(Hex(lColor And vbRed), 2))
End Function

Private Function Blue(lColor As Long) As Integer
    Blue = CInt("&h" & Left(Hex(lColor And vbBlue), 2))
End Function

Private Function Green(lColor As Long) As Integer
    Green = CInt("&h" & Left(Hex(lColor And vbGreen), 2))
End Function