vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Mails senden, abrufen und decodieren - ganz easy ;-)  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik:    |   VB-Versionen: VB606.10.13
Schnelle Umrechnung eines Farbbildes in ein Graustufenbild

Mit dieser Funktion lässt sich der Inhalt eines Farbbildes sehr schnell in ein Graufstufenbild umwandeln.

Autor:  ZardozBewertung:     [ Jetzt bewerten ]Views:  1.488 
ohne HomepageSystem:  WinXP, Win7, Win8, Win10, Win11 Beispielprojekt 

Manchmal ist es notwendig ein Farbbild in Graustufen umzuwandeln. Mit nachfolgendem Tipp erledigen Sie das auf schnelle Weise.

Erstellen Sie ein neues Projekt, platzieren auf die Form eine PictureBox und einen Command-Button. Laden Sie ein beliebiges Bild in die PictureBox und setzen die Eigenschaft AutoSize = True. Fügen Sie jetzt noch nachfolgenden Code ein und starten das Projekt.

Option Explicit
 
' Typen
Private Type POINTAPI
  x As Long
  y As Long
End Type
 
' Strukturen
Private Type COLORADJUSTMENT
  caSize As Integer
  caFlags As Integer
  caIlluminantIndex As Integer
  caRedGamma As Integer
  caGreenGamma As Integer
  caBlueGamma As Integer
  caReferenceBlack As Integer
  caReferenceWhite As Integer
  caContrast As Integer
  caBrightness As Integer
  caColorfulness As Integer
  caRedGreenTint As Integer
End Type
 
' Deklarationen
Private Declare Function SetStretchBltMode Lib "gdi32" ( _
  ByVal hdc As Long, _
  ByVal nStretchMode As Long) As Long
 
Private Declare Function StretchBlt Lib "gdi32" ( _
  ByVal hdc As Long, _
  ByVal x As Long, _
  ByVal y As Long, _
  ByVal nWidth As Long, _
  ByVal nHeight As Long, _
  ByVal hSrcDC As Long, _
  ByVal xSrc As Long, _
  ByVal ySrc As Long, _
  ByVal nSrcWidth As Long, _
  ByVal nSrcHeight As Long, _
  ByVal dwRop As Long) As Long
 
Private Declare Function SetColorAdjustment Lib "gdi32" ( _
  ByVal hdc As Long, _
  lpca As COLORADJUSTMENT) As Long
 
Private Declare Function GetColorAdjustment Lib "gdi32" ( _
  ByVal hdc As Long, _
  lpca As COLORADJUSTMENT) As Long
 
' Konstanten
Private Const HALFTONE = 4
' Bild in Graustufen umwandeln
Public Sub DoGrayScale(ByRef oPictureBox As PictureBox)
  Dim OldAdjust As COLORADJUSTMENT
  Dim NewAdjust As COLORADJUSTMENT
  Dim OldMode As Long
 
  With oPictureBox
    .ScaleMode = vbPixels ' Einheit Pixel
    .AutoRedraw = True    ' Beständiges Bild
 
    ' Farbeinstellungen auslesen
    Call GetColorAdjustment(.hdc, OldAdjust)
 
    ' Farbeinstellungen kopieren
    NewAdjust = OldAdjust
 
    ' Farbintensität auf Minimum setzen
    NewAdjust.caColorfulness = -100
 
    ' Neue Farbeinstellungen setzen
    Call SetColorAdjustment(.hdc, NewAdjust)
 
    ' StretchBltMode setzen
    OldMode = SetStretchBltMode(.hdc, HALFTONE)
 
    ' Bild mit neuen Farbeinstellungen zeichnen
    Call StretchBlt(.hdc, 0, 0, .ScaleWidth, .ScaleHeight, _
      .hdc, 0, 0, .ScaleWidth, .ScaleHeight, vbSrcCopy)
 
    ' Alter StretchBltMode zurück
    Call SetStretchBltMode(.hdc, OldMode)
 
    ' Alte Farbeinstellungen zurück
    Call SetColorAdjustment(.hdc, OldAdjust)
 
    ' Neuzeichnen erzwingen
    .Refresh
  End With
End Sub
Private Sub Command1_Click()
  DoGrayScale Picture1
End Sub