Home » Tip Bank » Security » Visual Basic

Language: VB
Expertise: Intermediate

Jun 14, 2005

This class allows you to apply a gradient to any control that has an hDC—forms, Pictureboxes, etc. Simply load the class and tell it the start color, direction of gradient, stop color, and the control to color. Then render it. It uses two API calls to perform the rendering, so it is blindlingly fast.

 Form Module-------------------------------------------------------

' Add one command button to the form and name it "cmdRect"

Dim Grad As Gradient

Private Sub cmdRect_Click()
    Grad.control = Me.hDc
    Grad.style = Vertical
    Grad.Start_X = 0
    Grad.Start_Y = 0
    Grad.start_Color = RGB(0, 0, 0)
    
    Grad.Finish_X = Me.ScaleWidth
    Grad.Finish_Y = Me.ScaleHeight
    Grad.Finish_Color = RGB(0, 255, 255)

    Dim Rendered As Boolean
    
    Grad.Finish_Color = RGB(Rnd * 255, Rnd * 255, Rnd * 255)
    
    Rendered = Grad.Render
    'Me.Refresh

End Sub

Private Sub Form_Load()
    Set Grad = New Gradient
End Sub

--------------------------------------------------------------

Class Module--------------------------------------------------
Option Explicit

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 Type GRADIENT_TRIANGLE
    Vertex1 As Long
    Vertex2 As Long
    Vertex3 As Long
End Type

Enum D
    Horizontal = 1
    Vertical = 2
End Enum

Const GRADIENT_FILL_RECT_H As Long = &H0
Const GRADIENT_FILL_RECT_V  As Long = &H1
Const GRADIENT_FILL_TRIANGLE As Long = &H2
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 vert(1) As TRIVERTEX
Private gRect As GRADIENT_RECT
Private Control_hDc As Long
Private Direction As Integer

Public Property Let style(ByRef dir As D)
    Direction = dir
End Property

Public Function Render() As Boolean
    gRect.UpperLeft = 0
    gRect.LowerRight = 1
    If Direction = D.Horizontal Then
        GradientFillRect Control_hDc, vert(0), 2, gRect, 1, GRADIENT_FILL_RECT_H
    Else
        GradientFillRect Control_hDc, vert(0), 2, gRect, 1, GRADIENT_FILL_RECT_V
    End If
End Function

Private Sub setTriVertexColor(tTV As TRIVERTEX, lColor As Long)
    Dim lRed As Long
    Dim lGreen As Long
    Dim lBlue As Long
    lRed = (lColor And &HFF&) * &H100&
    lGreen = (lColor And &HFF00&)
    lBlue = (lColor And &HFF0000) \ &H100&
    setTriVertexColorComponent tTV.Red, lRed
    setTriVertexColorComponent tTV.Green, lGreen
    setTriVertexColorComponent tTV.Blue, lBlue
End Sub

Private Sub setTriVertexColorComponent(ByRef iColor As Integer, ByVal lComponent As Long)
    If (lComponent And &H8000&) = &H8000& Then
        iColor = (lComponent And &H7F00&)
        iColor = iColor Or &H8000
    Else
        iColor = lComponent
    End If
End Sub

Public Property Let start_Color(ByVal lStartColor As OLE_COLOR)
    setTriVertexColor vert(0), lStartColor
End Property

Public Property Let Finish_Color(ByVal lStartColor As OLE_COLOR)
    setTriVertexColor vert(1), lStartColor
End Property

Public Property Let control(ByVal ctl As Long)
    Control_hDc = ctl
End Property

Public Property Let Start_X(ByVal value As Long)
    vert(0).x = value
End Property

Public Property Let Start_Y(ByVal value As Long)
    vert(0).y = value
End Property

Public Property Let Start_Alpha(ByVal value As Long)
    vert(0).Alpha = value
End Property

Public Property Let Finish_X(ByVal value As Long)
    vert(1).x = value
End Property

Public Property Let Finish_Y(ByVal value As Long)
    vert(1).y = value
End Property

Public Property Let Finish_Alpha(ByVal value As Long)
    vert(1).Alpha = value
End Property

Private Sub Class_Initialize()
    Direction = D.Vertical
End Sub

--------------------------------------------------------------------