例子代码：颜色转换函数(RGB、HSB、CMYK、Lab)

enmity 2002-03-29 01:47:36

加精

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

...全文