渐变

来源:互联网 发布:状态转移概率矩阵 编辑:程序博客网 时间:2024/05/01 01:15

1.画线的方法太笨了啊,推荐使用API函数:GradientFillRect

示例:新建窗体,窗体代码如下:

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 Type

Private Const GRADIENT_FILL_RECT_H As Long = &H0
Private Const GRADIENT_FILL_RECT_V  As Long = &H1
Private Const GRADIENT_FILL_TRIANGLE As Long = &H2
Private Const GRADIENT_FILL_OP_FLAG As Long = &HFF

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 Sub Form_Load()
    Me.ScaleMode = vbPixels
End Sub

Private Sub Form_Paint()
    Dim vert(1) As TRIVERTEX
    Dim gRect As GRADIENT_RECT
    With vert(0)
        .x = 0
        .y = 0
        .Red = 0&
        .Green = 0&
        .Blue = 0&
        .Alpha = 0&
    End With
    With vert(1)
        .x = Me.ScaleWidth
        .y = Me.ScaleHeight
        .Red = 0&
        .Green = 0&
        .Blue = CInt(&HFF00& - &H10000)
        .Alpha = 0&
    End With
    gRect.UpperLeft = 0
    gRect.LowerRight = 1
    GradientFillRect Me.hdc, vert(0), 2, gRect, 1, GRADIENT_FILL_RECT_H
End Sub

2.Public Function Horizontal(Newform As Form, Colour1 As ColorConstants, Colour2 As ColorConstants)
    Dim VR, VG, VB As Single
    Dim Color1, Color2 As Long
    Dim r, G, b, R2, G2, B2 As Integer
    Dim temp As Long
    Dim X As Long
   
    Color1 = Colour1
    Color2 = Colour2

    temp = (Color1 And 255)
    r = temp And 255
    temp = Int(Color1 / 256)
    G = temp And 255
    temp = Int(Color1 / 65536)
    b = temp And 255
    temp = (Color2 And 255)
    R2 = temp And 255
    temp = Int(Color2 / 256)
    G2 = temp And 255
    temp = Int(Color2 / 65536)
    B2 = temp And 255

    VR = Abs(r - R2) / Newform.ScaleWidth
    VG = Abs(G - G2) / Newform.ScaleWidth
    VB = Abs(b - B2) / Newform.ScaleWidth

    If R2 < r Then VR = -VR
    If G2 < G Then VG = -VG
    If B2 < b Then VB = -VB

    For X = 0 To Newform.ScaleWidth
        R2 = r + VR * X
        G2 = G + VG * X
        B2 = b + VB * X
        Newform.Line (X, 0)-(X, Newform.ScaleHeight), RGB(R2, G2, B2)
    Next X
End Function
3.Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function FillRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Private Type RECT
    left As Long
     top As Long
     right As Long
     bottom As Long
    End Type


    Private Sub Form_Paint()
    Dim Color As Long
    Dim hBrush As Long
    Dim OldMode As Long
    Dim RetVal As Long
    Dim StepSize As Long
    Dim X As Long
    Dim FillArea As RECT
    OldMode = Me.ScaleMode
    Me.ScaleMode = 3
    StepSize = 1 + Me.ScaleHeight / 80
    Color = 255
    FillArea.left = 0
    FillArea.right = Me.ScaleWidth
    FillArea.top = 0
    FillArea.bottom = StepSize
    For X = 1 To 80
    hBrush = CreateSolidBrush(RGB(Color / 2, Color * 2, Color))
    RetVal = FillRect(Me.hdc, FillArea, hBrush)
     RetVal = DeleteObject(hBrush)
    Color = Color - 2
     If Color < 0 Then Color = 0
     FillArea.top = FillArea.bottom
    FillArea.bottom = FillArea.bottom + StepSize
    Next
    Me.ScaleMode = OldMode
    End Sub