Aufhellung dunkler Bildbereiche mit VB6 Mit diesem Workshop zeigen wir, wie sich selbst große Digitalbilder (Bitmaps und JPEGs) mit VB6 schnell aufhellen lassen, ohne auf Kapazitäts-Grenzen zu stoßen. Zur schnellen Verarbeitung der Bilddaten werden diese hierzu in ein Byte-Array kopiert.
Autor:  Manfred Bohn	Bewertung:     [ Jetzt bewerten ]	Views:  12.279

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 2 Bewertung insgesamt: gut Durchschnittliche Bewertung: 4.0 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Problemstellung:

Bei der digitalen Fotografie entstehen häufig Aufnahmen, bei denen die Bilddetails in den relativ dunklen Bereichen für das Auge verborgen bleiben, während der Rest des Bildes korrekt belichtet ist.

Falls man bei der Nachbearbeitung solcher Bilder eine einfache Helligkeitsänderung vornimmt, werden diese Details zwar sichtbar, aber die hellen Bereiche des Bildes wirken oft zu grell.

In der Praxis ergeben sich solche Bilder z.B. bei Gegenlichtaufnahmen. Deren Hintergrund ist meist korrekt belichtet, aber im Vordergrund gibt es dunkle Zonen. Der umgekehrte Fall tritt bei Blitzlicht-Aufnahmen ein. Deren Vordergrund ist korrekt belichtet, aber oft verschwinden die Details, die sich am Rande des Blitzbereichs befinden, für das Auge teilweise im Dunkeln.

Eine einfache Lösung solcher Probleme besteht darin, die relative Änderung der Bildhelligkeit von der Helligkeit der einzelnen Bildpixel (z.B. linear) abhängig zu machen.

Digitalkameras liefern Bilddateien, die etliche Megapixel groß sind. Versucht man, mit VB-Bordmitteln ein Programm zur Aufhellung solcher Bilder zu erstellen, stößt man auf enge Kapazitäts-Grenzen. Die Bearbeitung dauert eine kleine Ewigkeit.

Das hier vorgestellte Demoprogramm - für die selektive Aufhellung dunkler Zonen in Bitmaps und JPEGs - kopiert die Bilddaten deshalb zur schnellen Bearbeitung in Bytearrays.

Diese Bild-Dateien müssen auf der Basis von 24-Bit-Bitmaps erstellt worden sein. Das ist zwar meistens ohnehin der Fall - sonst ist zunächst die Transformation durch ein Bildverarbeitungsprogramm erforderlich.

JPEGs, die sehr stark "komprimiert" sind, eignen sich im allgemeinen nicht für Nachbearbeitungen, weil deren residuale Bild-Informationen für sinnvolle Ergebnisse von Verarbeitungsfunktionen unzureichend sind. Es entstehen - aufgrund der Arbeitsweise des JPEG-Verfahrens - häufig qualitativ minderwertige Resultate. (Falls die Digitalkamera über eine Einstellmöglichkeit verfügt, sollte man bei geplanter Nachbearbeitung stets die JPEG-Stufe verwenden, die die Daten am wenigsten stark komprimiert.)

Demoprogramm:
Um das Demo-Programm auszuführen sind folgende Schritte erforderlich:

1. VB6 starten und ein neues Standard-Exe-Projekt erstellen
2. Im IDE-Menü 'Projekt -> Komponenten' sind zwei Checkboxen zu aktivieren (Microsoft Windows Common Controls 6 / Microsoft Common Dialog Control 6).
3. Im IDE-Menü 'Projekt -> Eigenschaften -> Erstellen' ist die Checkbox zum Entfernen nicht verwendeter ActiveX-Steuerelemente zu deaktivieren.
4. Den Programmcode vollständig in den Codebereich des Formulars 'Form1' laden.
5. Im Menü 'Projekt -> Eigenschaften -> Kompilieren' sollte die Option 'Codeausführungsgeschwindigkeit optimieren' gewählt werden.

Schnell läuft das Programm nur als EXE-Datei. Beim Testen innerhalb der IDE sollte man deshalb keine allzu großen Bilder laden.

Zu beachten:
Nach dem Erstellen der Overlay-Arrays ist innerhalb der Entwicklungsumgebung stets auf die Freigabe des Overlay zu achten. Beendet man die Programm-Ausführung, während das Overlay besteht, droht ein Absturz der VB-IDE !!! Das Anhalten an Brechpunkten ist aber möglich.
Auch beim 'Herumbasteln' an CopyMemory-Anweisungen drohen Abstürze. Diese Funktion verzeiht keine Fehler !!!

