Public TypeHSB
Hue As Integer
Saturation As Integer
Brightness As Integer
End Type
Public Type HSL
Hue As Integer
Saturation As Integer
Luminance As Integer
End Type
Public TypeRGB
Red As Integer
Green As Integer
Bue As Integer
End Type
' 转换RGB到HSB
Public FunctionRGB2HSB(ByVal R As Integer, ByVal G As Integer, ByVal B As Integer) AsHSB
Dim nH As Single, nS As Single, nV As Single
Dim nR As Single, nG As Single, nB As Single
Dim ndelR As Single, ndelG As Single, ndelB As Single
Dim nmax As Single, nmin As Single, ndelMax As Single
nR = R / 255
nG = G / 255
nB = B / 255
nmax = Max(Max(nR, nG), nB)
nmin = Min(Min(nR, nG), nB)
ndelMax = nmax - nmin
nV = nmax
If (ndelMax = 0) Then
nH = 0
nS = 0
Else
nS = ndelMax / nmax
ndelR = (((nmax - nR) / 6) + (ndelMax / 2)) / ndelMax
ndelG = (((nmax - nG) / 6) + (ndelMax / 2)) / ndelMax
ndelB = (((nmax - nB) / 6) + (ndelMax / 2)) / ndelMax
If (nR = nmax) Then
nH = ndelB - ndelG
ElseIf (nG = nmax) Then
nH = (1 / 3) + ndelR - ndelB
ElseIf (nB = nmax) Then
nH = (2 / 3) + ndelG - ndelR
End If
If (nH < 0) Then nH = nH + 1
If (nH > 1) Then nH = nH - 1
End If
RGB2HSB.Hue = nH * 360
RGB2HSB.Saturation = nS * 100
RGB2HSB.Brightness = nV * 100
End Function
' 转换HSB到RGB
Public FunctionHSB2RGB(ByVal H As Integer, ByVal S As Integer, ByVal B As Integer) AsRGB
Dim nH As Single, nS As Single, nV As Single
Dim nR As Single, nG As Single, nB As Single
Dim hi As Single, f As Single, p As Single, q As Single, t As Single
nH = H / 360
nS = S / 100
nV = B / 100
If (S = 0) Then
nR = nV * 255
nG = nV * 255
nB = nV * 255
Else
hi = nH * 6
If (hi = 6) Then hi = 0
f = Int(hi)
p = nV * (1 - nS)
q = nV * (1 - nS * (hi - f))
t = nV * (1 - nS * (1 - (hi - f)))
If (f = 0) Then
nR = nV
nG = t
nB = p
ElseIf (f = 1) Then
nR = q
nG = nV
nB = p
ElseIf (f = 2) Then
nR = p
nG = nV
nB = t
ElseIf (f = 3) Then
nR = p
nG = q
nB = nV
ElseIf (f = 4) Then
nR = t
nG = p
nB = nV
Else
nR = nV
nG = p
nB = q
End If
End If
HSB2RGB.Red = nR * 255
HSB2RGB.Green = nG * 255
HSB2RGB.Bue = nB * 255
End Function
' 转换RGB到HSL
Public FunctionRGB2HSL(ByVal R As Integer, ByVal G As Integer, ByVal B As Integer) As HSL
Dim nH As Single, nS As Single, nL As Single
Dim nR As Single, nG As Single, nB As Single
Dim ndelR As Single, ndelG As Single, ndelB As Single
Dim nmax As Single, nmin As Single, ndelMax As Single
nR = (R / 255)
nG = (G / 255)
nB = (B / 255)
nmax = Max(Max(nR, nG), nB)
nmin = Min(Min(nR, nG), nB)
ndelMax = nmax - nmin
nL = (nmax + nmin) / 2
If (ndelMax = 0) Then
nH = 0
nS = 0
Else
If (nL < 0.5) Then
nS = ndelMax / (nmax + nmin)
Else
nS = ndelMax / (2 - nmax - nmin)
End If
ndelR = (((nmax - nR) / 6) + (ndelMax / 2)) / ndelMax
ndelG = (((nmax - nG) / 6) + (ndelMax / 2)) / ndelMax
ndelB = (((nmax - nB) / 6) + (ndelMax / 2)) / ndelMax
If (nR = nmax) Then
nH = ndelB - ndelG
ElseIf (nG = nmax) Then
nH = (1 / 3) + ndelR - ndelB
ElseIf (nB = nmax) Then
nH = (2 / 3) + ndelG - ndelR
End If
If (nH < 0) Then nH = nH + 1
If (nH > 1) Then nH = nH - 1
End If
RGB2HSL.Hue = nH * 240
RGB2HSL.Saturation = nS * 240
RGB2HSL.Luminance = nL * 240
End Function
' 转换HSL到RGB
Public Function HSL2RGB(ByVal H As Integer, ByVal S As Integer, ByVal L As Integer) AsRGB
Dim nH As Single, nS As Single, nL As Single
Dim nR As Single, nG As Single, nB As Single
Dim p1 As Single, p2 As Single
nH = H / 240
nS = S / 240
nL = L / 240
If (nS = 0) Then
nR = nL * 255
nG = nL * 255
nB = nL * 255
Else
If (nL < 0.5) Then
p2 = Round(nL * (1 + nS), 2)
Else
p2 = Round((nL + nS) - (nS * nL), 2)
End If
p1 = Round(2 * nL - p2, 2)
nR = 255 * Hue2RGB(p1, p2, nH + (1 / 3))
nG = 255 * Hue2RGB(p1, p2, nH)
nB = 255 * Hue2RGB(p1, p2, nH - (1 / 3))
End If
HSL2RGB.Red = nR
HSL2RGB.Green = nG
HSL2RGB.Bue = nB
End Function
Private Function Hue2RGB(ByVal p1 As Single, ByVal p2 As Single, ByVal Hue As Single) As Single
If (Hue < 0) Then Hue = Hue + 1
If (Hue > 1) Then Hue = Hue - 1
If ((6 * Hue) < 1) Then
Hue2RGB= (p1 + (p2 - p1) * 6 * Hue)
ElseIf ((2 * Hue) < 1) Then
Hue2RGB= p2
ElseIf ((3 * Hue) < 2) Then
Hue2RGB= p1 + (p2 - p1) * ((2 / 3) - Hue) * 6
Else
Hue2RGB= p1
End If
End Function