Attribute VB_Name = "PixLib"
'   VB Pixel library  version 1.3
' Written by Mike D Sutton of EDais
'     Microsoft Visual Basic MVP
'
' E-Mail: EDais@mvps.org
' WWW: Http://www.mvps.org/EDais/
'
' Written: 12/10/2000
' Last edited: 16/08/2003
'
'About:
'A library of useful functions to deal with colour in VB
'
'Version history:
' Version 1.0 (12/10/2000):
'   Pixel UDT
'   NewPixel()  - Pixel constructor
'   PixToLong() - Converts a pixel to a long
'   LongToPix() - Converts a long to a pixel
'   TransPix()  - Linearly interpolate one pixel to another
'   LinearB()   - Linear interpolation routine (Byte version)
'   InvertPix() - Inverts a pixel
'
' Version 1.1 (19/11/2000):
'   Converted Pixel UDT to be 24/32 Bit
'   TransAddPix()   - Blend one pixel to another (Additive blend mode)
'   TransSubPix()   - Blend one pixel to another (Subtractive blend mode)
'   CheckHighByte() - Make sure a value isn't too big to fit in a byte
'   CheckLowByte()  - Make sure a value isn't too small to fit in a byte
'   CheckByte()     - Make sure a value isn't too big to fit in a byte
'   GreyPix()       - Returns the 8-Bit greyscale value (Uses ITU standard)
'   GreyscalePix()  - Returns a 24/32-Bit greyscale colour from an 8-Bit greyscale value
'
' Version 1.1b (23/11/2000):
'   SameCol()    - Checks to see if two colours are the same
'   LightenPix() - Lightens colour
'   DarkenPix()  - Darkens colour
'
' Version 1.2 (24/01/2001):
'   Arganised / grouped similar functions
'   TransSubPix()   - Fixed old function, see version 1.1 notes
'   TransLightPix() - Blend one pixel to another (Lighten blend mode)
'   TransDarkPix()  - Blend one pixel to another (Darken blend mode)
'   TransDiffPix()  - Blend one pixel to another (Difference blend mode)
'   TransExclPix()  - Blend one pixel to another (Exclusion blend mode)
'   MaxB()          - Returns the maximum of two byte values
'   MinB()          - Returns the minimum of two byte values
'
' Version 1.2b (01/03/2001):
'   Converted all Trans*Pix() functions to call Blend*()
'       functions, transparecy with different blend modes,
'       should now work.  (Untested currently unfortunately
'       though)
'   BlendAdd()   - Overlays pixels in addative blend mode
'   BlendSub()   - Overlays pixels in subtractive blend mode
'   BlendLight() - Overlays pixels in lighten blend mode
'   BlendDark()  - Overlays pixels in darken blend mode
'   BlendDiff()  - Overlays pixels in difference blend mode
'   BlendExcl()  - Overlays pixels in exclusion blend mode
'
' Version 1.3 (16/08/2003):
'   Entire library now properly alpha aware and controlllable
'   gloabbly via the UseAlpha conditional compile argument
'   Cleaned up and optimised entire library
'   LongToPix() now system colour aware
'   PixToLong() will now optionally copy alpha to output value
'   LongToPix() will now optionally read alpha from input value
'
'You use this code at your own risk, I don't accept any
' responsibility for anything nasty it may do to your machine!
'
'Please don't rip my work off...  I'm distributing this library
' free of charge because I think it can help other developers,
' this doesn't give you the right to take credit for it.  By
' all means use it, yes, but please don't claim it's your own
' work or charge for it.  If you do create anything interesting
' with it then feel free to send me it, if I receive any nice
' source code I'll post it on the site (With your permission)
' and of course you'll get full credit for it.
'
'Visit my site for any updates to this an more strange graphics
' related VB code, comments and suggestions always welcome!

' Should the library use 32 bit colours with alpha values?
#Const UseAlpha = True

Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

#If (UseAlpha) Then
    Public Type Pixel  ' 32-Bit colour
        Blue As Byte
        Green As Byte
        Red  As Byte
        Trans As Byte ' Alpha
    End Type
#Else
    Public Type Pixel  ' 24-Bit colour
        Blue As Byte
        Green As Byte
        Red  As Byte
    End Type
#End If

