Attribute VB_Name = "modGrad"
'      API gradients module 1.01
'  Written by Mike D Sutton of EDais
'
' E-Mail: EDais@mvps.org
' WWW: Http://www.mvps.org/EDais/
'
' Written: 03/12/2001
' Last edited: 17/08/2003
'
'Version history:
' Version 1.01 (17/08/2003):
'   Converted NewTriVertex() to take a single colour rather than each channel
'   Now uses internal high byte assignment rather than calling external DLL
'   DrawRectGrad() "inHoriz" parameter now optional (False by default)
'   Library now system colour aware
'
'   HighByteWord() - Set's the high byte of a word
'   EvalCol()      - Returns the RGB of a long colour value (System colour aware)
'
' Version 1.0 (03/12/2001):
'   NewTriVertex() - Gradient vertex point constructor
'   DrawRectGrad() - Draws a rectangular gradient
'   DrawTriGrad()  - Draw a triangular gradient
'
'About:
'Simple library encapsulating the API gradient drawing routines
' making them easier to implement from VB
'
'You use this code at your own risk, I don't accept any
' responsibility for anything nasty it may do to your machine!
'Feel free to re-use this code in your own applications (Yeah,
' like I could stop you anyway ;) However, please don't attempt
' to sell or re-distribute it without my written consent.
'Visit my site for any updates to this an more strange graphics
' related VB code, comments and suggestions always welcome!

Private Declare Function GradientFill Lib "msimg32.dll" (ByVal hDC As Long, ByRef pVertex As TRIVERTEX, ByVal dwNumVertex As Long, ByRef pMesh As Any, ByVal dwNumMesh As Long, ByVal dwMode As Long) As Long
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long

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

Public Type TRIVERTEX
    X As Long
    Y As Long
    Red As Integer
    Green As Integer
    Blue As Integer
    Alpha As Integer
End Type

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

Public Function NewTriVertex(ByVal inX As Long, ByVal inY As Long, ByVal inCol As Long) As TRIVERTEX
    Dim UseCol As Long
    
    UseCol = EvalCol(inCol)
    
    With NewTriVertex ' TriVertex constructor
        .X = inX
        .Y = inY
        .Red = HighByteWord(UseCol And &HFF)
        .Green = HighByteWord((UseCol \ &H100) And &HFF)
        .Blue = HighByteWord((UseCol \ &H10000) And &HFF)
        .Alpha = HighByteWord((UseCol \ &H1000000) And &HFF)
    End With
End Function

Public Function DrawRectGrad(ByVal inDC As Long, ByRef inA As TRIVERTEX, _
    ByRef inB As TRIVERTEX, Optional ByVal inHoriz As Boolean = False) As Boolean
    Dim RectInf As GRADIENT_RECT ' Draws a rectangular gradient
    Dim RectPts(1) As TRIVERTEX
    
    RectInf.UpperLeft = 1
    RectPts(0) = inA
    RectPts(1) = inB
    
    DrawRectGrad = GradientFill(inDC, RectPts(0), 2, RectInf, 1, _
        IIf(inHoriz, GRADIENT_FILL_RECT_H, GRADIENT_FILL_RECT_V)) <> 0
End Function

Public Function DrawTriGrad(ByVal inDC As Long, ByRef inA As TRIVERTEX, _
    ByRef inB As TRIVERTEX, ByRef inC As TRIVERTEX) As Boolean
    Dim TriInf As GRADIENT_TRIANGLE ' Draws a triangular gradient
    Dim TriPts(2) As TRIVERTEX
    
    With TriInf
        .Vertex1 = 0
        .Vertex2 = 1
        .Vertex3 = 2
    End With
    
    TriPts(0) = inA
    TriPts(1) = inB
    TriPts(2) = inC
    
    DrawTriGrad = GradientFill(inDC, TriPts(0), 3, _
        TriInf, 1, GRADIENT_FILL_TRIANGLE) <> 0
End Function

Private Function HighByteWord(ByVal inByte As Byte) As Integer
    HighByteWord = ((inByte And &H7F) * &H100) ' Set's the high byte of a word
    If (inByte And &H80) Then HighByteWord = Not (HighByteWord Xor &H7FFF)
End Function

Private Function EvalCol(ByVal inCol As Long) As Long ' Returns the RGB of a long colour value (System colour aware)
    If ((inCol And &HFFFFFF00) = &H80000000) Then EvalCol = GetSysColor(inCol And &HFF) Else EvalCol = inCol
End Function