画渐变色图像求教，谢谢！！！

Question

想画一个图里的东西：
一个矩形，边框为一种颜色，里面为另一种颜色，里面的颜色从中间到两边的边框逐渐变淡
求教高手指点一下，谢谢！！！
图例在http://www.vbgood.com/viewthread.php?tid=68693&extra=page%3D1

Answer 1

看不到附件，贴一段代码参考一下：
Private Type GRADIENT_TRIANGLE
    Vertex1 As Long
    Vertex2 As Long
    Vertex3 As Long
End Type
Private Type TRIVERTEX
    X As Long
    Y As Long
    Red As Integer
    Green As Integer
    Blue As Integer
    Alpha As Integer
End Type
Private Type GRADIENT_RECT
    UpperLeft As Long
    LowerRight As Long
End TypePrivate Enum GradientFillRectType
    GRADIENT_FILL_RECT_H = 0
    GRADIENT_FILL_RECT_V = 1
    GRADIENT_FILL_TRIANGLE = 2
End EnumPrivate Const CLR_INVALID = &HFFFF
Private Declare Function GradientFillRect Lib "msimg32" Alias "GradientFill" (ByVal hDC As Long, pVertex As TRIVERTEX, ByVal dwNumVertex As Long, pMesh As GRADIENT_RECT, ByVal dwNumMesh As Long, ByVal dwMode As Long) As Long
Private Declare Function GradientFillTriangle Lib "msimg32" Alias "GradientFill" (ByVal hDC As Long, pVertex As TRIVERTEX, ByVal dwNumVertex As Long, pMesh As GRADIENT_TRIANGLE, ByVal dwNumMesh As Long, ByVal dwMode As Long) As Long
Private Declare Function OleTranslateColor Lib "olepro32.dll" (ByVal OLE_COLOR As Long, ByVal hPalette As Long, pccolorref As Long) As LongPrivate Function DrawGradientCircle(ByVal hDC As Long, ByVal CenterX As Long, ByVal CenterY As Long, ByVal Radius As Long, ByVal StartColor As Long, ByVal EndColor As Long) As Boolean
    Dim i As Long
    Dim X1 As Long, Y1 As Long, X2 As Long, Y2 As Long, X3 As Long, Y3 As Long
    Dim Theta As Double
    Dim Vert(3) As TRIVERTEX
    Dim gTRi(1) As GRADIENT_TRIANGLE
 
    Theta = 10 * 3.1415926 / 180
    With Vert(0)
        .X = CenterX
        .Y = CenterY
        .Alpha = 0
    End With
    SetTriVertexColor Vert(0), StartColor
    X1 = CenterX
    Y1 = CenterY - Radius
    For i = 0 To 36
        X2 = CenterX - Cos(i * Theta) * Radius
        Y2 = CenterY - Sin(i * Theta) * Radius
        X3 = CenterX - Cos((i - 0.5) * Theta) * Radius
        Y3 = CenterY - Sin((i - 0.5) * Theta) * Radius
        With Vert(1)
            .X = X1
            .Y = Y1
            .Alpha = 0
        End With
        SetTriVertexColor Vert(1), EndColor
        With Vert(2)
            .X = X2
            .Y = Y2
            .Alpha = 0
        End With
        SetTriVertexColor Vert(2), EndColor
        With Vert(3)
            .X = X3
            .Y = Y3
            .Alpha = 0
        End With
        SetTriVertexColor Vert(3), EndColor
        
        gTRi(0).Vertex1 = 0
        gTRi(0).Vertex2 = 1
        gTRi(0).Vertex3 = 2
        gTRi(1).Vertex1 = 3
        gTRi(1).Vertex2 = 1
        gTRi(1).Vertex3 = 2
        GradientFillTriangle hDC, Vert(0), 4, gTRi(0), 2, GRADIENT_FILL_TRIANGLE
        X1 = X2
        Y1 = Y2
    Next
    DrawGradientCircle = True
End Function
Private Function DrawGradientRect(ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, X2 As Long, Y2 As Long, ColorStart As Long, ColorEnd As Long, Optional Mode As GradientFillRectType = GradientFillRectType.GRADIENT_FILL_RECT_H) As Boolean
    Dim Vert(1) As TRIVERTEX
    Dim gRect As GRADIENT_RECT
    SetTriVertexColor Vert(0), TranslateColor(ColorStart)
    With Vert(0)
        .X = X1
        .Y = Y1
        .Alpha = 0
    End With
    SetTriVertexColor Vert(1), TranslateColor(ColorEnd)
    With Vert(1)
        .X = X2
        .Y = Y2
        .Alpha = 0
    End With
    gRect.UpperLeft = 0
    gRect.LowerRight = 1
    If Mode = GRADIENT_FILL_TRIANGLE Then Mode = GRADIENT_FILL_RECT_H
    GradientFillRect hDC, Vert(0), 2, gRect, 1, Mode
    DrawGradientRect = True
