Hue Contrast Brightness Palette

Published:

Updated:

Function HCBPtoRGB(ByVal Hue As Double, ByVal Contrast As Double, ByVal Brightness As Double, ByVal Palette As Double) As Long
    'Palette = 0.0  [All Chroma Palette]  <- to ->  Palette = 1.0  [All Saturation Palette]
    'Hue, Contrast, Brightness = 0.0 to 1.0 Scale
    HCBPtoRGB = RGB(Int(255 * HCBPtoR(Hue, Contrast, Brightness, Palette)), Int(255 * HCBPtoG(Hue, Contrast, Brightness, Palette)), Int(255 * HCBPtoB(Hue, Contrast, Brightness, Palette)))
End Function

Function HCBPtoR(ByVal Hue As Double, ByVal Contrast As Double, ByVal Brightness As Double, ByVal Palette As Double)
    'Palette = 0.0  [All Chroma],  Palette = 1.0  [All Saturation]
    Dim r0, g0, b0, h0, c0, m0, x0 As Double 'Chroma Scale
    Dim r1, g1, b1, h1, c1, m1, x1 As Double 'Saturation Scale
   
    c0 = Contrast
    c1 = (1 - Abs(2 * Brightness - 1)) * Contrast
    h0 = Hue - Int(Hue)
    h1 = Hue - Int(Hue)
    x0 = c0 * (1 - Abs(Modulus((6 * h0), 2) - 1))
    x1 = c1 * (1 - Abs(Modulus((6 * h1), 2) - 1))
   
    If (((0 / 6) <= h0) And (h0 < (1 / 6))) Then
        r0 = c0: g0 = x0: b0 = 0
    ElseIf ((1 / 6) <= h0) And (h0 < (2 / 6)) Then
        r0 = x0: g0 = c0: b0 = 0
    ElseIf ((2 / 6) <= h0) And (h0 < (3 / 6)) Then
        r0 = 0: g0 = c0: b0 = x0
    ElseIf ((3 / 6) <= h0) And (h0 < (4 / 6)) Then
        r0 = 0: g0 = x0: b0 = c0
    ElseIf ((4 / 6) <= h0) And (h0 < (5 / 6)) Then
        r0 = x0: g0 = 0: b0 = c0
    ElseIf ((5 / 6) <= h0) And (h0 < (6 / 6)) Then
        r0 = c0: g0 = 0: b0 = x0
    End If
   
    If (((0 / 6) <= h1) And (h1 < (1 / 6))) Then
        r1 = c1: g1 = x1: b1 = 0
    ElseIf ((1 / 6) <= h1) And (h1 < (2 / 6)) Then
        r1 = x1: g1 = c1: b1 = 0
    ElseIf ((2 / 6) <= h1) And (h1 < (3 / 6)) Then
        r1 = 0: g1 = c1: b1 = x1
    ElseIf ((3 / 6) <= h1) And (h1 < (4 / 6)) Then
        r1 = 0: g1 = x1: b1 = c1
    ElseIf ((4 / 6) <= h1) And (h1 < (5 / 6)) Then
        r1 = x1: g1 = 0: b1 = c1
    ElseIf ((5 / 6) <= h1) And (h1 < (6 / 6)) Then
        r1 = c1: g1 = 0: b1 = x1
    End If
   
    m0 = Brightness - (0.3 * r0 + 0.59 * g0 + 0.11 * b0)
    m1 = Brightness - (c1 / 2)
   
    Select Case (1 - Palette) * (r0 + m0) + Palette * (r1 + m1)
        Case Is > 1
            HCBPtoR = 1
        Case Is < 0
            HCBPtoR = 0
        Case Else
            HCBPtoR = (1 - Palette) * (r0 + m0) + Palette * (r1 + m1)
    End Select

End Function

