[VBnet Forms] GradientFill: Triangular Gradient Form Backgrounds


	Visual Basic Window/Form Routines GradientFill: Triangular Gradient Form Backgrounds

Posted:	Monday February 17, 2003
Updated:	Monday December 26, 2011

Applies to:	VB4-32, VB5, VB6
Developed with:	VB6, Windows XP
OS restrictions:	Windows 98 or later, Windows 2000 or later
Author:	VBnet - Randy Birch

Related:	FillRect: Gradient Form Backgrounds GradientFill: Gradient Form Backgrounds GradientFill: Triangular Gradient Form Backgrounds Pure VB: Tile an Image as a Form Background

Prerequisites

None.

I certainly can't pretend to know why this works; its based on a C demo in the MSDN. While the TRIVERTEX structure is straightforward enough, I don't have sufficient experience with GDI to truly understand the ins and outs of the GRADIENT_TRIANGLE structure and its Vertex members. Suffice to say, playing around with different values for the various setting may provide you with a strong indication of what's going on under the hood.

As coded, the demo creates the form coloured as shown. The Red, Green, Blue and Alpha members of the TRIVERTEX structure are defined in the C header files as USHORT, or in VB parlance, Integers.

Concerning the TRIVERTEX structure, the MSDN states:

In the TRIVERTEX structure, x and y indicate position in the same manner as in the POINTL structure contained in the wtypes.h header file. Red, Green, Blue, and Alpha members indicate color information at the point x, y. The color information of each channel is specified as a value from 0x0000 to 0xff00. This allows higher color resolution for an object that has been split into small triangles for display. The TRIVERTEX structure contains information needed by the pVertex parameter of GradientFill.

For the GRADIENT_TRIANGLE structure, the MSDN text is:

The GRADIENT_TRIANGLE structure specifies the index of three vertices in the pVertex array in the GradientFill function. These three vertices form one triangle.

While this demos the code against a form background which may have its place in something like a custom splash screen, a better use for this code would be to fill a picture box being used as a colour-picking tool.

BAS Module Code

None.

Form Code

Add the following code to a form:

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_TRIANGLE = &H2

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_TRIANGLE
   Vertex1 As Long
   Vertex2 As Long
   Vertex3 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 Form_Load()

   Me.AutoRedraw = True
   
End Sub


Private Sub Form_Resize()

   Call DrawGradientFillTriangle(vbBlue, vbYellow, vbRed, vbBlack)

End Sub


Private Sub DrawGradientFillTriangle(dwColour1 As Long, _
                                     dwColour2 As Long, _
                                     dwColour3 As Long, _
                                     dwColour4 As Long)
    
   Dim grTri(0 To 1) As GRADIENT_TRIANGLE
   Dim vert(0 To 3) As TRIVERTEX
   
  'Colour at upper-left corner
   With vert(0)
      .X = 0
      .Y = 0
      .Red = LongToSignedShort(CLng((dwColour1 And &HFF&) * 256))
      .Green = LongToSignedShort(CLng(((dwColour1 And &HFF00&) \ &H100&) * 256))
      .Blue = LongToSignedShort(CLng(((dwColour1 And &HFF0000) \ &H10000) * 256))
      .Alpha = 0
   End With
   
  'Colour at upper-right corner
   With vert(1)
      .X = Me.ScaleWidth \ Screen.TwipsPerPixelX
      .Y = 0
      .Red = LongToSignedShort(CLng((dwColour2 And &HFF&) * 256))
      .Green = LongToSignedShort(CLng(((dwColour2 And &HFF00&) \ &H100&) * 256))
      .Blue = LongToSignedShort(CLng(((dwColour2 And &HFF0000) \ &H10000) * 256))
      .Alpha = 0
   End With

  'Colour at lower-right corner
   With vert(2)
      .X = Me.ScaleWidth \ Screen.TwipsPerPixelX
      .Y = Me.ScaleHeight \ Screen.TwipsPerPixelY
      .Red = LongToSignedShort(CLng((dwColour3 And &HFF&) * 256))
      .Green = LongToSignedShort(CLng(((dwColour3 And &HFF00&) \ &H100&) * 256))
      .Blue = LongToSignedShort(CLng(((dwColour3 And &HFF0000) \ &H10000) * 256))
      .Alpha = 0
   End With
      
  'Colour at lower-left corner
   With vert(3)
      .X = 0
      .Y = Me.ScaleHeight \ Screen.TwipsPerPixelX
      .Red = LongToSignedShort(CLng((dwColour4 And &HFF&) * 256))
      .Green = LongToSignedShort(CLng(((dwColour4 And &HFF00&) \ &H100&) * 256))
      .Blue = LongToSignedShort(CLng(((dwColour4 And &HFF0000) \ &H10000) * 256))
      .Alpha = 0
   End With
   
   With grTri(0)
      .Vertex1 = 0
      .Vertex2 = 1
      .Vertex3 = 2
   End With
   
   With grTri(1)
      .Vertex1 = 0
      .Vertex2 = 2
      .Vertex3 = 3
   End With
         
   Me.Cls
   
  'parameters:
  'hdc - display context handle of the target window
  'vert(0) - first member of interest in the vert() array
  '4 - number of vert() array members (not ubound(vert))
  'grTri(0) - first member of interest in the grTri() array
  '2 - number of grTri() array members (not ubound(grTri)
  'GRADIENT_FILL_TRIANGLE - fill operation
   Call GradientFill(Me.hdc, vert(0), 4, grTri(0), 2, GRADIENT_FILL_TRIANGLE)

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

Comments

PayPal Link