vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Top-Preis! AP-Access-Tools-CD Volume 1  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: Grafik und Font · Grafische Effekte   |   VB-Versionen: VB200815.07.08
Erstellen einer Farbe aus den Angaben HBS

Die Routine 'FromAHBS' erstellt eine Farbe aus den Angaben Hue, Lightness (Brightness) und Saturation

Autor:   Manfred BohnBewertung:     [ Jetzt bewerten ]Views:  12.034 
ohne HomepageSystem:  Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

In den aktuellen VB-Versionen sind Farben im Modell A-R-G-B definiert (Alpha-Kanal, Rot-, Grün- und Blau-Anteil, jeweils von Werten im Bereich 0 bis 255 belegt).

Möchte man die Leuchtstärke ('Brightness' – weiter verbreitet ist allerdings die eindeutiger abgegrenzte Bezeichnung 'Lightness' - in MSDN-Beiträgen wird gelegentlich auch 'Value' verwendet) oder die Farbsättigung ('Saturation') eines Bildes ändern, benötigt man Zugriff auf die Komponenten des HBS- (bzw. HLS- / HSV-) Farbmodells.

Einen raschen Überblick über dieses Farb-Modell kann man sich verschaffen, wenn man in der MSDN einen Blick auf die entsprechend sortierten vordefinierten Farben wirft: 'Colors By Saturation', 'Colors by Ligthness', 'Colors by Hue'.

Instanzen der Color-Klasse verfügen zwar über Methoden, die die Komponenten einer Farbe om HBS-Modell liefern ('GetHue', 'GetBrightness', 'GetSaturation') aber eine Methode zum Erstellen einer Farbe aus den Werten dieser Komponenten fehlt.

Die Methoden der Color-Klasse liefern die Farbwerte für Sättigung und Leuchtstärke der zugewiesenen Farbe im Skalen-Bereich 0 bis 1. Die Färbung ('Hue') wird als Winkelangabe in Grad (0-360) ausgegeben.

Die Erweiterungsmethode 'FromAHBS' (für die Klasse 'Color') erstellt eine Farbe aus dem Wert des Alpha-Kanals (0-255) und Angaben zu den H-B-S-Komponenten. Damit lassen sich Leuchtstärke und Sättigung eines Bildes modifizieren.

Die Routine muss mit dem Schlüsselwort 'Public' in einem Modul vereinbart sein. (Es handelt sich um eine für die Verwendung in VB2008 ergänzte und angepasste VB6-Routine, die ich vor einiger Zeit aus dem Internet gefischt habe. In dieser Form arbeitet sie kompatibel zu Parameter-Werten, die an Color-Methoden im ARGB-Modell übergeben werden.)

Die Änderung von Leuchtstärke und Farbsättigung empfiehlt sich nur bei qualitativ guten Bildern und bei Bildern die nicht zu stark (z.B. JPEG-) komprimiert worden sind.
Es kann sonst zu einem deutlichen Hervortreten der Bildmängel kommen.

Größere Änderungen von Sättigung bzw. Leuchtstärke führen zu einem Verlust an Informationen. (Z.B.: Bei starker Absenkung der Sättigung entsteht ein Bild in Grautönen. Bei starker Erhöhung der Leuchtstärke strahlt das Bild in weißer Farbe.)

Die Erweiterungsmethode 'Adjust_LS' (für die Bitmap-Klasse) erwartet das zu ändernde Bild als Bitmap-Instanz, sowie die Angaben zur Modifikation von 'Saturation' und 'Brightness'. Zurückgegeben wird entweder das geänderte Bild oder 'Nothing'.

Die Routine 'Test_FromAHBS' zeigt dass und wie die Routine 'FromAHBS' mit den anderen Color-Methoden korrespondiert.

Code-Schnippsel (ohne Verwendung von 'Adjust_LS'):
Die Leuchtstärke eines Bildes, das in eine Instanz des Bitmap-Objekts geladen ist, wird um 0,2 erhöht, die Sättigung um 0,1 gesenkt. Die pixelbezogene Bearbeitung eines umfangreichen Bildes ist allerdings langsam!

