Para hacer un gradiente (degradado) entre dos colores podemos usar la rutina que se presenta a continuación. Los parámetros que recibe son :
- objeto (formulario o picture con la propiedad autoredraw a true)
- color origen
- color destino
- tipo de gradiente (horizontal=0 , vertical =1 o diagonal =2)

En un formulario escribimos :

Option Explicit
Private Type RGBQUAD
        rgbBlue As Byte
        rgbGreen As Byte
        rgbRed As Byte
        rgbReserved As Byte
End Type
Private Enum TipoGradiente
    Horizontal = 0
    Vertical = 1
    Diagonal = 2
End Enum
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
  (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function LineTo Lib "gdi32" _
  (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" _
  (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As Any) As Long
Private Declare Function DeleteObject Lib "gdi32" _
  (ByVal hObject As Long) As Long
Private Declare Function CreatePen Lib "gdi32" _
  (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function SelectObject Lib "gdi32" _
  (ByVal hdc As Long, ByVal hObject As Long) As Long

Private Const PS_SOLID = 0
Public Sub Gradiente(objeto As Object, lngColor1 As Long, lngColor2 As Long, Optional ByVal Tipo As Long = 0)
Dim rgbColor1 As RGBQUAD, rgbColor2 As RGBQUAD
Dim ColorRojo As Double, ColorVerde As Double, ColorAzul As Double
Dim CDiffRed As Double, CDiffGreen As Double, CDiffBlue As Double
Dim CFadeRed As Double, CFadeGreen As Double, CFadeBlue As Double
Dim Fade As Double
Dim hNewPen As Long, hOldPen As Long
Dim Escala As Long
Dim Tamaño As Double, Longitud As Double
On Error Resume Next
'Guardamos el tipo de escala original
Escala = objeto.ScaleMode
objeto.ScaleMode = vbPixels
Select Case Tipo
    Case Horizontal: Tamaño = objeto.ScaleWidth
                    Longitud = objeto.ScaleHeight
    Case Vertical: Tamaño = objeto.ScaleHeight
                    Longitud = objeto.ScaleWidth
    Case Diagonal: Tamaño = objeto.ScaleWidth
                    Longitud = objeto.ScaleHeight
End Select
'Obtenemos los valores rgb de los colores
Long2RGB lngColor1, rgbColor1
Long2RGB lngColor2, rgbColor2
'Calculamos las diferencias entre los colores
CDiffRed = -(CLng(rgbColor1.rgbRed) - CLng(rgbColor2.rgbRed))
CDiffGreen = -(CLng(rgbColor1.rgbGreen) - CLng(rgbColor2.rgbGreen))
CDiffBlue = -(CLng(rgbColor1.rgbBlue) - CLng(rgbColor2.rgbBlue))
'tomamos los colores iniciales
ColorRojo = rgbColor1.rgbRed: ColorVerde = rgbColor1.rgbGreen: ColorAzul = rgbColor1.rgbBlue
'Calculamos el incremento en los colores para cada línea
CFadeRed = CDiffRed / Tamaño
CFadeGreen = CDiffGreen / Tamaño
CFadeBlue = CDiffBlue / Tamaño
'Si es diagonal
If Tipo = Diagonal Then Tamaño = Tamaño + Longitud
'Pintamos las líneas
For Fade = 0 To Tamaño
    'Creamos un nuevo pen
    hNewPen = CreatePen(PS_SOLID, 0, RGB(ColorRojo, ColorVerde, ColorAzul))
    hOldPen = SelectObject(objeto.hdc, hNewPen)
    Select Case Tipo
        Case Horizontal: 'Nos colocamos en el origen de la línea
                        MoveToEx objeto.hdc, Fade, 0&, 0&
                        'Trazamos la línea
                        LineTo objeto.hdc, Fade, Longitud
        Case Vertical: 'Nos colocamos en el origen de la línea
                        MoveToEx objeto.hdc, 0&, Fade, 0&
                        'Trazamos la línea
                        LineTo objeto.hdc, Longitud, Fade
        Case Diagonal: 'Nos colocamos en el origen de la línea
                        MoveToEx objeto.hdc, Fade, 0&, 0&
                        'Trazamos la línea
                        LineTo objeto.hdc, 0&, Fade
    End Select
    'Restauramos el pen original
    hNewPen = SelectObject(objeto.hdc, hOldPen)
    'Borrarmos el pen
    DeleteObject hNewPen
    'Incrementamos los colores
    ColorRojo = ColorRojo + CFadeRed
    ColorVerde = ColorVerde + CFadeGreen
    ColorAzul = ColorAzul + CFadeBlue
Next Fade
objeto.Picture = objeto.Image
'Restablecemos el ScaleMode
objeto.ScaleMode = Escala
End Sub


Public Sub Long2RGB(lngColor As Long, rgbColor As RGBQUAD)
Dim aux As Byte
CopyMemory rgbColor, lngColor, 4
aux = rgbColor.rgbBlue
rgbColor.rgbBlue = rgbColor.rgbRed
rgbColor.rgbRed = aux
End Sub