Function HCBPtoG(ByVal Hue As Double, ByVal Contrast As Double, ByVal Brightness As Double, ByVal Palette As Double)
    'Palette = 0.0  [All Chroma],  Palette = 1.0  [All Saturation]
    Dim r0, g0, b0, h0, c0, m0, x0 As Double 'Chroma Scale
    Dim r1, g1, b1, h1, c1, m1, x1 As Double 'Saturation Scale
   
    c0 = Contrast
    c1 = (1 - Abs(2 * Brightness - 1)) * Contrast
    h0 = Hue - Int(Hue)
    h1 = Hue - Int(Hue)
    x0 = c0 * (1 - Abs(Modulus((6 * h0), 2) - 1))
    x1 = c1 * (1 - Abs(Modulus((6 * h1), 2) - 1))
   
    If (((0 / 6) <= h0) And (h0 < (1 / 6))) Then
        r0 = c0: g0 = x0: b0 = 0
    ElseIf ((1 / 6) <= h0) And (h0 < (2 / 6)) Then
        r0 = x0: g0 = c0: b0 = 0
    ElseIf ((2 / 6) <= h0) And (h0 < (3 / 6)) Then
        r0 = 0: g0 = c0: b0 = x0
    ElseIf ((3 / 6) <= h0) And (h0 < (4 / 6)) Then
        r0 = 0: g0 = x0: b0 = c0
    ElseIf ((4 / 6) <= h0) And (h0 < (5 / 6)) Then
        r0 = x0: g0 = 0: b0 = c0
    ElseIf ((5 / 6) <= h0) And (h0 < (6 / 6)) Then
        r0 = c0: g0 = 0: b0 = x0
    End If
   
    If (((0 / 6) <= h1) And (h1 < (1 / 6))) Then
        r1 = c1: g1 = x1: b1 = 0
    ElseIf ((1 / 6) <= h1) And (h1 < (2 / 6)) Then
        r1 = x1: g1 = c1: b1 = 0
    ElseIf ((2 / 6) <= h1) And (h1 < (3 / 6)) Then
        r1 = 0: g1 = c1: b1 = x1
    ElseIf ((3 / 6) <= h1) And (h1 < (4 / 6)) Then
        r1 = 0: g1 = x1: b1 = c1
    ElseIf ((4 / 6) <= h1) And (h1 < (5 / 6)) Then
        r1 = x1: g1 = 0: b1 = c1
    ElseIf ((5 / 6) <= h1) And (h1 < (6 / 6)) Then
        r1 = c1: g1 = 0: b1 = x1
    End If
   
    m0 = Brightness - (0.3 * r0 + 0.59 * g0 + 0.11 * b0)
    m1 = Brightness - (c1 / 2)
   
    Select Case (1 - Palette) * (g0 + m0) + Palette * (g1 + m1)
        Case Is > 1
            HCBPtoG = 1
        Case Is < 0
            HCBPtoG = 0
        Case Else
            HCBPtoG = (1 - Palette) * (g0 + m0) + Palette * (g1 + m1)
    End Select

End Function

Function HCBPtoB(ByVal Hue As Double, ByVal Contrast As Double, ByVal Brightness As Double, ByVal Palette As Double)
    'Palette = 0.0  [All Chroma],  Palette = 1.0  [All Saturation]
    Dim r0, g0, b0, h0, c0, m0, x0 As Double 'Chroma Scale
    Dim r1, g1, b1, h1, c1, m1, x1 As Double 'Saturation Scale
   
    c0 = Contrast
    c1 = (1 - Abs(2 * Brightness - 1)) * Contrast
    h0 = Hue - Int(Hue)
    h1 = Hue - Int(Hue)
    x0 = c0 * (1 - Abs(Modulus((6 * h0), 2) - 1))
    x1 = c1 * (1 - Abs(Modulus((6 * h1), 2) - 1))
   
    If (((0 / 6) <= h0) And (h0 < (1 / 6))) Then
        r0 = c0: g0 = x0: b0 = 0
    ElseIf ((1 / 6) <= h0) And (h0 < (2 / 6)) Then
        r0 = x0: g0 = c0: b0 = 0
    ElseIf ((2 / 6) <= h0) And (h0 < (3 / 6)) Then
        r0 = 0: g0 = c0: b0 = x0
    ElseIf ((3 / 6) <= h0) And (h0 < (4 / 6)) Then
        r0 = 0: g0 = x0: b0 = c0
    ElseIf ((4 / 6) <= h0) And (h0 < (5 / 6)) Then
        r0 = x0: g0 = 0: b0 = c0
    ElseIf ((5 / 6) <= h0) And (h0 < (6 / 6)) Then
        r0 = c0: g0 = 0: b0 = x0
    End If
   
    If (((0 / 6) <= h1) And (h1 < (1 / 6))) Then
        r1 = c1: g1 = x1: b1 = 0
    ElseIf ((1 / 6) <= h1) And (h1 < (2 / 6)) Then
        r1 = x1: g1 = c1: b1 = 0
    ElseIf ((2 / 6) <= h1) And (h1 < (3 / 6)) Then
        r1 = 0: g1 = c1: b1 = x1
    ElseIf ((3 / 6) <= h1) And (h1 < (4 / 6)) Then
        r1 = 0: g1 = x1: b1 = c1
    ElseIf ((4 / 6) <= h1) And (h1 < (5 / 6)) Then
        r1 = x1: g1 = 0: b1 = c1
    ElseIf ((5 / 6) <= h1) And (h1 < (6 / 6)) Then
        r1 = c1: g1 = 0: b1 = x1
    End If
   
    m0 = Brightness - (0.3 * r0 + 0.59 * g0 + 0.11 * b0)
    m1 = Brightness - (c1 / 2)
   
    Select Case (1 - Palette) * (b0 + m0) + Palette * (b1 + m1)
        Case Is > 1
            HCBPtoB = 1
        Case Is < 0
            HCBPtoB = 0
        Case Else
            HCBPtoB = (1 - Palette) * (b0 + m0) + Palette * (b1 + m1)
    End Select

End Function

Function Modulus(ByVal a As Double, ByVal n As Integer) As Double
    Modulus = a - (n * Int(a / n))
End Function

Entry #2,522

Comments

This Blog entry currently has no comments.

Post a Comment

Please Log In

To use this feature you must be logged into your Lottery Post account.

Not a member yet?

If you don't yet have a Lottery Post account, it's simple and free to create one! Just tap the Register button and after a quick process you'll be part of our lottery community.

Register