' Bild aus Datei laden
Dim bmp As New Drawing.Bitmap("Bilddatei angeben")
 
' Variable für Farbe, Leuchtstärke und Sättigung
Dim cl As Drawing.Color, l, s As Single
 
' Schleifen über Bild-Pixel
For i As Integer = 0 To bmp.Width - 1
  For k As Integer = 0 To bmp.Height - 1
    ' Pixel-Farbe abfragen
    cl = bmp.GetPixel(i, k)
    ' Leuchtstärke und Sättigung kontrolliert ändern 
    l = Math.Min(cl.GetBrightness + CSng(0.2), 1)
    s = Math.Max(cl.GetSaturation - CSng(0.1), 0)
    ' neue Farbe erstellen
    cl.FromAHBS(cl.A, cl.GetHue, l, s)
    ' Farbe zuweisen
    bmp.SetPixel(i, k, cl)
  Next k
Next i

Code für das Modul mit der FromHBS-Erweiterung:

Module Module1
  ''' <summary>
  ''' Erstellt eine Farbe aus Alpha, Farbwinkel, 
  ''' Leuchtstärke und Sättigung
  ''' </summary>
  ''' <param name="col">Die zu erstellende Farbe</param>
  ''' <param name="alpha">Alpha-Wert 0 - 255</param>
  ''' <param name="hue">Farbwinkel 0 - 360</param>
  ''' <param name="Brightness">Leuchtstärke 0 - 1</param>
  ''' <param name="saturation">Sättigung 0 - 1</param>
  ''' <remarks></remarks>
  <System.Runtime.CompilerServices.Extension()> _
  Public Sub FromAHBS(ByRef col As Drawing.Color, _
    ByVal Alpha As Integer, _
    ByVal Hue As Single, _
    ByVal Brightness As Single, _
    ByVal Saturation As Single)
 
    Dim sR, sG, sB As Single     ' Red-Green-Blue
    Dim min, max, dif As Single  ' Hilfswerte
 
    ' Rückgabe initialisieren
    col = Color.Black
 
    ' Parameter checken
    If Hue < 0 Or Hue > 360 Or _
      Brightness < 0 Or Brightness > 1 Or _
      Saturation < 0 Or Saturation > 1 Then
      Throw New ArgumentException
    End If
 
    ' interne Skalierung des Farbwinkels 
    If Hue > 300 Then Hue -= 360
    Hue /= 60
 
    If Saturation = 0 Then
      ' Grauwert entsteht bei 0-Sättigung
      sR = Brightness : sG = Brightness : sB = Brightness
    Else
      If Brightness > 0.5 Then
        min = Brightness - Saturation * (1 - Brightness)
      Else
        min = Brightness * (1 - Saturation)
      End If
      max = 2 * Brightness - min
      dif = max - min
      Select Case Hue
        Case Is < 0
          sR = max : sG = min
          sB = min - (Hue * dif)
        Case Is < 1
          sR = max : sB = min
          sG = min + (Hue * dif)
        Case Is < 2
          sG = max : sB = min
          sR = min + (2 - Hue) * dif
        Case Is < 3
          sG = max : sR = min
          sB = min + (Hue - 2) * dif
        Case Is < 4
          sB = max : sR = min
          sG = min + (4 - Hue) * dif
        Case Else
          sB = max : sG = min
          sR = min + (Hue - 4) * dif
      End Select
    End If
 
    ' VB-Farbe erstellen
    Dim red As Integer = _
      CByte(Math.Max(Math.Min(sR * 255, 255), 0))
    Dim green As Integer = CByte(Math.Min(sG * 255, 255))
    Dim blue As Integer = CByte(Math.Min(sB * 255, 255))
 
    ' Farbe zurückgeben
    col = Color.FromArgb(Alpha, red, green, blue)
  End Sub
  ''' <summary>
  ''' Änderung von Farbsättigung und Leuchtstärke eines Bildes
  ''' </summary>
  ''' <param name="bmp_in">Bitmap: das zu ändernde Bild</param>
  ''' <param name="adj_saturation">Änderung der Sättigung 
  ''' (-0.5 bis +0.5)</param>
  ''' <param name="adj_brightness">Änderung der Leuchtstärke 
  ''' (-0.5 bis +0.5)</param>
  ''' <returns>Das geänderte Bild (oder Nothing)</returns>
  Public Function Adjust_LS(ByVal bmp_in As Drawing.Bitmap, _
    ByVal adj_saturation As Single, _
    ByVal adj_brightness As Single) As Drawing.Bitmap
 
    Try
      If IsNothing(bmp_in) Then Return Nothing
 
      ' Rückgabebild initialisieren
      Dim bmp_out As Drawing.Bitmap = _
        CType(bmp_in.Clone, Drawing.Bitmap)
 
      ' Variable für Farbe, Leuchtkraft und Sättigung
      Dim cl As Drawing.Color, l, s As Single
      ' Schleifen über Bild-Pixel
      For i As Integer = 0 To bmp_out.Width - 1
        For k As Integer = 0 To bmp_out.Height - 1
          ' Pixel-Farbe abfragen
          cl = bmp_out.GetPixel(i, k)
 
          ' Leuchtstärke und Sättigung kontrolliert ändern 
          l = Adjust_LS_Param(cl.GetBrightness, adj_brightness)
          s = Adjust_LS_Param(cl.GetSaturation, adj_saturation)
 
          ' neue Farbe erstellen
          cl.FromAHBS(cl.A, cl.GetHue, l, s)
 
          ' Farbe zuweisen
          bmp_out.SetPixel(i, k, cl)
        Next k
      Next i
      ' Bild zurückgeben
      Return bmp_out
    Catch
      Return Nothing
    End Try
  End Function
  Private Function Adjust_LS_Param(ByVal v As Single, _
    ByVal p As Single) As Single
 
    ' Hilfsfunktion: Der L- oder S-Parameter 'v'
    ' wird kontrolliert modifiziert um den Wert 'p'
 
    If p > 0.5 Then p = 0.5
    If p < -0.5 Then p = -0.5
    If Math.Abs(v) > 1 Then Return 0
 
    v += p
    If p >= 0 Then
      Return Math.Min(v, 1)
    Else
      Return Math.Max(v, 0)
    End If
  End Function
End Module

Test-Funktion

Public Sub Test_FromAHBS()
 
  ' Test der Routine 'FromAHBS'
  ' Kompatibilität der H-B-S-Werte mit den R-G-B-Werten?
 
  Dim h, b, s As Single
  Dim col1 As New Drawing.Color
  Dim col2 As New Drawing.Color
  Dim alpha As Integer = 128 ' Alpha konstant
 
  ' Alle RGB-Farben durcheilen
  For red As Integer = 0 To 255
    For green As Integer = 0 To 255
      For blue As Integer = 0 To 255
        ' aus den R-G-B-Werten eine Farbe erstellen
        col1 = Color.FromArgb(alpha, red, green, blue)
 
        ' H-B-S der Farbe abfragen
        With col1
          h = .GetHue
          b = .GetBrightness
          s = .GetSaturation
        End With
 
        ' Aus den H-B-S-Werten eine Farbe erstellen
        col2.FromAHBS(alpha, h, b, s)
 
        ' Vergleich der RGB-Werte 
        ' der beiden Instanzen der Colorklasse
        If col1.R <> col2.R Then Stop ' Autsch
        If col1.G <> col2.G Then Stop ' Autsch
        If col1.B <> col2.B Then Stop ' Aua 
      Next blue
    Next green
  Next red
 
  MsgBox("Alles OK")
End Sub

Dieser Tipp wurde bereits 12.034 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel