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
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