Rubrik: | VB-Versionen: VB6 | 06.10.13 |
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