Details:
Zur Vereinfachung des Programmtests werden die erforderlichen Steuerelemente aus dem Code heraus erstellt, positioniert und eingerichtet (im FORM_LOAD-Ereignis).

Da sehr große Bilddateien, wie sie von Digitalkameras geliefert werden, nicht vollständig angezeigt werden können, arbeitet das Programm mit einer unsichtbaren und einer sichtbaren Picturebox.
Das (ggf. modifizierte) Bild wird in Originalgröße in der unsichtbaren Schachtel aufbewahrt, angezeigt wird es in angepasster Größe in der sichtbaren Box (Routine: Bild_Anzeigen).

Die Manipulation und das Speichern des Ergebnis-Bildes erfolgt in der Originalgröße als Bitmap. Diese Bilddateien können beim Speichern im Einzelfall bis zu 50 MB groß werden !!!

Um während der Bearbeitung durch den Helligkeits-Scroller immer wieder auf die Daten des Originalbildes zurückgreifen zu können, wird dieses Bild in einem global deklarierten Bytearray (gPicBackup) aufbewahrt. Dies geschieht bei Ausführung der Ereignisbehandlungsroutine 'cmdBildLaden_Click'.

Bei Manipulation der Bilddaten werden die Originaldaten modifiziert per temporärem, lokal deklarierten Overlay-Array (Pic) direkt in die unsichtbare Picturebox eingetragen (Ereignisroutine 'scrBildaufhellen_Change'). Von dort lassen sie sich in passender Größe in die sichtbare PictureBox übertragen (allgemeine Routine: 'Bild_Anzeigen'). Dabei wird auf das korrekte Seitenverhältnis geachtet.

Bei Veränderung der Größe des Formulars wird das geladene Bild jeweils erneut in die Anzeige-Picturebox eingepasst (jeweils in maximal möglicher Größe unter Beibehaltung des Seitenverhältnisses). Zu große Bilder werden verkleinert angezeigt. Diese Anpassung wirkt sich aber nicht auf die Bearbeitung des Bildes aus.

Die Aktivierung der Checkbox 'chkGleichmäßigeAufhellung' ermöglicht den Vergleich zwischen einer linear abgestuften Aufhellung der Bild-Pixel und einer nicht abgestuften, sondern gleichmäßigen Aufhellung.

Die Verwendung der Funktion setzt den Kontrast des Bildes herab und sie ist deshalb zur Anwendung bei bereits korrekt belichteten Bildern nicht geeignet. Bei Bildern, die insgesamt zu dunkel geraten sind, sollte zunächst eine leichte Erhöhung der allgemeinen Helligkeit erfolgen, ehe die hier vorgestellte Funktion zur Anwendung kommt.

Weitere Details sind den Kommentarzeilen zu entnehmen. Dort finden sich auch einige Hinweise zur Modifikation des Programms (Farb-Gewichtung, Abdunkelung).

Variablen-Deklaration und dynamisches Erzeugen der benötigten Steuerelemente auf dem Formular

' ============================================================
' Formular zur Bildaufhellung
' Start des Codes
' ============================================================
 
' VB6-Projekt
' Manfred Bohn für VBARCHIV   11.2007
 
' Aufhellung dunkler Bildpunkte in Bitmap/JPG-Bildern
' (Voraussetzung: 24 Bit-Darstellung der Bild-Pixel)
 
 
' ====================================================================
' Notwendige IDE-Einstellungen
' ====================================================================
 
' Erforderliche Komponenten
' Microsoft Windows Common Controls 6        (MsComctlLib: ProgressBar)
' Microsoft Common Dialog Control 6          (MsComDlg: Dateidialoge)
 
' Im Menü: Projekt -> Eigenschaften -> Erstellen:
' Die Folgende Checkbox muss deaktiviert werden:
' - Informationen zu nicht verwendeten ActiveX-Steuerelementen entfernen

Option Explicit
 
' =====================================================================
' Globale Deklarationen
' =====================================================================
 
' Zugriff auf die benötigten Steuerelemente
Private WithEvents picDisplay As VB.PictureBox ' angezeigtes Bild
Private WithEvents picBox As VB.PictureBox     ' Bild in Originalgröße
 
