vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
sevDataGrid - Gönnen Sie Ihrem SQL-Kommando diesen krönenden Abschluß!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2018
 
zurück
Rubrik: Grafik und Font · Grafische Effekte   |   VB-Versionen: VB2008, VB201017.10.11
Helligkeit, Kontrast ändern: Format8BPPIndexed

Routinen zur Änderung von Helligkeit und Kontrast bei Bildern, die eine 256-Farben-Palette enthalten.

Autor:   Manfred BohnBewertung:     [ Jetzt bewerten ]Views:  8.405 
ohne HomepageSystem:  WinXP, Vista, Win7, Win8, Win10 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

Dieser Tipp wurde bereits 8.405 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-2018 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