vb@rchiv · Tipps & Tricks · Helligkeit, Kontrast ändern: Format8BPPIndexed

Rubrik: Grafik und Font · Grafische Effekte | VB-Versionen: VB2008, VB2010

17.10.11

Helligkeit, Kontrast ändern: Format8BPPIndexed Routinen zur Änderung von Helligkeit und Kontrast bei Bildern, die eine 256-Farben-Palette enthalten.
Autor: Manfred Bohn	Bewertung:	Views: 11.962
ohne Homepage	System: WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Manche Bitmaps, aber auch GIF- und TIF-Bilder, die nur 256 Farben umfassen, werden im Drawing.Imaging.Pixelformat "Format8BPPIndexed" als Bitmap-Objekt geladen.

Um Helligkeit oder Kontrast solcher Bilder zu ändern, müssen die Einträge in der Farbpalette modifiziert werden. Das erledigen die Routinen "ChangeBrightness8BPP" bzw. "ChangeContrast8BPP".

Im ersten Parameter ist ein Bitmap-Objekt zu übergeben, das ein entsprechend formatiertes Bild enthält. Parameterwerte (Faktoren) zwischen 0 und 1 senken Helligkeit bzw. Kontrast, Werte über 1 erhöhen sie. Zurückgegeben wird jeweils das modifizierte Bild.

Die Colorpalette eines Bildes kann nicht direkt manipuliert werden. Auch das direkte Erstellen einer Instanz dieser Klasse ist nicht möglich. Die Palette muss aus einer Bitmap extrahiert werden (vgl. "GetColorPalette"). Bei den anderen "indizierten" Bildformaten ist entsprechend vorzugehen.

Public Function ChangeBrightness8BPP(ByVal bmp As Bitmap, _
  ByVal BrightnessFactor As Double) As Bitmap
 
  Dim trafo(255) As Byte
  For i As Integer = 0 To 255
    trafo(i) = ToByte(i * BrightnessFactor)
  Next i
  Return TransformColors8BPP(bmp, trafo)
End Function

Public Function ChangeContrast8BPP(ByVal bmp As Bitmap, _
  ByVal ContrastFactor As Double) As Bitmap
 
  Dim trafo(255) As Byte
  For i As Integer = 0 To 255
    trafo(i) = ToByte((i - 127) * ContrastFactor + 127)
  Next i
  Return TransformColors8BPP(bmp, trafo)
End Function

Private Function TransformColors8BPP(ByVal bmp As Bitmap, _
  ByVal Trafo() As Byte) As Bitmap
 
  If bmp Is Nothing OrElse bmp.PixelFormat <> Imaging.PixelFormat.Format8bppIndexed Then
    Return Nothing
  End If
  If Trafo.Length <> 256 Then Return Nothing
 
  Dim ibmp As Bitmap = CType(bmp.Clone, Bitmap)
  Dim pal As Imaging.ColorPalette = GetColorPalette()
  With bmp.Palette
    For i As Integer = 0 To .Entries.Count - 1
      pal.Entries(i) = Color.FromArgb(Trafo(.Entries(i).R), _
      Trafo(.Entries(i).G), Trafo(.Entries(i).B))
    Next i
  End With
  ibmp.Palette = pal
  Return ibmp
End Function

Private Function GetColorPalette() As Imaging.ColorPalette
  Dim bmp As New Bitmap(1, 1, Imaging.PixelFormat.Format8bppIndexed)
  Dim palette As Imaging.ColorPalette = bmp.Palette
  bmp.Dispose()
  Return palette
End Function

Private Function ToByte(ByVal arg As Double) As Byte
  If arg < 0 Then Return 0
  If arg > 255 Then Return 255
  Return CByte(arg)
End Function