Option Explicit

Private R As Byte

Private G As Byte

Private B As Byte

Public Property Get cmyC() As Byte

  cmyC = 255 - R

End Property

Public Property Get cmyM() As Byte

  cmyM = 255 - G

End Property

Public Property Get cmykK() As Integer

  cmykK = Minimum(255 - R, 255 - G, 255 - B) / 2.55

End Property

Public Property Get cmykC() As Integer

  Dim MyR As Integer, Div As Integer

  MyR = R / 2.55

  Div = (100 - cmykK)

  If Div = 0 Then Div = 1

  cmykC = ((100 - MyR - cmykK) / Div) * 100

End Property

Public Property Get cmykM() As Integer

  Dim MyG As Integer, Div As Integer

  MyG = G / 2.55

  Div = (100 - cmykK)

  If Div = 0 Then Div = 1

  cmykM = ((100 - MyG - cmykK) / Div) * 100

End Property

Public Property Get cmykY() As Integer

  Dim MyB As Integer, Div As Integer

  MyB = B / 2.55

  Div = (100 - cmykK)

  If Div = 0 Then Div = 1

  cmykY = ((100 - MyB - cmykK) / Div) * 100

End Property

Public Property Get cmyY() As Byte

  cmyY = 255 - B

End Property

Public Property Get hlsH() As Integer

  Dim MyR As Single, MyG As Single, MyB As Single

  Dim Max As Single, Min As Single

  Dim Delta As Single, MyVal As Single

  MyR = R / 255: MyG = G / 255: MyB = B / 255

  Max = Maximum(MyR, MyG, MyB)

  Min = Minimum(MyR, MyG, MyB)

  If Max <> Min Then

    Delta = Max - Min

    Select Case Max

      Case MyR

        MyVal = (MyG - MyB) / Delta

      Case MyG

        MyVal = 2 + (MyB - MyR) / Delta

      Case MyB

        MyVal = 4 + (MyR - MyG) / Delta

    End Select

  End If

  MyVal = (MyVal + 1) * 60

  If MyVal < 0 Then MyVal = MyVal + 360

  hlsH = MyVal

  Debug.Print hlsH

End Property

Public Property Get hlsL() As Integer

  hlsL = ((Maximum(R, G, B) + Minimum(R, G, B)) / 2) / 2.55

End Property

Public Property Get hlsS() As Integer

  Dim MyR As Single, MyG As Single, MyB As Single

  Dim Max As Single, Min As Single, MyS As Single

  MyR = R / 255: MyG = G / 255: MyB = B / 255

  Max = Maximum(MyR, MyG, MyB)

  Min = Minimum(MyR, MyG, MyB)

  If Max <> Min Then

    If hlsL <= 50 Then

      MyS = (Max - Min) / (Max + Min)

    Else

      MyS = (Max - Min) / (2 - Max - Min)

    End If

    hlsS = MyS * 100

  End If

End Property

Private Function Minimum(ParamArray Vals())

  Dim n As Integer, MinVal

  MinVal = Vals(0)

  For n = 0 To UBound(Vals)

    If Vals(n) < MinVal Then MinVal = Vals(n)

  Next n

  Minimum = MinVal

End Function

Private Function Maximum(ParamArray Vals())

  Dim n As Integer, MaxVal

  For n = 0 To UBound(Vals)

    If Vals(n) > MaxVal Then MaxVal = Vals(n)

  Next n

  Maximum = MaxVal

End Function

Public Property Let rgbR(NewVal As Byte)

  R = NewVal

End Property

Public Property Get rgbR() As Byte

  rgbR = R

End Property

Public Property Get rgbG() As Byte

  rgbG = G

End Property

Public Property Get rgbB() As Byte

  rgbB = B

End Property

Public Property Get ycbcrY() As Byte

  ycbcrY = R * 0.2989 + G * 0.5866 + B * 0.1145

End Property

Public Property Get ycbcrCb() As Byte

  Dim MyCb As Integer

  MyCb = -0.1687 * R - 0.3313 * G + 0.5 * B + 128

  ycbcrCb = IIf(MyCb <= 255, MyCb, 255)

End Property

Public Property Get ycbcrCr() As Byte

  Dim MyCr As Integer

  MyCr = 0.5 * R - 0.4187 * G - 0.0813 * B + 128

  ycbcrCr = IIf(MyCr <= 255, MyCr, 255)

End Property

Public Property Let rgbG(NewVal As Byte)

  G = NewVal

End Property

Public Property Let rgbB(NewVal As Byte)

  B = NewVal

End Property

Public Sub SetCMY(C As Integer, M As Integer, Y As Integer)

  R = 255 - C

  G = 255 - M

  B = 255 - Y

End Sub

Public Sub SetHLS(H As Integer, L As Integer, S As Integer)

  Dim MyR As Single, MyG As Single, MyB As Single

  Dim MyH As Single, MyL As Single, MyS As Single

  Dim Min As Single, Max As Single, Delta As Single

  MyH = (H / 60) - 1: MyL = L / 100: MyS = S / 100

  If MyS = 0 Then

    MyR = MyL: MyG = MyL: MyB = MyL

  Else

    If MyL <= 0.5 Then

      Min = MyL * (1 - MyS)

    Else

      Min = MyL - MyS * (1 - MyL)

    End If

    Max = 2 * MyL - Min

    Delta = Max - Min

    Select Case MyH

      Case Is < 1

        MyR = Max

        If MyH < 0 Then

          MyG = Min

          MyB = MyG - MyH * Delta

        Else

          MyB = Min

          MyG = MyH * Delta + MyB

        End If

      Case Is < 3

        MyG = Max

        If MyH < 2 Then

          MyB = Min

          MyR = MyB - (MyH - 2) * Delta

        Else

          MyR = Min

          MyB = (MyH - 2) * Delta + MyR

        End If

      Case Else

        MyB = Max

        If MyH < 4 Then

          MyR = Min

          MyG = MyR - (MyH - 4) * Delta

        Else

          MyG = Min

          MyR = (MyH - 4) * Delta + MyG

        End If

    End Select

  End If

  R = MyR * 255: G = MyG * 255: B = MyB * 255

End Sub

Public Sub SetCMYK(C As Integer, M As Integer, Y As Integer, K As Integer)

  Dim MyC As Single, MyM As Single, MyY As Single, MyK As Single

  MyC = C / 100: MyM = M / 100: MyY = Y / 100: MyK = K / 100

  R = (1 - (MyC * (1 - MyK) + MyK)) * 255

  G = (1 - (MyM * (1 - MyK) + MyK)) * 255

  B = (1 - (MyY * (1 - MyK) + MyK)) * 255

End Sub

Public Sub SetYCbCr(Y As Integer, Cb As Integer, Cr As Integer)

  Dim MyR As Integer, MyG As Integer, MyB As Integer

  MyR = Y + 1.402 * (Cr - 128)

  MyG = Y - 0.34414 * (Cb - 128) - 0.71414 * (Cr - 128)

  MyB = Y + 1.772 * (Cb - 128)

  If MyR > 255 Then MyR = 255

  If MyG > 255 Then MyG = 255

  If MyB > 255 Then MyB = 255

  If MyR < 0 Then MyR = 0

  If MyG < 0 Then MyG = 0

  If MyB < 0 Then MyB = 0

  R = MyR

  G = MyG

  B = MyB

End Sub