End FunctionPrivate Sub SetTriVertexColor(Vert As TRIVERTEX, Color As Long)
    Dim Red As Long
    Dim Green As Long
    Dim Blue As Long
    Red = (Color And &HFF&) * &H100&
    Green = (Color And &HFF00&)
    Blue = (Color And &HFF0000) \ &H100&
    SetTriVertexColorComponent Vert.Red, Red
    SetTriVertexColorComponent Vert.Green, Green
    SetTriVertexColorComponent Vert.Blue, Blue
End Sub
Private Sub SetTriVertexColorComponent(ByRef Color As Integer, ByVal Component As Long)
    If (Component And &H8000&) = &H8000& Then
        Color = (Component And &H7F00&)
        Color = Color Or &H8000
    Else
        Color = Component
    End If
End SubPrivate Function TranslateColor(ByVal Color As OLE_COLOR, Optional hPal As Long = 0) As Long
    If OleTranslateColor(Color, hPal, TranslateColor) Then
        TranslateColor = CLR_INVALID
    End If
End FunctionPrivate Sub Command1_Click()
    DrawGradientCircle Me.hDC, 40, 40, 50, vbRed, vbGreen
    Me.Refresh
End SubPrivate Sub Command2_Click()
    DrawGradientRect Me.hDC, 10, 10, 200, 100, vbBlue, vbGreen
    Me.Refresh
End SubPrivate Sub Form_Load()
    Me.AutoRedraw = True
End Sub

Answer 2

谢谢你的帮助！！！
请你帮助看看我想画的图，谢谢！！！
http://www.vbgood.com/attachments/month_0804/zrTDMP7_wXGkpZfvQNPv.jpg

Answer 3

TO lsftest :谢谢！！因该是一样的：
还请各位看看下面的代码，能正常画出符合我的要求图形，但有一个问题(不能在Picture1离的任意位置画）
如： Call DrawGraduallyChangesColor(Picture1.hwnd, Picture1.ScaleWidth * 0.5, Picture1.ScaleHeight * 0.4, Picture1.ScaleWidth * 0.6, Picture1.ScaleHeight * 0.6, 1, vbWhite, 255)
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc 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 DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Const PS_SOLID = 0
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Function DrawGraduallyChangesColor(ByVal ObjHwnd As Long, ByVal X1 As Single, ByVal Y1 As Single, ByVal X2 As Single, ByVal Y2 As Single, ByVal HorV As Integer, ByVal StartColor As Long, ByVal EndColor As Long)
Dim hOldPen, hPen As Long
Dim r, g, b As Single
Dim r1, g1, b1, r2, g2, b2 As Integer
Dim A As Integer
Dim pColor As Long
r1 = StartColor And &HFF '提取开始颜色、结束颜色的RGB值
g1 = (StartColor And 65280) / 256
b1 = (StartColor And &HFF0000) / 65536
r2 = EndColor And &HFF
g2 = (EndColor And 65280) / 256
b2 = (EndColor And &HFF0000) / 65536
Dim ObjhDC As Long
ObjhDC = GetDC(ObjHwnd)
If HorV = 1 Then
r = (r2 - r1) / (X2 - X1)
g = (g2 - g1) / (X2 - X1)
b = (b2 - b1) / (X2 - X1)
For A = 0 To (X2 - X1 - 1)
pColor = RGB(r1 + r * A, g1 + g * A, b1 + b * A)
hPen = CreatePen(PS_SOLID, 0, pColor)
hOldPen = SelectObject(ObjhDC, hPen)
Rectangle ObjhDC, X1 + A, 0, X1 + A + 1, Y2
SelectObject ObjhDC, hOldPen
DeleteObject hPen
Next A
ElseIf HorV = 2 Then
r = (r2 - r1) / (Y2 - Y1)
g = (g2 - g1) / (Y2 - Y1)
b = (b2 - b1) / (Y2 - Y1)
For A = 0 To (Y2 - Y1 - 1)
pColor = RGB(r1 + r * A, g1 + g * A, b1 + b * A)
hPen = CreatePen(PS_SOLID, 0, pColor)
hOldPen = SelectObject(ObjhDC, hPen)
Rectangle ObjhDC, 0, Y1 + A, X2, Y1 + A + 1
SelectObject ObjhDC, hOldPen
DeleteObject hPen
Next A
End If
ReleaseDC ObjHwnd, ObjhDC
End Function
Private Sub AA_Click()
 Call DrawGraduallyChangesColor(Picture1.hwnd, 100, 200, 120, 300, 1, vbWhite, 255)
 Call DrawGraduallyChangesColor(Picture1.hwnd, 80, 200, 100, 300, 1, 255, vbWhite)
End Sub
Private Sub Form_Load()
Me.Show
End Sub
Private Sub Form_Resize()
Picture1.Left = 0
Picture1.Top = 0
Picture1.Height = Me.Height
Picture1.Width = Me.Width
End Sub

Answer 4

检查两处Rectangle的调用，传过来的参数Y1在绘图时没有起作用，所以不能改变绘图的位置
Rectangle ObjhDC, X1 + A, 0, X1 + A + 1, Y2 
Rectangle ObjhDC, 0, Y1 + A, X2, Y1 + A + 1