clsgradient(xp按钮).cls

在Visual Basic 6.0的环境下

Version 1.0 Class
Begin
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
End
Attribute VB_Name = "clsGradient"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False


Option Explicit

Public Enum GRADIENT_DIRECT
    [Left To Right] = &H0
    [Top To Bottom] = &H1
End Enum

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom 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 Type

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 GradientFill Lib "msimg32" (ByVal hdc As Long, pVertex As Any, ByVal dwNumVertex As Long, pMesh As Any, ByVal dwNumMesh As Long, ByVal dwMode As Long) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Private udtRect As RECT

Private Function LongToSignedShort(ByVal Unsigned As Long) As Integer
    If Unsigned < 32768 Then
        LongToSignedShort = CInt(Unsigned)
    Else
        LongToSignedShort = CInt(Unsigned - &H10000)
    End If
End Function

Public Sub DefineRect(ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long)
    SetRect udtRect, X1, Y1, X2, Y2
End Sub

Public Sub DrawGradient(ByVal hdc As Long, Direction As GRADIENT_DIRECT, ByVal StartColor As Long, ByVal EndColor As Long)
    Dim udtVert(1) As TRIVERTEX, udtGRect As GRADIENT_RECT
    
    With udtVert(0)
        .x = udtRect.Left
        .Y = udtRect.Top
        .Red = LongToSignedShort(CLng((StartColor And &HFF&) * 256))
        .Green = LongToSignedShort(CLng(((StartColor And &HFF00&) \ &H100&) * 256))
        .Blue = LongToSignedShort(CLng(((StartColor And &HFF0000) \ &H10000) * 256))
        .Alpha = 0&
    End With
    
    With udtVert(1)
        .x = udtRect.Right
        .Y = udtRect.Bottom
        .Red = LongToSignedShort(CLng((EndColor And &HFF&) * 256))
        .Green = LongToSignedShort(CLng(((EndColor And &HFF00&) \ &H100&) * 256))
        .Blue = LongToSignedShort(CLng(((EndColor And &HFF0000) \ &H10000) * 256))
        .Alpha = 0&
    End With
    
    udtGRect.UpperLeft = 0
    udtGRect.LowerRight = 1
    
    GradientFillRect hdc, udtVert(0), 2, udtGRect, 1, Direction
End Sub