' Zugiff auf integrierte VB6-Steuerelemnte
Private WithEvents cmdBildLaden As VB.CommandButton
Private WithEvents cmdBildSpeichern As VB.CommandButton
Private WithEvents scrBildAufhellen As VB.HScrollBar
Private WithEvents chkGleichmäßigeAufhellung As VB.CheckBox
 
' Ergänzende VB-Steuelemente
Private WithEvents pbrProgress As MSComctlLib.ProgressBar
Private WithEvents cdlStandardDialog As MSComDlg.CommonDialog
 
' API/GDI für den Zugriff auf Bild in der PictureBox
' Übertragung der Bitmap-Rahmendaten in einen Buffer
Private Declare Function GetObject Lib "gdi32" _
  Alias "GetObjectA" ( _
  ByVal hObject As Long, _
  ByVal nCount As Long, _
  lpObject As Any) As Long
 
' Diese Deklaration liefert den Zeiger auf die SafeArray-Struktur
' eines Array, der zur Erstellung eines Oberlay benötigt wird
Private Declare Function VarPtrArray Lib "msvbvm60.dll" _
  Alias "VarPtr" ( _
  Ptr() As Any) As Long
 
' API-Funktion für schnelles Kopieren von Bytefolgen
Private Declare Sub CopyMemory Lib "kernel32" _
  Alias "RtlMoveMemory" ( _
  pDst As Any, _
  pSrc As Any, _
  ByVal ByteLen As Long)
 
' Informationsblock der Array-Dimensionierung bei VB6
Private Type strucSAFEARRAY
  Dimensionen As Integer    ' Zahl der Array-Dimensionen
  Features As Integer       ' spezielle Array-Eigenschaften
  Elemente As Long          ' Angabe zum einz. Arrayfeld
  Locks As Long             ' Sperrvermerke
  DatenZeiger As Long       ' Zeiger: Speicher-Start der Arraydaten
  Elements1 As Long         ' Anzahl Elemente in 1.Dimension
  lBound1 As Long           ' Arrayuntergrenze 1. Dimension
  Elements2 As Long         ' s.o.
  lBound2 As Long
End Type
 
' Windows Bitmap-Rahmendaten werden von
' der API/GDI-Funktion 'GetObject' geliefert
' (Bezeichnung der Elemente zur besseren Code-Lesbarkeit
' im Vergleich zur Windows-Dekl. modiziziert!)
Private Type strucBITMAP
  Type As Long
  PixelWidth As Long      ' Bildbreite (Pixel)
  PixelHeight As Long     ' Bildhöhe   (Pixel)
  BytesWidth As Long      ' Breite (in Byte; bei 24 Bit-Bitmap 3 Byte/Pixel)
  Planes As Integer
  BitsPerPixel As Integer ' Prog unterstützt nur 24 Bits/Pixe
  BitZeiger As Long       ' Zeiger auf die Bilddaten
End Type
 
' Globale Variable
Dim gAufhellVektor(255) As Integer ' zur Veränderung der Farbintensität
Dim gPicBackup() As Byte           ' Kopie der Bilddaten des Originalbildes
Dim gSafearray As strucSAFEARRAY   ' SafeArray-Daten für Daten-Overlay
 
' Konstante für Verwendung in Meldeboxen
Const cTitle As String = "VBARCHIV-DEMO: Bildaufhellung"

' =======================================================================
' Ereignis-Behandlungsroutinen
' =======================================================================