' Construction functions
#If (UseAlpha) Then
    Public Function NewPixel(ByVal inRed As Byte, ByVal inGreen As Byte, _
        ByVal inBlue As Byte, Optional ByVal inTrans As Byte = &HFF) As Pixel
        NewPixel.Trans = inTrans
#Else
    Public Function NewPixel(ByVal inRed As Byte, ByVal inGreen As Byte, ByVal inBlue As Byte) As Pixel
#End If
    With NewPixel ' Pixel constructor
        .Red = inRed
        .Green = inGreen
        .Blue = inBlue
    End With
End Function

#If (UseAlpha) Then
    Public Function PixToLong(ByRef inPix As Pixel, Optional ByVal inCopyAlpha As Boolean = False) As Long
        PixToLong = RGB(inPix.Red, inPix.Green, inPix.Blue)
        If (inCopyAlpha) Then Call RtlMoveMemory(ByVal (VarPtr(PixToLong) + 3), inPix.Trans, &H1)
    End Function
#Else
    Public Function PixToLong(ByRef inPix As Pixel) As Long
        PixToLong = RGB(inPix.Red, inPix.Green, inPix.Blue)
    End Function
#End If

#If (UseAlpha) Then
    Public Function LongToPix(ByVal inCol As Long, Optional ByVal inReadAlpha As Boolean = False) As Pixel
#Else
    Public Function LongToPix(ByVal inCol As Long) As Pixel
#End If
    If ((inCol And &HFFFFFF00) = &H80000000) Then _
        inCol = GetSysColor(inCol And &HFF) Or &HFF000000
    
    With LongToPix ' Converts a long to pixel
        .Red = inCol And &HFF
        .Green = (inCol \ &H100) And &HFF
        .Blue = (inCol \ &H10000) And &HFF
        
        #If (UseAlpha) Then
            If (inReadAlpha) Then .Trans = (inCol \ &H1000000) And &HFF Else .Trans = &HFF
        #End If
    End With
End Function

Public Function GreyscalePix(ByVal inLevel As Byte) As Pixel
    #If (UseAlpha) Then ' Returns a 24/32-Bit greyscale 'colour'
        GreyscalePix = NewPixel(inLevel, inLevel, inLevel, &HFF)
    #Else
        GreyscalePix = NewPixel(inLevel, inLevel, inLevel)
    #End If
End Function

' Colour adjustment
Public Function InvertPix(ByRef inPix As Pixel) As Pixel
    With InvertPix ' Inverts a pixel value
        .Red = Not inPix.Red
        .Green = Not inPix.Green
        .Blue = Not inPix.Blue
        
        #If (UseAlpha) Then
            .Trans = Not .Trans
        #End If
    End With
End Function

Public Function SameCol(ByRef inPixA As Pixel, ByRef inPixB As Pixel) As Boolean
    #If (UseAlpha) Then ' Checks to see if two colours are the same
        SameCol = (inPixA.Red = inPixB.Red) And (inPixA.Green = inPixB.Green) And _
            (inPixA.Blue = inPixB.Blue) And (inPixA.Trans = inPixB.Trans)
    #Else
        SameCol = (inPixA.Red = inPixB.Red) And (inPixA.Green = inPixB.Green) And (inPixA.Blue = inPixB.Blue)
    #End If
End Function

Public Function GetGreyPix(ByRef inPix As Pixel) As Byte
    ' Returns the 8-Bit greyscale value of the pixel
    GetGreyPix = ((inPix.Red * 0.222) + (inPix.Green * 0.707) + (inPix.Blue * 0.071))
End Function

Public Function LightenPix(ByRef inCol As Pixel, ByVal inAmt As Byte) As Pixel
    #If (UseAlpha) Then ' Lightens the colour by a specified amount
        LightenPix = NewPixel(CheckHighByte(inCol.Red + inAmt), _
            CheckHighByte(inCol.Green + inAmt), CheckHighByte(inCol.Blue + inAmt), _
            CheckHighByte(inCol.Trans + inAmt))
    #Else
        LightenPix = NewPixel(CheckHighByte(inCol.Red + inAmt), _
            CheckHighByte(inCol.Green + inAmt), CheckHighByte(inCol.Blue + inAmt))
    #End If
End Function

