|
Das technische System des Farbraums für Bildschirme beruht auf der Mischung dreier Grundfarben Rot, Grün und Blau. Der jeweilige Anteil einer dieser drei Farben wird als Byte-Wert (0 - 255) beschrieben. Die Ermittlung dieser drei Werte, um eine bestimmte Farbe zu erzeugen, ist jedoch nicht gerade sehr intuitiv. Wie Sie selbst wahrscheinlich wissen, artet es manchmal in eine Knobelei aus, einen bestimmten Farbton über Änderungen der drei Farbanteilswerte gezielt zu verändern.
Wesentlich intuitiver sind andere Modelle des Farbraums, die die Bestimmung einer Farbe und eines Farbtons beispielsweise über Schieberegler für den Anwender erheblich vereinfachen. So wird im Gegensatz dazu im so genannten HSV-Modell eine Farbe durch die Werte Hue (Farbton), Saturation (Sättigung) und Value (Helligkeit) festgelegt. Ein anderes derartiges Modell ist das HLS-Modell, bei dem auf sehr ähnliche Weise die Werte Hue (Farbton), Lightness (Helligkeit) und Saturation (Sättigung) die Farbmischung bestimmen.
Da jedoch weder Visual Basic noch die API-Funktionen des Windows-GDI mit diesem Farbmodell etwas anzufangen wissen, müssen die Werte des RGB-Farbmodells in die Werte dieser alternativen Farbmodelle umgerechnet werden.
Die beiden Module zu diesem Artikel (modRGBHSV.bas und modRGBHLS.bas) enthalten Prozeduren und Funktionen zur Umrechnung von Farbwerten, die als Long-Farbwerte und als bereits daraus separierte RGB-Werte (siehe "Von Bunt nach R, G und B" khwcolortorgb.htm) vorliegen können, in die Bestimmungswerte der Farbmodelle HSV und HLS. Natürlich fehlen auch nicht die entsprechenden Umkehrungen, die Ihnen aus Bestimmungswerten dieser Farbmodelle die entsprechenden RGB-Werte oder den direkt verwendbaren Long-Farbwert liefern.
Beim HLS-Farbmodell können Sie den Wertebereich der Bestimmungswerte (und damit die Feinheit der Auflösung) selbst festlegen. Sie können der global Variablen HLSmax im Modul modRGBHLS jeden beliebigen Wert zuweisen, der durch 6 teilbar sein sollte. Voreingestellt ist der Konstantwert 600, der beim ersten Aufruf einer der Funktionen des Moduls zunächst automatisch der Variablen HLSmax zugewiesen wird.
In beiden Modulen können als Ausgangswerte für Long-Farbwerte auch Systemfarbenkonstanten eingesetzt werden. Sie werden automatisch in echte RGB-Farben konvertiert (siehe "Systemfarben-Dolmetscher" khwoletranslatecolor.htm).
Der Code des Moduls modRGBHSV.bas:
Private Declare Function OleTranslateColor Lib "oleaut32.dll" _
(ByVal lOleColor As Long, ByVal lHPalette As Long, _
ByRef lColorRef As Long) As Long
Public Sub RGBColorToHSV(ByVal Color As Long, rH As Integer, _
rS As Integer, rV As Integer)
Dim nR As Integer
Dim nG As Integer
Dim nB As Integer
OleTranslateColor Color, 0&, Color
nR = Color Mod 256
Color = Color \ 256
nG = Color Mod 256
Color = Color \ 256
nB = Color Mod 256
RGBToHSV nR, nG, nB, rH, rS, rV
End Sub
Public Sub RGBtoHSV(ByVal R As Integer, ByVal G As Integer, _
ByVal B As Integer, rH As Integer, rS As Integer, rV As Integer)
Dim nR As Integer
Dim nRR As Double
Dim nG As Integer
Dim nGG As Double
Dim nB As Integer
Dim nBB As Double
Dim nMax As Double
Dim nMin As Double
Dim nH As Double
Dim nS As Double
Dim nV As Double
Dim nDelta As Double
Dim nRGBs(0 To 2) As Double
nRR = R / 255
nGG = G / 255
nBB = B / 255
nRGBs(0) = nRR
nRGBs(1) = nGG
nRGBs(2) = nBB
nMax = zMax(nRGBs)
nMin = zMin(nRGBs)
nV = nMax
If nMax <> 0 Then
nS = (nMax - nMin) / nMax
End If
If nS = 0 Then
nH = -1
Else
nDelta = nMax - nMin
Select Case nMax
Case nRR
nH = (nGG - nBB) / nDelta
Case nGG
nH = 2 + ((nBB - nRR) / nDelta)
Case Else
nH = 4 + ((nRR - nGG) / nDelta)
End Select
nH = nH * 60
If nH < 0 Then
nH = nH + 360
End If
End If
rH = nH
rS = nS * 100
rV = nV * 100
End Sub
Public Function HSVtoRGBColor(ByVal H As Integer, _
ByVal S As Integer, ByVal V As Integer) As Long
Dim nR As Integer
Dim nG As Integer
Dim nB As Integer
HSVtoRGB H, S, V, nR, nG, nB
HSVtoRGBColor = RGB(nR, nG, nB)
End Function
Public Sub HSVtoRGB(ByVal H As Integer, ByVal S As Integer, _
ByVal V As Integer, rR As Integer, rG As Integer, rB As Integer)
Dim nH As Double
Dim nS As Double
Dim nV As Double
Dim nRR As Double
Dim nGG As Double
Dim nBB As Double
Dim nI As Integer
Dim nF As Double
Dim nP As Double
Dim nQ As Double
Dim nT As Double
nS = S / 100
nV = V / 100
If nS = 0 Then
rR = nV * 255
rG = nV * 255
rB = nV * 255
Exit Sub
End If
H = H Mod 360
nH = H / 60
nI = Int(nH)
nF = nH - nI
nP = nV * (1 - nS)
nQ = nV * (1 - nS * nF)
nT = nV * (1 - nS * (1 - nF))
Select Case nI
Case 0
rR = nV * 255
rG = nT * 255
rB = nP * 255
Case 1
rR = nQ * 255
rG = nV * 255
rB = nP * 255
Case 2
rR = nP * 255
rG = nV * 255
rB = nT * 255
Case 3
rR = nP * 255
rG = nQ * 255
rB = nV * 255
Case 4
rR = nT * 255
rG = nP * 255
rB = nV * 255
Case Else
rR = nV * 255
rG = nP * 255
rB = nQ * 255
End Select
End Sub
Private Function zMax(Values() As Double) As Double
Dim nMax As Double
Dim i As Integer
For i = 0 To 2
If Values(i) > nMax Then
nMax = Values(i)
End If
Next 'i
zMax = nMax
End Function
Private Function zMin(Values() As Double) As Double
Dim nMin As Double
Dim i As Integer
nMin = Values(0)
For i = 1 To 2
If Values(i) < nMin Then
nMin = Values(i)
End If
Next 'i
zMin = nMin
End Function
Der Code des Moduls modRGBHLS.bas:
Private Declare Function OleTranslateColor Lib "oleaut32.dll" _
(ByVal lOleColor As Long, ByVal lHPalette As Long, _
ByRef lColorRef As Long) As Long
Private Const kRGBmax = 255&
Private Const kHLSmax = 600&
Public HLSmax As Long
Public Sub RGBColorToHLS(ByVal Color As Long, rH As Integer, _
rL As Integer, rS As Integer)
Dim nR As Integer
Dim nG As Integer
Dim nB As Integer
OleTranslateColor Color, 0&, Color
nR = Color Mod 256
Color = Color \ 256
nG = Color Mod 256
Color = Color \ 256
nB = Color Mod 256
RGBtoHLS nR, nG, nB, rH, rL, rS
End Sub
Public Sub RGBtoHLS(ByVal R As Integer, ByVal G As Integer, _
ByVal B As Integer, rH As Integer, rL As Integer, rS As Integer)
Dim nMax As Integer
Dim nMin As Integer
Dim nRdelta As Integer
Dim nGdelta As Integer
Dim nBdelta As Integer
Dim nRGBs(0 To 2) As Integer
Dim nHLSMax6 As Integer
Dim nMaxMinDelta As Integer
Dim nMaxMinDelta2 As Integer
If HLSmax = 0 Then
HLSmax = kHLSmax
End If
nRGBs(0) = R
nRGBs(1) = G
nRGBs(2) = B
nMax = zMax(nRGBs)
nMin = zMin(nRGBs)
rL = (((nMax + nMin) * HLSmax) + kRGBmax) / (2 * kRGBmax)
If nMax = nMin Then
rH = -1
Else
nMaxMinDelta = nMax - nMin
If rL <= HLSmax / 2 Then
rS = ((nMaxMinDelta * HLSmax) + ((nMax + nMin) / 2)) / _
(nMax + nMin)
Else
rS = ((nMaxMinDelta * HLSmax) + _
((2 * kRGBmax - nMax - nMin) / 2)) / _
(2 * kRGBmax - nMax - nMin)
End If
nHLSMax6 = HLSmax / 6
nMaxMinDelta2 = nMaxMinDelta / 2
nRdelta = (((nMax - R) * nHLSMax6) + nMaxMinDelta2) / nMaxMinDelta
nGdelta = (((nMax - G) * nHLSMax6) + nMaxMinDelta2) / nMaxMinDelta
nBdelta = (((nMax - B) * nHLSMax6) + nMaxMinDelta2) / nMaxMinDelta
Select Case nMax
Case R
rH = nBdelta - nGdelta
Case G
rH = (HLSmax / 3) + nRdelta - nBdelta
Case Else
rH = ((2 * HLSmax) / 3) + nGdelta - nRdelta
End Select
If rH < 0 Then
rH = rH + HLSmax
End If
If rH > HLSmax Then
rH = rH - HLSmax
End If
End If
End Sub
Public Function HLStoRGBColor(ByVal H As Integer, ByVal L As Integer, _
ByVal S As Integer) As Long
Dim nR As Integer
Dim nG As Integer
Dim nB As Integer
HLStoRGB H, L, S, nR, nG, nB
HLStoRGBColor = RGB(nR, nG, nB)
End Function
Public Sub HLStoRGB(ByVal H As Integer, ByVal L As Integer, _
ByVal S As Integer, rR As Integer, rG As Integer, rB As Integer)
Dim nH As Long
Dim nL As Long
Dim nS As Long
Dim nR As Long
Dim nG As Long
Dim nB As Long
Dim n1 As Long
Dim n2 As Long
Dim nHLSMax2 As Long
Dim nHLSMax3 As Long
If HLSmax = 0 Then
HLSmax = kHLSmax
End If
nH = H
nL = L
nS = S
If nS = 0 Then
nR = (nL * kRGBmax) / HLSmax
rR = nR
rG = nR
rB = nR
Else
nHLSMax2 = HLSmax / 2
nHLSMax3 = HLSmax / 3
If nL <= nHLSMax2 Then
n2 = (nL * (HLSmax + nS) + nHLSMax2) / HLSmax
Else
n2 = nL + nS - ((nL * nS) + nHLSMax2) / HLSmax
n1 = 2 * nL - n2
End If
rR = (zHueToRGB(n1, n2, nH + nHLSMax3) * kRGBmax + nHLSMax2) _
/ HLSmax
rG = (zHueToRGB(n1, n2, nH) * kRGBmax + nHLSMax2) / HLSmax
rB = (zHueToRGB(n1, n2, nH - nHLSMax3) * kRGBmax + nHLSMax2) _
/ HLSmax
End If
End Sub
Private Function zHueToRGB(ByVal n1 As Long, ByVal n2 As Long, _
Hue As Long) As Long
If Hue < 0 Then
Hue = Hue + HLSmax
End If
If Hue > HLSmax Then
Hue = Hue - HLSmax
End If
Select Case Hue
Case Is < HLSmax / 6
zHueToRGB = n1 + (((n2 - n1) * Hue + (HLSmax / 12)) _
/ (HLSmax / 6))
Case Is < HLSmax / 2
zHueToRGB = n2
Case Hue < (HLSmax * 2) / 3
zHueToRGB = n1 + (((n2 - n1) * (((HLSmax * 2) / 3) - Hue) _
+ (HLSmax / 12)) / (HLSmax / 6))
Case Else
zHueToRGB = n1
End Select
End Function
Private Function zMax(Values() As Integer) As Integer
Dim nMax As Integer
Dim i As Integer
For i = 0 To 2
If Values(i) > nMax Then
nMax = Values(i)
End If
Next 'i
zMax = nMax
End Function
Private Function zMin(Values() As Integer) As Integer
Dim nMin As Integer
Dim i As Integer
nMin = Values(0)
For i = 1 To 2
If Values(i) < nMin Then
nMin = Values(i)
End If
Next 'i
zMin = nMin
End Function
|