Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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 GRADIENT_FILL_RECT_DIRECTION As Long
Private Const GRADIENT_COLOR1 As Long = &HFF0000
Private Const GRADIENT_COLOR2 As Long = &H0
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 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 Sub Command1_Click()
'toggle the colour
GRADIENT_FILL_RECT_DIRECTION = Not GRADIENT_FILL_RECT_DIRECTION
Call DrawGradientFill(GRADIENT_COLOR1, GRADIENT_COLOR2)
End Sub
Private Sub Form_Load()
Me.AutoRedraw = True
End Sub
Private Sub Form_Resize()
Call DrawGradientFill(GRADIENT_COLOR1, GRADIENT_COLOR2)
End Sub
Private Sub DrawGradientFill(ByVal dwColour1 As Long, ByVal dwColour2 As Long)
Dim vert(0 To 1) As TRIVERTEX
Dim grRc As GRADIENT_RECT
'Colour at upper-left corner
With vert(0)
.x = 0
.Y = 0
.Red = LongToSignedShort((dwColour1 And &HFF&) * 256)
.Green = LongToSignedShort(((dwColour1 And &HFF00&) \ &H100&) * 256)
.Blue = LongToSignedShort(((dwColour1 And &HFF0000) \ &H10000) * 256)
.Alpha = 0
End With
'Colour at bottom-right corner
With vert(1)
.x = Me.ScaleWidth \ Screen.TwipsPerPixelX
.Y = Me.ScaleHeight \ Screen.TwipsPerPixelY
.Red = LongToSignedShort((dwColour2 And &HFF&) * 256)
.Green = LongToSignedShort(((dwColour2 And &HFF00&) \ &H100&) * 256)
.Blue = LongToSignedShort(((dwColour2 And &HFF0000) \ &H10000) * 256)
.Alpha = 0
End With
With grRc
.LowerRight = 0
.UpperLeft = 1
End With
Me.Cls
'parameters:
'hdc - display context handle of the target window
'vert(0) - first member of interest in the vert() array
'2 - number of vert() array members (not ubound(vert))
'grRc - GRADIENT_RECT info
'1 - number of grRc structures passed
'GRADIENT_FILL_RECT_DIRECTION - fill operation -
'will toggle between 0 and 1, the values of
'GRADIENT_FILL_RECT_H and GRADIENT_FILL_RECT_V.
Call GradientFill(Me.hdc, vert(0), 2, grRc, 1, Abs(GRADIENT_FILL_RECT_DIRECTION))
End Sub
Private Function LongToSignedShort(dwUnsigned As Long) As Integer
'convert from long to signed short
If dwUnsigned < 32768 Then
LongToSignedShort = CInt(dwUnsigned)
Else
LongToSignedShort = CInt(dwUnsigned - &H10000)
End If
End Function |
For
those using the FillRect gradient fill demo at FillRect: Gradient Form Backgrounds,
here's a faster method to achieve a horizontal or vertical two-colour
gradient fill. For more information about the GradientFill methods, see
the
GradientFill: Triangular Gradient Form Backgrounds
demo. As with the Triangle demo, this code is also suitable for use in
filling a picture box used as a colour-picking tool.