Public Function DarkenPix(ByRef inCol As Pixel, ByVal inAmt As Byte) As Pixel
    #If (UseAlpha) Then ' Darkens the colour by a specified amount
        DarkenPix = NewPixel(CheckLowByte(inCol.Red - inAmt), _
            CheckLowByte(inCol.Green - inAmt), CheckLowByte(inCol.Blue - inAmt), _
            CheckLowByte(inCol.Trans - inAmt))
    #Else
        DarkenPix = NewPixel(CheckLowByte(inCol.Red - inAmt), _
            CheckLowByte(inCol.Green - inAmt), CheckLowByte(inCol.Blue - inAmt))
    #End If
End Function

' Blending functions
Public Function TransPix(ByRef PixA As Pixel, ByRef PixB As Pixel, ByVal inAmt As Single) As Pixel
    With TransPix ' Linearly interpolate one pixel to another
        .Red = LinearB(PixA.Red, PixB.Red, inAmt)
        .Green = LinearB(PixA.Green, PixB.Green, inAmt)
        .Blue = LinearB(PixA.Blue, PixB.Blue, inAmt)
        
        #If (UseAlpha) Then
            .Trans = LinearB(PixA.Trans, PixB.Trans, inAmt)
        #End If
    End With
End Function

Public Function TransAddPix(ByRef inPixA As Pixel, ByRef inPixB As Pixel, ByVal inAmt As Single) As Pixel
    TransAddPix = TransPix(BlendAdd(inPixA, inPixB), inPixB, inAmt) ' Additive transparency
End Function

Public Function TransSubPix(ByRef inPixA As Pixel, ByRef inPixB As Pixel, ByVal inAmt As Single) As Pixel
    TransSubPix = TransPix(BlendSub(inPixA, inPixB), inPixB, inAmt) ' Subtractive transparency
End Function

Public Function TransLightPix(ByRef inPixA As Pixel, ByRef inPixB As Pixel, ByVal inAmt As Single) As Pixel
    TransLightPix = TransPix(BlendLight(inPixA, inPixB), inPixB, inAmt) ' Lighten transparency
End Function

Public Function TransDarkPix(ByRef inPixA As Pixel, ByRef inPixB As Pixel, ByVal inAmt As Single) As Pixel
    TransDarkPix = TransPix(BlendDark(inPixA, inPixB), inPixB, inAmt) ' Darken transparency
End Function

Public Function TransDiffPix(ByRef inPixA As Pixel, ByRef inPixB As Pixel, ByVal inAmt As Single) As Pixel
    TransDiffPix = TransPix(BlendDiff(inPixA, inPixB), inPixB, inAmt) ' Difference transparency
End Function

Public Function TransScrnPix(ByRef inPixA As Pixel, ByRef inPixB As Pixel, ByVal inAmt As Single) As Pixel
    TransScrnPix = TransPix(BlendScrn(inPixA, inPixB), inPixB, inAmt) ' Screen transparency
End Function

Public Function TransExclPix(ByRef inPixA As Pixel, ByRef inPixB As Pixel, ByVal inAmt As Single) As Pixel
    TransExclPix = TransPix(BlendExcl(inPixA, inPixB), inPixB, inAmt) ' Exclusion transparency
End Function

Public Function BlendAdd(ByRef inPixA As Pixel, ByRef inPixB As Pixel) As Pixel
    With BlendAdd ' Blend with additive blend mode
        .Red = CheckHighByte(inPixA.Red + inPixB.Red)
        .Green = CheckHighByte(inPixA.Green + inPixB.Green)
        .Blue = CheckHighByte(inPixA.Blue + inPixB.Blue)
        
        #If (UseAlpha) Then
            .Trans = CheckHighByte(inPixA.Trans + inPixB.Trans)
        #End If
    End With
End Function

Public Function BlendSub(ByRef inPixA As Pixel, ByRef inPixB As Pixel) As Pixel
    With BlendSub ' Blend with subtractive blend mode
        .Red = CheckLowByte(inPixA.Red - inPixB.Red)
        .Green = CheckLowByte(inPixA.Green - inPixB.Green)
        .Blue = CheckLowByte(inPixA.Blue - inPixB.Blue)
        
        #If (UseAlpha) Then
            .Trans = CheckLowByte(inPixA.Trans - inPixB.Trans)
        #End If
    End With
End Function

