【Class Library】

Dim r1 As Long, g1 As Long, b1 As Long 'r,g,b値の初期値
Dim r2 As Long, g2 As Long, b2 As Long 'r,g,b値の終了値
'r,g,b値の1カウントごとの変化値
Dim rm As Single, gm As Single, bm As Single

Private Sub Class_Initialize()
    r1 = 0&: g1 = 0&: b1 = 255&
    r2 = 255&: g2 = 255&: b2 = 255&
    rm = 1!: gm = 1!: bm = 0!
End Sub

'============================================================
'SetGradColor   グラデーションに使用する色を設定
'------引数--------------------------------------------------
'fr,fg,fb   グラデーションに使うＲ，Ｇ，Ｂ値の初期値
'er,eg,eb   グラデーションに使うＲ，Ｇ，Ｂ値の終了値
'vr,vg,vb   １カウントごとのグラデーションのＲ，Ｇ，Ｂ値の変化値
'------注意--------------------------------------------------
'fr＜er→vr＞0:er＜fr→vr＜0でなければならない。
'============================================================
Public Sub SetGradColor(fr As Long, fg As Long, fb As Long, _
                      er As Long, eg As Long, eb As Long, _
                      vr As Single, vg As Single, vb As Single)
    r1 = fr: r2 = er: rm = vr
    g1 = fg: g2 = eg: gm = vg
    b1 = fb: b2 = eb: bm = vb
End Sub

'============================================================
'DrawGradLine   指定描画領域に、SetGradColorプロシージャで
'               指定された色で直線グラデーションを描く
'------引数--------------------------------------------------
'Pic        描画領域のオブジェ
'sx,sy      描画開始位置
'wid,hei    描画幅，高さ(gapx＜＞0の時wid無視、gapy＜＞0の時hei無視)
'gapx,gapy  描画向き(gapx=1の時、左から右)、１カウントごとの飛び
'count      グラデーションのカウント
'============================================================
Public Sub DrawGradLine(Pic As Object, _
                sx As Long, sy As Long, _
                wid As Long, hei As Long, _
                gapx As Long, gapy As Long, count As Long)
    Dim r As Long, g As Long, b As Long
    Dim i As Long
    Dim xw As Long, yh As Long
    If gapx <> 0& Then wid = 0& 'ここのコードにちょっと無理が・・
    If gapy <> 0& Then hei = 0&
    r = r1: g = g1: b = b1 '初期値の格納
    'グラデーションの回数まで
    For i = 0& To count - 1&
        '終了値まで、色を変化させていく
        If Abs(r - r2) >= Abs(rm) Then r = r1 + CLng(rm * CSng(i))
        If Abs(g - g2) >= Abs(gm) Then g = g1 + CLng(gm * CSng(i))
        If Abs(b - b2) >= Abs(bm) Then b = b1 + CLng(bm * CSng(i))
        xw = gapx * i: yh = gapy * i
        If gapx <> 0& And gapy <> 0& Then 'いわゆる斜線の描画
            Pic.Line (sx, sy + yh)-(sx + xw, sy), RGB(r, g, b)
        Else '普通の直線描画
            Pic.Line (sx + xw, sy + yh)- _
                     (sx + xw + wid, sy + yh + hei), RGB(r, g, b)
        End If
        DoEvents '←これがある方が見ていて面白い？
    Next i
End Sub

    Dim cgl As New CGradL
    Call cgl.SetGradColor(0&, 0&, 120&, _
              255&, 255&, 255&, 1!, 1!, 2!)
    Call cgl.DrawGradLine(Picture1, 0&, 0&, _
              0&, 300&, 1&, 0&, 300&)