渐变

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

  • 0
    点赞
  • 1
    收藏
    觉得还不错? 一键收藏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值