Public Function BlendLight(ByRef inPixA As Pixel, ByRef inPixB As Pixel) As Pixel
    With BlendLight ' Blend with lighten blend mode
        .Red = MaxB(inPixA.Red, inPixB.Red)
        .Green = MaxB(inPixA.Green, inPixB.Green)
        .Blue = MaxB(inPixA.Blue, inPixB.Blue)
        
        #If (UseAlpha) Then
            .Trans = MaxB(inPixA.Trans, inPixB.Trans)
        #End If
    End With
End Function

Public Function BlendDark(ByRef inPixA As Pixel, ByRef inPixB As Pixel) As Pixel
    With BlendDark ' Blend with darken blend mode
        .Red = MinB(inPixA.Red, inPixB.Red)
        .Green = MinB(inPixA.Green, inPixB.Green)
        .Blue = MinB(inPixA.Blue, inPixB.Blue)
        
        #If (UseAlpha) Then
            .Trans = MinB(inPixA.Trans, inPixB.Trans)
        #End If
    End With
End Function

Public Function BlendDiff(ByRef inPixA As Pixel, ByRef inPixB As Pixel) As Pixel
    With BlendDiff ' Blend with difference blend mode
        .Red = Abs(inPixA.Red - inPixB.Red)
        .Green = Abs(inPixA.Green - inPixB.Green)
        .Blue = Abs(inPixA.Blue - inPixB.Blue)
        
        #If (UseAlpha) Then
            .Trans = Abs(inPixA.Trans - inPixB.Trans)
        #End If
    End With
End Function

Public Function BlendScrn(ByRef inPixA As Pixel, ByRef inPixB As Pixel) As Pixel
    With BlendScrn ' Blend with screen blend mode
        .Red = CheckHighByte(inPixA.Red * (1 + (inPixB.Red / &HFF)))
        .Green = CheckHighByte(inPixA.Green * (1 + (inPixB.Green / &HFF)))
        .Blue = CheckHighByte(inPixA.Blue * (1 + (inPixB.Blue / &HFF)))
        
        #If (UseAlpha) Then
            .Trans = CheckHighByte(inPixA.Trans * (1 + (inPixB.Trans / &HFF)))
        #End If
    End With
End Function

Public Function BlendExcl(ByRef inPixA As Pixel, ByRef inPixB As Pixel) As Pixel
    With BlendExcl ' Blend with exculusion blend mode
        .Red = LinearB(inPixA.Red, Not inPixA.Red, inPixB.Red / &HFF)
        .Green = LinearB(inPixA.Green, Not inPixA.Green, inPixB.Green / &HFF)
        .Blue = LinearB(inPixA.Blue, Not inPixA.Blue, inPixB.Blue / &HFF)
        
        #If (UseAlpha) Then
            .Trans = LinearB(inPixA.Trans, Not inPixA.Trans, inPixB.Trans / &HFF)
        #End If
    End With
End Function

' Misc functions
Private Function LinearB(ByVal inValA As Byte, ByVal inValB As Byte, ByVal inPos As Single) As Byte
    ' Linear interpolation routine (Byte version)
    LinearB = (inValA * (1 - inPos)) + (inValB * inPos)
End Function

Private Function CheckHighByte(ByVal inVal As Integer) As Byte
    ' Makes sure a value will fit in a byte (Only checks for >0xFF)
    CheckHighByte = IIf(inVal > &HFF, &HFF, inVal)
End Function

Private Function CheckLowByte(ByVal inVal As Integer) As Byte
    ' Makes sure a value will fit in a byte (Only checks for <0)
    CheckLowByte = IIf(inVal < 0, 0, inVal)
End Function

Private Function CheckByte(ByVal inVal As Integer) As Byte
    ' Makes sure a value will fit in a byte (Checks for both <0 and >0xFF)
    If (inVal < 0) Then CheckByte = 0 Else If (inVal > &HFF) Then CheckByte = &HFF Else CheckByte = inVal
End Function

Private Function MaxB(ByVal inValA As Byte, ByVal inValB As Byte) As Byte
    ' Returns the maximum of two values
    MaxB = IIf(inValA > inValB, inValA, inValB)
End Function

Private Function MinB(ByVal inValA As Byte, ByVal inValB As Byte) As Byte
    ' Returns the minumum of two values
    MinB = IIf(inValA < inValB, inValA, inValB)
End Function