Private Sub Form_Load()
  ' Basisformular Bildaufhellung
  ' Ladeprozedur: Erstellen und Einrichten der Steuerelemente
 
  ' Formulargröße einrichten
  With Me
    .Height = 480 * 15: .Width = 640 * 15
    .Caption = "Kein Bild geladen"
  End With
 
  ' eine PictureBox dem Formular hinzufügen
  Set picDisplay = Me.Controls.Add("VB.PictureBox", "PicDisplay", Me)
 
  ' die PictureBox positionieren und einrichten
  With picDisplay
    .ScaleMode = vbPixels
    .Top = 45: .Left = 45: .Height = 400 * 15: .Width = 625 * 15
    .AutoRedraw = True  ' Beständige Bitmap!!
    .Visible = True
  End With
 
  ' Unsichtbare Picturebox hinzufügen
  ' (für modifiziertes Bild in Originalgröße)
  Set picBox = Me.Controls.Add("VB.PictureBox", "PicBox", Me)
 
  With picBox
    ' Die Größe des unsichtbaren Bild-Steuerelements
    ' ist für diesen Verwendungszweck schnurzpiepegal!!
    .Top = 10: .Left = 10: .Visible = False
    .ScaleMode = vbPixels
  End With
 
  ' Dialog-Steuerelement erstellen (Datei laden und Speichern)
  Set cdlStandardDialog = Me.Controls.Add( _
    "MScomdlg.CommonDialog", "cdlStandardDialog", Me)
 
  ' Dialog-Buttons erstellen
  Set cmdBildLaden = Me.Controls.Add( _
    "VB.CommandButton", "cmdBildLaden", Me)
 
  Set cmdBildSpeichern = Me.Controls.Add( _
    "VB.CommandButton", "cmdBildSpeichern", Me)
 
  ' Buttons einrichten und positionieren
  With cmdBildLaden
    .Caption = "Bild &Laden"
    .FontSize = 8
    .Height = 600: .Width = 1000
    .Top = Me.Height - .Height - 500
    .Left = 45
    .Visible = True
  End With
 
  With cmdBildSpeichern
    .Caption = "Bild &Speichern"
    .FontSize = 8
    .Height = 600: .Width = 1000
    .Top = Me.Height - .Height - 500
    .Left = cmdBildLaden.Left + cmdBildLaden.Width + 145
    .Visible = True
  End With
 
  ' Checkbox erstellen
  Set chkGleichmäßigeAufhellung = Me.Controls.Add( _
    "VB.CheckBox", "ChkGleichmäßigeAufHellung", Me)
 
  ' Checkbox einrichten
  With chkGleichmäßigeAufhellung
    .Left = cmdBildSpeichern.Left + cmdBildSpeichern.Width + 200
    .Top = cmdBildSpeichern.Top
    .Height = cmdBildSpeichern.Height
    .Width = 1500
    .Caption = "Gleichmäßige Aufhellung"
    .Visible = True
  End With
 
  ' Scroller erstellen
  Set scrBildAufhellen = Me.Controls.Add( _
    "VB.HScrollBar", "scrBildSAufhellen", Me)
 
  ' Scroller positionieren und einrichten
  With scrBildAufhellen
    .Min = 0:
    .Max = 126  ' zulässige Obergrenze der Intensitätsänderung
    .Top = chkGleichmäßigeAufhellung.Top
    .Left = chkGleichmäßigeAufhellung.Left + _
            chkGleichmäßigeAufhellung.Width + 200
    .Width = 2500
    .Height = chkGleichmäßigeAufhellung.Height
    .Visible = True
  End With
 
  ' Progressbar erstellen
  ' Hier ist die Angabe der ProgId erforderlich!! ???
  Set pbrProgress = Me.Controls.Add( _
    "MsComctlLib.Progctrl.2", "pBrProgress", Me)
 
  ' Progressbar für spätere Verwendung vorbereiten
  With pbrProgress
    .Left = scrBildAufhellen.Left + _
            scrBildAufhellen.Width + 200
    .Top = scrBildAufhellen.Top
    .Height = scrBildAufhellen.Height
    .Width = scrBildAufhellen.Width
    .Min = 0: .Max = 100 ' Dummy
    ' Progressbar bleibt zunächst unsichtbar
    .Visible = True
  End With
 
  ' Formular-Grundzustand einrichten
  Bild_Löschen
End Sub

Private Sub Form_Resize()
  ' Ereignis: Benutzer ändert Formulargröße
 
  ' Minimiertes Window erlaubt keine Positionierung
  ' der Steuerelemente
  If Me.WindowState = vbMinimized Then Exit Sub
 
  ' Mindestgröße des Formulars auf einfache Weise sicherstellen
  ' damit alle Steuerelemente sichtbar bleiben und das Bild
  ' in vernünftiger Größe angezeigt werden kann
  ' Die hier zu verwendende Einheit ist Twips
  If Me.Width < 9500 Then Me.Width = 9500
  If Me.Height < 6000 Then Me.Height = 6000
 
  ' Falls die Steuerelemente noch nicht geladen sind
  ' (z.B. beim Programmstart)
  ' --> Resize-Fehler ignorieren
  On Error Resume Next
 
  ' Anzeigepicturebox in Höhe und Breite anpassen
  With picDisplay
    .Width = Me.Width - (.Left * 5)
    .Height = Me.Height - 1500
  End With
 
  ' zusätzliche Steuerelemente unten im Formular positionieren
  With cmdBildLaden
    .Top = Me.Height - .Height - 500
    cmdBildSpeichern.Top = .Top
    chkGleichmäßigeAufhellung.Top = .Top
    scrBildAufhellen.Top = .Top
    pbrProgress.Top = .Top
  End With
 
  ' Nach Größenänderung das Bild neu einpassen
  Bild_Anzeigen
End Sub

Bild laden und speichern

Private Sub cmdBildLaden_Click()
  ' Ereignisroutine
  ' Dialog für das Laden eines Bildes
  ' Die Bild-Daten werden in der PictureBox und
  ' zusätzlich in einem ByteArray abgelegt
 
  Dim Bmp As strucBITMAP ' Struktur für die Bitmap-Rahmenangaben
                         ' des geladenen Bildes
  Dim Pic() As Byte      ' temporäres Overlay-Array für Zugriff
                         ' auf Pixeldaten des geladenen Bildes
 
  ' Sicherheitsabfrage
  If gSafearray.DatenZeiger <> 0 Then
    If MsgBox("Das geladene Bild wird überschrieben", _
      vbQuestion + vbOKCancel, cTitle) = vbCancel Then Exit Sub
  End If
 
  ' ggf. wird ein bereits geladenes Bild gelöscht
  Bild_Löschen
 
  On Error GoTo fehler
 
  ' Dialog zum Laden eines Bildes
  With cdlStandardDialog
    .Filter = "Bildateien |*.jpg;*.jpeg;*.bmp;*.dib"
    .CancelError = False
    .DialogTitle = "Laden einer Bilddatei für Aufhellungsfunktion"
 
    ' Die Bilddatei muss bereits existieren
    .Flags = cdlOFNFileMustExist
 
    ' Dialog anzeigen
    .ShowOpen
 
    ' Dialog aufräumen lassen
    DoEvents
 
    ' Kein Bild im Dialog gewählt (Abbruch)?
    If .FileName = "" Then Exit Sub
 
    ' Bild in Originalgröße in unsichtbare PictureBox laden
    picBox.Picture = VB.LoadPicture(.FileName)
    Me.Caption = "Bild: " + .FileTitle
  End With
 
  ' Bitmap-Daten des geladenen Bildes besorgen
  Call GetObject(picBox.Picture, Len(Bmp), Bmp)
 
  ' Kontrollabfrage
  If Bmp.BitsPerPixel <> 24 Then
    MsgBox "Das Demoprogramm unterstützt nur 24-Bit Bitmaps!", _
      vbInformation, cTitle
    GoTo fehler
  End If
 
  ' SafeArray-Daten zur späteren Dimensionierung des Overlay-Array
  ' für das geladene Bild passend einrichten
  ' global deklarierte Variable !!
  With gSafearray
    .Elemente = 1
    .Dimensionen = 2             ' 2-dimensionales Array
    .lBound1 = 0
    .Elements1 = Bmp.PixelHeight ' Bildhöhe in Pixel
    .lBound2 = 0
    .Elements2 = Bmp.BytesWidth  ' Bildbreite in Byte !!!
    .DatenZeiger = Bmp.BitZeiger ' Zeiger auf die Bilddaten
  End With
 
  ' Statt Array-Dimensionierung:
  ' Safearray-Daten in das Array kopieren (= Overlay erstellen)
  Call CopyMemory(ByVal VarPtrArray(Pic), VarPtr(gSafearray), 4)
 
  ' BackUp-Array wie gewohnt dimensionieren
  ReDim gPicBackup(0 To Bmp.BytesWidth - 1, 0 To Bmp.PixelHeight - 1)
 
  ' Bilddaten per Overlay-Zugriff in das BackUp-Array kopieren
  ' global deklarierte Variable
  Call CopyMemory(gPicBackup(0, 0), Pic(0, 0), _
    Bmp.PixelHeight * Bmp.BytesWidth)
 
  ' Overlay-Array wieder freigeben (wichtig!)
  Call CopyMemory(ByVal VarPtrArray(Pic), 0&, 4)
 
  ' Bild in die Anzeige-Picturebox übertragen
  Bild_Anzeigen
 
  ' Steuerelemente für Benutzer freigeben
  Formular_Enabeln
 
  ' Aufhell-Slider auf Ausgangsposition setzen
  scrBildAufhellen.Value = 0
  Exit Sub
 
fehler:
  Bild_Löschen
End Sub

Private Sub cmdBildSpeichern_Click()
  ' Ereignisroutine
  ' Das manipulierte Bild kann als Bitmap
  ' gespeichert werden
 
  On Error GoTo fehler
 
  Dim FileName As String
 
  ' Sicherheitsabfrage
  If gSafearray.DatenZeiger = 0 Then
    MsgBox "Es ist kein Bild geladen worden", vbInformation, cTitle
    Exit Sub
  End If
 
  ' Dialog zum Speichern des Bildes als Bitmap-Datei
  With cdlStandardDialog
    .CancelError = False
    .DialogTitle = "Aktuelles Bild als Bitmap speichern"
    .Filter = "Bitmaps|*.bmp"
 
    ' Überschreiben einer Bilddatei bestätigen lassen
    .Flags = cdlOFNOverwritePrompt
 
    ' Keine Vorgabe eines Dateinamens
    .FileName = ""
 
    ' Dialog starten
    .ShowSave
 
    ' Falls Abbruch ....
    If .FileName = "" Then Exit Sub
 
    ' ... sonst: das bearbeitete Bild
    ' in der unsichtbaren PictureBox speichern
 
    FileName = .FileName
 
    ' Korrekte Extension sicherstellen
    If UCase(Right(FileName, 4)) = ".JPG" Then
      FileName = Left(FileName, Len(FileName) - 4)
    End If
    If UCase(Right(FileName, 4)) <> ".BMP" Then
      FileName = FileName + ".bmp"
    End If
 
    ' Bild als Bitmap speichern
    Call VB.SavePicture(picBox.Picture, FileName)
  End With
  Exit Sub
 
fehler:
  ' falls beim Speichern etwas schief geht:
  ' z.B. der Versuch eine schreibgeschützte Datei zu überschreiben
  VBA.MsgBox VBA.Err.Description, vbExclamation, cTitle
End Sub

Bild aufhellen

Private Sub scrBildAufhellen_Change()
  ' EreignisRoutine
  ' Bild wird gemaess Slidereinstellung aufgehellt
 
  Dim i As Integer, k As Integer     ' Loops
  Dim Pic() As Byte                  ' Overlay-Array für Bildzugriff
 
  Dim Mittlere_Intensität As Integer ' für Bildmanipulation
  Dim Intensitätsänderung As Integer
 
  ' Ist überhaupt ein Bild geladen worden?
  If gSafearray.DatenZeiger = 0 Then Exit Sub
 
  ' Benutzer während der Bild-Bearbeitung aussperren
  Formular_Enabeln False
 
  ' ==================================================================
  ' allgemeiner Hinweis:
  ' Innerhalb dieses Code-Abschnitts können auch andere
  ' Helligkeits-Transformationen programmiert werden
 
  ' geforderte Intensitätsänderung berechnen
  For i = 0 To 255
    If chkGleichmäßigeAufhellung.Value = vbUnchecked Then
      ' Umsetzung der Farbintensität gemaess
      ' aktueller Slidereinstellung
 
      ' a.) Dunkle Pixel relativ stärker aufhellen als helle
      gAufhellVektor(i) = _
        (256 - i) / 256 * scrBildAufhellen.Value
 
      ' Weitere Beispiele:
      ' ==================
      ' b.) nur Abdunkeln sehr heller Pixel
'      If i > 190 Then
'        ' Je heller ein Pixel, desto stärker wird er abgedunkelt
'        gAufhellVektor(i) = -(CDbl(i - 190) / 190) * _
'          scrBildAufhellen.Value
'      Else
'        ' bereits 'dunkle' Pixel werden nicht verändert
'        gAufhellVektor(i) = 0
'      End If
 
       ' c.) Kombination von Aufhellung und Abdunkelung
'      If i > 190 Then
'        ' Je heller ein Pixel, desto stärker wird er abgedunkelt
'        gAufhellVektor(i) = _
'          -(CLng(i - 190) / 190) * scrBildAufhellen.Value
'      ElseIf i < 128 Then
'        ' Je dunkler ein Pixel, desto stärker wird er aufgehellt
'        gAufhellVektor(i) = _
'          CDbl(128 - i) / 128 * scrBildAufhellen.Value
'      Else
'        ' Mittelhelle Pixel bleiben unverändert
'        gAufhellVektor(i) = 0
'      End If
    Else
      ' zum Vergleich:
      ' alle Helligkeiten um den gleichen Betrag aufhellen
      gAufhellVektor(i) = 0.5 * scrBildAufhellen.Value
    End If
  Next i
 
  ' ====================================================================
 
  ' Statt einer Array-Dimensionierung:
  ' Safearray-Daten in das temporäre Array eintragen (= Overlay erstellen)
  ' per Zugriff auf Pic kann danach das PictureBox-Bild manipuliert werden
  Call CopyMemory(ByVal VarPtrArray(Pic), VarPtr(gSafearray), 4)
 
  ' Progressbar einrichten
  pbrProgress.Max = UBound(Pic, 2)
  pbrProgress.Value = 0
  pbrProgress.Visible = True
 
  ' Die Daten aus dem global deklarierten Backup-Buffer
  ' (=Originalzustand des Bildes)
  ' werden manipuliert in das Overlay-Array
  ' (=PictureBox-Bild) eingetragen
 
  ' Doppelschleife über die Bilddaten
  ' Schleife über Bildzeilen
  For k = 0 To UBound(Pic, 2)
    ' Schleife innerhalb einer Bildzeile
    ' In der Breite liegen drei Byte für einen Pixel (=24Bit) nebeneinander
    For i = 0 To UBound(Pic, 1) - 2 Step 3
 
      ' mittlere Farbintensität des aktuellen Bild-Pixels berechnen
      ' Hier könnte man Gewichtungsfaktoren einfügen.
      ' Üblicherweise wird dabei der Grünanteil stark und
      ' der Blauanteil schwach gewichtet, um die Helligkeits-Verarbeitung
      ' des menschlichen Auges einzubeziehen. Die Anordnung der
      ' Farbbytes im Hauptspeicher ist aber hardwareabhängig,
      ' (z.B. R-G-B oder B-G-R)
      ' --> deshalb habe ich die Gewichtung weggelassen
      Mittlere_Intensität = _
        (CInt(gPicBackup(i, k)) + gPicBackup(i + 1, k) + _
        gPicBackup(i + 2, k)) / 3
 
      ' zusätzliches Beispiel:
      ' Gewichtete Helligkeitsintensität unter der Annahme
      ' die drei Farb-Bytes zu einem Pixel seien in der
      ' Folge Blau-Grün-Rot im Speicher abgelegt
      ' Mittlere_Intensität = _
          (CInt(gPicBackup(i, k)) + gPicBackup(i + 1, k) * 4 + _
          gPicBackup(i + 2, k) * 2) / 7
 
      ' Intensitätsänderung aus dem Aufhellungsvektor entnehmen
      Intensitätsänderung = gAufhellVektor(Mittlere_Intensität)
 
      ' Änderung in die drei Farben-Bytes des Pixel eintragen
      ' von der Backup-Kopie des Originals direkt in die PictureBox
      ' alle drei Bildpunkte müssen um den gleichen Betrag
      ' geändert werden, sonst treten Farbänderungen ein
      Pic(i, k) = _
        ByteAddition(gPicBackup(i, k), Intensitätsänderung)
      Pic(i + 1, k) = _
        ByteAddition(gPicBackup(i + 1, k), Intensitätsänderung)
      Pic(i + 2, k) = _
        ByteAddition(gPicBackup(i + 2, k), Intensitätsänderung)
 
      ' Schleife innerhalb einer Bildzeile
    Next i
 
    ' gelegentlich den Fortschritt auch sichtbar machen
    If k Mod 20 = 0 Then
      pbrProgress.Value = k
    End If
 
    ' Schleife über alle Bildzeilen
  Next k
 
  ' Progressbar wieder verbergen
  pbrProgress.Visible = False
 
  ' Overlay-Array wieder freigeben (wichtig!)
  Call CopyMemory(ByVal VarPtrArray(Pic), 0&, 4)
 
  ' Die modifizierten Bildpixel am Bildschirm anzeigen
  Bild_Anzeigen
 
  ' Der Benutzer darf jetzt wieder aktiv werden
  Formular_Enabeln True
End Sub

Private Sub chkGleichmäßigeAufhellung_Click()
  ' Ereignisroutine
  ' Beim Setzen/Löschen der Checkbox wird das
  ' geladene Bild neu bearbeitet
  scrBildAufhellen_Change
End Sub

Hilfsfunktionen

' =====================================================================
' Hilfsfunktionen
' =====================================================================

Private Sub Bild_Löschen()
  ' Hilfsfunktion:
  ' alle Daten eines geladenen Bildes werden gelöscht
  ' Variable werden zurückgesetzt und
  ' betroffene Steuerelemente abgeschaltet
 
  ' Backup-Bilddaten löschen
  ReDim gPicBackup(0, 0)
 
  ' SafeArray initialisieren
  gSafearray.DatenZeiger = 0
 
  ' PictureBox-Inhalt löschen
  picBox.Picture = VB.LoadPicture()
  picDisplay.Picture = VB.LoadPicture()
  picDisplay.Cls
 
  ' Formularüberschrift setzen
  Me.Caption = "Kein Bild geladen"
 
  ' Speichern-Button, Helligkeitsscroller und Ckeckbox disabeln
  cmdBildSpeichern.Enabled = False
  scrBildAufhellen.Enabled = False
  chkGleichmäßigeAufhellung.Enabled = False
End Sub

Private Sub Formular_Enabeln(Optional ByVal Enabled As Boolean = True)
  ' Hilfsfunktion:
  ' Enabled-Eigenschaft aller Steuerelemente setzen
 
  Dim i As Integer
 
  ' Falls ein Steuerelement in der Controls-Auflistung
  ' keine Enabled-Eiegenschaft besitzt, Fehler übergehen
  On Error Resume Next
  For i = 0 To Controls.Count - 1
    Controls(i).Enabled = Enabled
  Next i
End Sub

Private Function ByteAddition(ByVal a As Byte, ByVal b As Integer) As Byte
  ' Hilfsfunktion
  ' Bei Addition eines Wertes in einer Byte-Variable darf 255
  ' nicht überschritten werden
  ' Zu 'stark' aufgehellte Pixel werden deshalb schneeweiss
  Dim erg As Integer
 
  erg = CInt(a) + b
  If erg > 255 Then erg = 255
  If erg < 0 Then erg = 0
  ByteAddition = CByte(erg)
End Function

Private Sub Bild_Anzeigen()
  ' Hilfsfunktion für die Anzeige des modifizierten Bildes
  ' in passender Größe
 
  Dim bild_breite As Integer, bild_höhe As Integer
  Dim anzeige_breite As Integer, anzeige_höhe As Integer
 
  ' Ist ein Bild geladen?
  If gSafearray.DatenZeiger = 0 Then Exit Sub
 
  ' Anzeige-Picturebox löschen
  picDisplay.Cls
  picDisplay.Picture = LoadPicture()
 
  ' Proportionale Bildgröße für die Anzeige ermitteln
 
  ' Originalgröße dfes Bildes in Pixeln
  bild_höhe = gSafearray.Elements1
  bild_breite = gSafearray.Elements2 / 3
 
  ' Angezeigte Größe des Bildes berechnen
  anzeige_breite = CLng(bild_breite) * picDisplay.ScaleHeight / bild_höhe
  anzeige_höhe = picDisplay.ScaleHeight
  ' Passt Bild bei voller Ausnutzung der Anzeige-Höhe
  ' in die verfügbare Anzeige-Breite?
  If anzeige_breite > picDisplay.ScaleWidth Then
    ' Das Bild ist zu breit -->
    ' Bild in voller Ausnutzung der Höhe einpassen
    anzeige_höhe = CLng(bild_höhe) * picDisplay.ScaleWidth / bild_breite
    anzeige_breite = picDisplay.ScaleWidth
  End If
 
  ' Vergrößerung kleiner Bilder bei Anzeige vermeiden
  If anzeige_breite > bild_breite And _
    anzeige_höhe > bild_höhe Then
    anzeige_breite = bild_breite: anzeige_höhe = bild_höhe
  End If
 
  ' Bild aus der unsichtbaren Box in die sichtbare Box übertragen
  Call picDisplay.PaintPicture(picBox.Picture, _
    0, 0, anzeige_breite, anzeige_höhe, _
                                 0, 0, bild_breite, bild_höhe)
 
  ' das eingepaßte Bild anzeigen
  picDisplay.Refresh
End Sub

' =======================================================================
' Ende des Codes Demo-Formular: Bildaufhellung
' ======================================================================