Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0674: Helligkeit und Kontrast einer Grafik per GDI+ ändern

VB 5/6-Tipp 0674: Helligkeit und Kontrast einer Grafik per GDI+ ändern

 von Frank Schüler

Schwierigkeitsgrad:

Verwendete API-Aufrufe: GdipCreateFromHDC, GdipCreateImageAttributes, GdipDeleteGraphics, GdipDisposeImage, GdipDisposeImageAttributes, GdipDrawImageRectRect, GdipGetImageDimension, GdipLoadImageFromFile, GdipSetImageAttributesColorMatrix, GdiplusShutdown, GdiplusStartup

Download: Download des Beispielprojektes [5,52 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'---- Anfang Projektdatei GDIPlusBrightnessContrast.vbp  ----
' Die Komponente 'Microsoft Common Dialog Control 6.0 (SP3) (comdlg32.ocx)' wird benötigt.

'--- Anfang Formular "frmGDIPlusBrightnessContrast" alias frmGDIPlusBrightnessContrast.frm  ---
' Steuerelement: Horizontale Scrollbar "hscContrast"
' Steuerelement: Horizontale Scrollbar "hscBrightness"
' Steuerelement: Standarddialog-Steuerelement "cdLoadPicture"
' Steuerelement: Schaltfläche "cmdLoadPicture"
' Steuerelement: Bildfeld-Steuerelement "picView"
' Steuerelement: Beschriftungsfeld "lblInfo" (Index von 0 bis 1)

Option Explicit

' ----==== GDI+ Konstanten ====----
Private Const GdiPlusVersion As Long = 1&

' ----==== GDI+ Typen ====----
Private Type COLORMATRIX
    m(0 To 4, 0 To 4) As Single
End Type

Private Type GDIPlusStartupInput
    GdiPlusVersion As Long
    DebugEventCallback As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs As Long
End Type

Private Type GdiplusStartupOutput
    NotificationHook As Long
    NotificationUnhook As Long
End Type

' ----==== GDI+ Enumerationen ====----
Private Enum ColorAdjustType
    ColorAdjustTypeDefault = 0
    ColorAdjustTypeBitmap = 1
    ColorAdjustTypeBrush = 2
    ColorAdjustTypePen = 3
    ColorAdjustTypeText = 4
    ColorAdjustTypeCount = 5
    ColorAdjustTypeAny = 6
End Enum

Private Enum ColorMatrixFlags
    ColorMatrixFlagsDefault = 0
    ColorMatrixFlagsSkipGrays = 1
    ColorMatrixFlagsAltGray = 2
End Enum

' GDI+ Status
Private Enum Status
    OK = 0
    GenericError = 1
    InvalidParameter = 2
    OutOfMemory = 3
    ObjectBusy = 4
    InsufficientBuffer = 5
    NotImplemented = 6
    Win32Error = 7
    WrongState = 8
    Aborted = 9
    FileNotFound = 10
    ValueOverflow = 11
    AccessDenied = 12
    UnknownImageFormat = 13
    FontFamilyNotFound = 14
    FontStyleNotFound = 15
    NotTrueTypeFont = 16
    UnsupportedGdiplusVersion = 17
    GdiplusNotInitialized = 18
    PropertyNotFound = 19
    PropertyNotSupported = 20
    ProfileNotFound = 21
End Enum

Public Enum Unit
    UnitWorld = 0
    UnitDisplay = 1
    UnitPixel = 2
    UnitPoint = 3
    UnitInch = 4
    UnitDocument = 5
    UnitMillimeter = 6
End Enum

' ----==== GDI+ API Deklarationen ====----
Private Declare Function GdipCreateFromHDC Lib "gdiplus" _
    (ByVal hdc As Long, ByRef graphics As Long) As Status

Private Declare Function GdipCreateImageAttributes Lib "gdiplus" _
    (ByRef imageattr As Long) As Status

Private Declare Function GdipDeleteGraphics Lib "gdiplus" _
    (ByVal graphics As Long) As Status

Private Declare Function GdipDisposeImage Lib "gdiplus" _
    (ByVal image As Long) As Status

Private Declare Function GdipDisposeImageAttributes Lib "gdiplus" _
    (ByVal imageattr As Long) As Status

Private Declare Function GdipDrawImageRectRect Lib "gdiplus" _
    (ByVal graphics As Long, ByVal image As Long, _
    ByVal dstx As Single, ByVal dsty As Single, _
    ByVal dstwidth As Single, ByVal dstheight As Single, _
    ByVal srcx As Single, ByVal srcy As Single, _
    ByVal srcwidth As Single, ByVal srcheight As Single, _
    ByVal srcUnit As Unit, ByVal imageAttributes As Long, _
    ByVal callback As Long, ByVal callbackData As Long) As Status

Private Declare Function GdipGetImageDimension Lib "gdiplus" _
    (ByVal image As Long, ByRef sngWidth As Single, _
    ByRef sngHeight As Single) As Status

Private Declare Function GdipLoadImageFromFile Lib "gdiplus" _
    (ByVal FileName As Long, ByRef image As Long) As Status

Private Declare Function GdiplusShutdown Lib "gdiplus" _
    (ByVal token As Long) As Status

Private Declare Function GdiplusStartup Lib "gdiplus" _
    (ByRef token As Long, ByRef lpInput As GDIPlusStartupInput, _
    ByRef lpOutput As GdiplusStartupOutput) As Status

Private Declare Function GdipSetImageAttributesColorMatrix _
    Lib "gdiplus" (ByVal imageattr As Long, _
    ByVal ColorAdjust As ColorAdjustType, _
    ByVal EnableFlag As Boolean, _
    ByRef MatrixColor As COLORMATRIX, _
    ByRef MatrixGray As COLORMATRIX, _
    ByVal Flags As ColorMatrixFlags) As Status

' ----==== Variablen ====----
Private GdipToken As Long
Private GdipInitialized As Boolean
Private lBitmap As Long

'------------------------------------------------------
' Funktion     : Execute
' Beschreibung : Gibt im Fehlerfall die entsprechende
'                GDI+ Fehlermeldung aus
' Übergabewert : GDI+ Status
' Rückgabewert : GDI+ Status
'------------------------------------------------------
Private Function Execute(ByVal eReturn As Status) As Status
    Dim eCurErr As Status
    If eReturn = OK Then
        eCurErr = OK
    Else
        eCurErr = eReturn
        MsgBox GdiErrorString(eReturn) & " GDI+ Error:" & _
        eReturn, vbOKOnly, "GDI Error"
    End If
    Execute = eCurErr
End Function

'------------------------------------------------------
' Funktion     : GdiErrorString
' Beschreibung : Umwandlung der GDI+ Statuscodes in Stringcodes
' Übergabewert : GDI+ Status
' Rückgabewert : Fehlercode als String
'------------------------------------------------------
Private Function GdiErrorString(ByVal eError As Status) As String
    Dim s As String
    
    Select Case eError
    Case GenericError:              s = "Generic Error."
    Case InvalidParameter:          s = "Invalid Parameter."
    Case OutOfMemory:               s = "Out Of Memory."
    Case ObjectBusy:                s = "Object Busy."
    Case InsufficientBuffer:        s = "Insufficient Buffer."
    Case NotImplemented:            s = "Not Implemented."
    Case Win32Error:                s = "Win32 Error."
    Case WrongState:                s = "Wrong State."
    Case Aborted:                   s = "Aborted."
    Case FileNotFound:              s = "File Not Found."
    Case ValueOverflow:             s = "Value Overflow."
    Case AccessDenied:              s = "Access Denied."
    Case UnknownImageFormat:        s = "Unknown Image Format."
    Case FontFamilyNotFound:        s = "FontFamily Not Found."
    Case FontStyleNotFound:         s = "FontStyle Not Found."
    Case NotTrueTypeFont:           s = "Not TrueType Font."
    Case UnsupportedGdiplusVersion: s = "Unsupported Gdiplus Version."
    Case GdiplusNotInitialized:     s = "Gdiplus Not Initialized."
    Case PropertyNotFound:          s = "Property Not Found."
    Case PropertyNotSupported:      s = "Property Not Supported."
    Case Else:                      s = "Unknown GDI+ Error."
    End Select
    
    GdiErrorString = s
End Function

'------------------------------------------------------
' Funktion     : LoadPicturePlus
' Beschreibung : Laden einer Bildatei und
'                GDI+ Bitmapobjekt erzeugen
' Übergabewert : sFileName = Pfad\Dateiname.ext
'                lOutBitmap = GDI+ Bitmapobjekt
' Rückgabewert : GDI+ Status
'------------------------------------------------------
Private Function LoadPicturePlus(ByVal sFileName As String, _
    ByRef lOutBitmap As Long) As Status
    
    ' GDI+ Bitmapobjekt von Datei erstellen -> lOutBitmap
    LoadPicturePlus = _
    Execute(GdipLoadImageFromFile(StrPtr(sFileName), lOutBitmap))
End Function

'------------------------------------------------------
' Funktion     : SetBrightnessContrast
' Beschreibung : Helligkeit und Kontrast ändern
' Übergabewert : lInBitmap = GDI+ Bitmapobjekt
'                sBrightness = Helligkeit (-1 bis 1, 0 = Normal)
'                sContrast = Kontrast (-1 bis 1, 0 = Normal)
' Rückgabewert : True/False
'------------------------------------------------------
Private Function SetBrightnessContrast(ByVal lInBitmap As Long, _
    ByVal oPicBox As PictureBox, _
    Optional ByVal sBrightness As Single = 0, _
    Optional ByVal sContrast As Single = 0) As Boolean
    
    Dim lGraphics As Long
    Dim lAttribute As Long
    Dim sWidth As Single
    Dim sHeight As Single
    Dim lOldScaleMode As Long
    Dim bOldAutoRedraw As Boolean
    Dim tMatrixColor As COLORMATRIX
    Dim tMatrixGray As COLORMATRIX
    Dim sDiff As Single
    
    Dim bRet As Boolean
    
    bRet = False
    
    ' Parameter zwischenspeichern und setzen
    With oPicBox
        lOldScaleMode = .ScaleMode
        bOldAutoRedraw = .AutoRedraw
        .ScaleMode = vbPixels
        .AutoRedraw = True
        .Cls
    End With
    
    ' Min/Max
    If sBrightness < -1 Then sBrightness = -1
    If sBrightness > 1 Then sBrightness = 1
    If sContrast < -1 Then sContrast = -1
    If sContrast > 1 Then sContrast = 1
    
    ' Differenz berechnen zur korrekten Darstellung
    ' beim verändern des Kontrastwertes
    sDiff = (sBrightness / 2) - (sContrast / 2)
    
    ' ColorMatrix Parameter setzen
    With tMatrixColor
        .m(0, 0) = 1 + sContrast: .m(0, 4) = sBrightness + sDiff
        .m(1, 1) = 1 + sContrast: .m(1, 4) = sBrightness + sDiff
        .m(2, 2) = 1 + sContrast: .m(2, 4) = sBrightness + sDiff
        .m(3, 3) = 1
        .m(4, 4) = 1
    End With
    
    ' Dimensionen von lInBitmap ermitteln
    If Execute(GdipGetImageDimension(lInBitmap, _
    sWidth, sHeight)) = OK Then
        
        ' Graphicsobjekt vom HDC erstellen -> lGraphics
        If Execute(GdipCreateFromHDC(oPicBox.hdc, _
        lGraphics)) = OK Then
            
            ' ImageAttributeobjekt erstellen -> lAttribute
            If Execute(GdipCreateImageAttributes(lAttribute)) _
            = OK Then
                
                ' ColorMatrix an ImageAttributeobjekt übergeben
                If Execute(GdipSetImageAttributesColorMatrix( _
                lAttribute, ColorAdjustTypeDefault, True, _
                tMatrixColor, tMatrixGray, _
                ColorMatrixFlagsDefault)) = OK Then
                    
                    ' zeichnet lInBitmap in das Graphicsobjekt
                    ' lGraphics mit dem entsprechenden ImageAttribute
                    ' und Dimensionen
                    If Execute(GdipDrawImageRectRect(lGraphics, _
                    lInBitmap, 0, 0, sWidth, sHeight, _
                    0, 0, sWidth, sHeight, UnitPixel, _
                    lAttribute, 0, 0)) = OK Then
                        
                        bRet = True
                        
                    End If
                End If
                
                ' lAttribute löschen
                Call Execute(GdipDisposeImageAttributes(lAttribute))
            End If
            
            ' lGraphics löschen
            Call Execute(GdipDeleteGraphics(lGraphics))
        End If
    End If
    
    ' zwichengespeicherte Werte zurücksetzen
    With oPicBox
        .ScaleMode = lOldScaleMode
        .AutoRedraw = bOldAutoRedraw
        .Refresh
    End With
    
    ' Rückgabewert übergeben
    SetBrightnessContrast = bRet
End Function

'------------------------------------------------------
' Funktion     : ShutdownGDIPlus
' Beschreibung : Beendet die GDI+ Instanz
' Rückgabewert : GDI+ Status
'------------------------------------------------------
Private Function ShutdownGDIPlus() As Status
    ' Beendet GDI+ Instanz
    ShutdownGDIPlus = GdiplusShutdown(GdipToken)
End Function

'------------------------------------------------------
' Funktion     : StartUpGDIPlus
' Beschreibung : Initialisiert GDI+ Instanz
' Übergabewert : GDI+ Version
' Rückgabewert : GDI+ Status
'------------------------------------------------------
Private Function StartUpGDIPlus(ByVal GdipVersion As Long) As Status
    ' Initialisieren der GDI+ Instanz
    Dim GdipStartupInput As GDIPlusStartupInput
    Dim GdipStartupOutput As GdiplusStartupOutput
    
    GdipStartupInput.GdiPlusVersion = GdipVersion
    StartUpGDIPlus = GdiplusStartup(GdipToken, _
    GdipStartupInput, GdipStartupOutput)
End Function

Private Sub cmdLoadPicture_Click()
    ' Fehlerbehandlung
    On Error Goto errorhandler
    
    ' ist GDI+ initialisiert
    If GdipInitialized = True Then
        
        ' Dialogparameter setzen
        With cdLoadPicture
            .Filter = "All Files (*.BMP;*.DIB;*.RLE;*.JPG;" _
            & "*.JPEG;*.JPE;*.JFIF;*.GIF;*.EMF;*.WMF;" & _
            "*.TIF;*.TIFF;*.PNG;*.ICO)|*.BMP;*.DIB;" & _
            "*.RLE;*.JPG;*.JPEG;*.JPE;*.JFIF;*.GIF;" & _
            "*.EMF;*.WMF;*.TIF;*.TIFF;*.PNG;*.ICO"
            .CancelError = True
            .ShowOpen
        End With
        
        ' ist lBitmap vorhanden
        If lBitmap Then
            
            ' lBitmap löschen
            If Execute(GdipDisposeImage(lBitmap)) = OK Then
                lBitmap = 0
            End If
        End If
        
        ' Laden der Bildatei und
        ' GDI+ Bitmapobjekt erzeugen
        If LoadPicturePlus(cdLoadPicture.FileName, _
        lBitmap) = OK Then
        
            Call UpdateScroll
        
        End If
    End If
    
    Exit Sub
errorhandler:
End Sub

'------------------------------------------------------
' Funktion     : UpdateScroll
' Beschreibung : wird aufgerufen, wenn sich der Value-Wert
'                einer ScrollBars ändert
'------------------------------------------------------
Private Sub UpdateScroll()
    
    ' ist GDI+ initialisiert
    If GdipInitialized = True Then
    
        ' ist lBitmap vorhanden
        If lBitmap Then
            
            ' Helligkeit und Kontrast ändern
            If SetBrightnessContrast(lBitmap, picView, _
            CSng(hscBrightness.Value / 100), _
            CSng(hscContrast.Value / 100)) = True Then
            
                lblInfo(0).Caption = "Helligkeit: " _
                & CStr(hscBrightness.Value)
                
                lblInfo(1).Caption = "Kontrast: " _
                & CStr(hscContrast.Value)
                
                DoEvents
            
            End If
        End If
    End If
End Sub

Private Sub Form_Load()
    GdipInitialized = False
    
    With Me
        .Width = 8400
        .Height = 8250
        .Caption = "GDI+ SetBrightnessContrast"
    End With
    
    With picView
        .Move 60, 60, Me.ScaleWidth - 120, 6400
    End With
    
    With cmdLoadPicture
        .Move 60, 60 + picView.Top + _
        picView.Height, 2000, 350
        .Caption = "Load Picture"
    End With
    
    With lblInfo(0)
        .Move 60, 60 + cmdLoadPicture.Top + _
        cmdLoadPicture.Height, 1500, 225
        .Caption = "Helligkeit: 0"
    End With
    
    With lblInfo(1)
        .Move 60, 60 + lblInfo(0).Top + _
        lblInfo(0).Height, 1500, 225
        .Caption = "Kontrast: 0"
    End With
    
    With hscBrightness
        .Move 60 + lblInfo(0).Left + lblInfo(0).Width, _
        lblInfo(0).Top, 6000, 225
        .Max = 100
        .Min = -100
        .Value = 0
    End With
    
    With hscContrast
        .Move 60 + lblInfo(1).Left + lblInfo(1).Width, _
        lblInfo(1).Top, 6000, 225
        .Max = 100
        .Min = -100
        .Value = 0
    End With
    
    ' GDI+ initialisieren
    If Execute(StartUpGDIPlus(GdiPlusVersion)) = OK Then
        GdipInitialized = True
    Else
        ' Initialisierung fehlgeschalgen
        MsgBox "GDI+ not inizialized.", vbOKOnly, "GDI Error"
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    
    ' ist GDI+ initialisiert
    If GdipInitialized = True Then
        
        ' ist lBitmap vorhanden
        If lBitmap Then
            
            ' lBitmap löschen
            Call Execute(GdipDisposeImage(lBitmap))
        End If
        
        ' GDI+ beenden
        Call Execute(ShutdownGDIPlus)
    End If
End Sub

Private Sub hscBrightness_Change()
    Call UpdateScroll
End Sub

Private Sub hscBrightness_Scroll()
    Call hscBrightness_Change
End Sub

Private Sub hscContrast_Change()
    Call UpdateScroll
End Sub

Private Sub hscContrast_Scroll()
    Call hscContrast_Change
End Sub
'--- Ende Formular "frmGDIPlusBrightnessContrast" alias frmGDIPlusBrightnessContrast.frm  ---
'----- Ende Projektdatei GDIPlusBrightnessContrast.vbp  -----