Apply a Gradient to Any Control that Has an hDC

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 GradientPrivate Sub cmdRect_Click()    Grad.control = Me.hDc = 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.RefreshEnd SubPrivate Sub Form_Load()    Set Grad = New GradientEnd Sub--------------------------------------------------------------Class Module--------------------------------------------------Option ExplicitPrivate Type TRIVERTEX    x As Long    y As Long    Red As Integer    Green As Integer    Blue As Integer    Alpha As IntegerEnd TypePrivate Type GRADIENT_RECT    UpperLeft As Long    LowerRight As LongEnd TypePrivate Type GRADIENT_TRIANGLE    Vertex1 As Long    Vertex2 As Long    Vertex3 As LongEnd TypeEnum D    Horizontal = 1    Vertical = 2End EnumConst GRADIENT_FILL_RECT_H As Long = &H0Const GRADIENT_FILL_RECT_V  As Long = &H1Const GRADIENT_FILL_TRIANGLE As Long = &H2Const GRADIENT_FILL_OP_FLAG As Long = &HFFPrivate 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 TRIVERTEXPrivate gRect As GRADIENT_RECTPrivate Control_hDc As LongPrivate Direction As IntegerPublic Property Let style(ByRef dir As D)    Direction = dirEnd PropertyPublic 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 IfEnd FunctionPrivate 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, lBlueEnd SubPrivate 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 IfEnd SubPublic Property Let start_Color(ByVal lStartColor As OLE_COLOR)    setTriVertexColor vert(0), lStartColorEnd PropertyPublic Property Let Finish_Color(ByVal lStartColor As OLE_COLOR)    setTriVertexColor vert(1), lStartColorEnd PropertyPublic Property Let control(ByVal ctl As Long)    Control_hDc = ctlEnd PropertyPublic Property Let Start_X(ByVal value As Long)    vert(0).x = valueEnd PropertyPublic Property Let Start_Y(ByVal value As Long)    vert(0).y = valueEnd PropertyPublic Property Let Start_Alpha(ByVal value As Long)    vert(0).Alpha = valueEnd PropertyPublic Property Let Finish_X(ByVal value As Long)    vert(1).x = valueEnd PropertyPublic Property Let Finish_Y(ByVal value As Long)    vert(1).y = valueEnd PropertyPublic Property Let Finish_Alpha(ByVal value As Long)    vert(1).Alpha = valueEnd PropertyPrivate Sub Class_Initialize()    Direction = D.VerticalEnd Sub--------------------------------------------------------------------
Share the Post:
Share on facebook
Share on twitter
Share on linkedin


Recent Articles: