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:
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: Details: 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. 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 ' ====================================================================== Dieser Workshop wurde bereits 12.279 mal aufgerufen.
Anzeige
![]() ![]() ![]() (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. |
Neu! sevEingabe 3.0 ![]() Einfach stark! Ein einziges Eingabe-Control für alle benötigten Eingabetypen und -formate, inkl. Kalender-, Taschenrechner und Floskelfunktion, mehrspaltige ComboBox mit DB-Anbindung, ImageComboBox u.v.m. Tipp des Monats ![]() Dieter Otter PopUp-Menü wird nicht angezeigt :-( In diesem Tipp verraten wir Ihnen, wie Sie Probleme mit PopUp-Menüs umgehen können, wenn diese unter bestimmten Umständen einfach nicht angezeigt werden. TOP Entwickler-Paket ![]() TOP-Preis!! Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1605.50 EUR... |
|||||||||||||
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. |