ABOUT Visual Basic Programmieren Programmierung Download Downloads Tips & Tricks Tipps & Tricks Know-How Praxis VB VBA Visual Basic for Applications VBS VBScript Scripting Windows ActiveX COM OLE API ComputerPC Microsoft Office Microsoft Office 97 Office 2000 Access Word Winword Excel Outlook Addins ASP Active Server Pages COMAddIns ActiveX-Controls OCX UserControl UserDocument Komponenten DLL EXE
Diese Seite wurde zuletzt aktualisiert am 27.11.2000

Diese Seite wurde zuletzt aktualisiert am 27.11.2000
Aktuell im ABOUT Visual Basic-MagazinGrundlagenwissen und TechnologienKnow How, Tipps und Tricks rund um Visual BasicActiveX-Komponenten, Controls, Klassen und mehr...AddIns für die Visual Basic-IDE und die VBA-IDEVBA-Programmierung in MS-Office und anderen AnwendungenScripting-Praxis für den Windows Scripting Host und das Scripting-ControlTools, Komponenten und Dienstleistungen des MarktesRessourcen für Programmierer (Bücher, Job-Börse)Dies&Das...

Themen und Stichwörter im ABOUT Visual Basic-Magazin
Code, Beispiele, Komponenten, Tools im Überblick, Shareware, Freeware
Ihre Service-Seite, Termine, Job-Börse
Melden Sie sich an, um in den vollen Genuss des ABOUT Visual Basic-Magazins zu kommen!
Informationen zum ABOUT Visual Basic-Magazin, Kontakt und Impressum

Zurück...

RGB in anderen Farbräumen

Zurück...


Anzeige

(-hg) mailto:hg_rgbhlshsv@aboutvb.de

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.

RGB-Farben lassen sich auch über die Farbmodelle HLS und HSV festlegen

RGB-Farben lassen sich auch über die Farbmodelle HLS und HSV festlegen

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

Beispiel-Projekt und Module modRGBHSV und modRGBHLS (rgbhlshsv.zip - ca. 8 KB)


Artikel
Zum Download-Bereich dieses Artikel
Mail an den Autor dieses Artikels

KnowHow
Zur KnowHow-Übersicht

KnowHow-Themen
Themen - Allgemeines
Themen - Entwicklungsumgebung (VB-IDE)
Themen - Forms
Themen - Steuerelemente (Controls)
Themen - Grafik
Themen - Dateien
Themen - UserControls
Themen - Einsteiger-Tipps
Themen - Wussten Sie...?

Übersicht nach Titeln in alphabetischer Reihenfolge
Übersicht nach Erscheinungsdatum

Schnellsuche



Zum Seitenanfang

Copyright © 1999 - 2017 Harald M. Genauck, ip-pro gmbh  /  Impressum

Zum Seitenanfang

Zurück...

Zurück...

Download Internet Explorer