HOME TIPPS & TRICKS BEFEHLSREFERENZ API-REFERENZ FAQ FORUM DOWNLOAD TOOLBESPRECHUNG BÜCHERECKE MARKETPLACE GRAFIK & DESIGN VB-SEITEN

Partnerseiten
Top 5 Partnerlinks







Weitere...

Entwickler / Welt

··· Workshops · Grafik/DiretxX

autom. Vorschaubilder erstellen (Thumbnails) Dieser Workshop zeigt wie man mit reinen VB-Boardmitteln Vorschaubilder (Thumbnails) von Grafiken in einer bestimmten Größe erstellen kann. Außerdem lernen Sie, wie sich die Größe einer Grafik ermitteln lässt, wie man Grafiken zoomen und dann als neues Bild abspeichern kann - und das sogar optional als JPEGs mit einstellbarer Bildqualität.
Autor:  Dieter Otter	Bewertung:     [ Jetzt bewerten ]	Views:  20.686

Dieser Workshop zeigt wie man mit reinen VB-Boardmitteln Vorschaubilder (Thumbnails) von Grafiken in einer bestimmten Größe erstellen kann. Außerdem lernen Sie, wie sich die Größe einer Grafik ermitteln lässt, wie man Grafiken zoomen und dann als neues Bild abspeichern kann. Am Ende des Workshops wartet dann eine kleine Anwendung, welche für alle Grafikdateien eines Verzeichnisses die entsprechenden Vorschaubilder erstellt und in ein neues Verzeichnis abspeichert - und das sogar optional als JPEGs mit einstellbarer Bildqualität.

Einführendes Beispiel

Das nachfolgende Beispiel zeigt, wie man von bestehenden Bildern eine kleine Vorschau-Grafik (Thumbnails) erstellen kann. Hierzu wird das Originalbild zunächst in eine PictureBox geladen. Mittels PaintPicture wird das Bild dann verkleinert in eine zweite PictureBox kopiert, und kann dann mit dem Befehl SavePicture als Bitmap-Bild abgespeichert werden.

Erstellen Sie ein neues Projekt und plazieren auf der Form1 zwei PictureBoxen. Erstellen Sie die 2. PictureBox bereits in der Größe, in der die Vorschau-Datei angezeigt werden soll. Fügen Sie über das Menü Projekte - Komponenten das "Microsoft Common Dialog-Steuerelement" hinzu und plazieren eine Instanz auf das Formular. Jetzt wird noch ein CommandButton benötigt, über welchen das Original-Bild ausgewählt werden soll (Command1) und ein weiterer (Command2), über welchen das Vorschau-Bild gespeichert werden kann.

Und hier der Code:

' Originalbild per Dialog auswählen
Private Sub Command1_Click()
  Dim sFilename As String
  Dim sExt As String
 
  On Local Error Resume Next
  With CommonDialog1
    .CancelError = True
    .Filter = "alle Bilddateien|*.jpg;*.gif;*.bmp"
    .ShowOpen
    If Err.Number = 0 Then
      ' Thumbnail erstellen
      Picture1.Picture = LoadPicture(.Filename)
      If Err.Number = 0 Then
        CreateThumbnail Picture1, Picture2
 
        ' Vorschlag für neuen Dateinamen
        sFilename = Left$(.FileName, _
          InStrRev(.FileName, ".") - 1)
        sExt = Mid$(.FileName, _
          InStrRev(.FileName, ".") + 1)
 
        Picture1.Tag = sFilename + "-small.bmp"
      Else
        ' Fehler beim Laden des Bildes
        MsgBox "Fehler beim Laden des Bildes."
      End If
    Else
      ' Abbrechen wurde gewählt
    End If
  End With
End Sub
 
' Vorschau-Grafik (Thumbnail) erstellen
Private Sub CreateThumbnail(Pic1 As PictureBox, _
  Pic2 As PictureBox)
 
  With Pic2
    .AutoRedraw = True
    .Cls
    .PaintPicture Pic1.Picture, 0, 0, .Width, .Height, _
      0, 0, Pic1.Width, Pic1.Height
  End With
End Sub
 
' Thumbnail speichern
Private Sub Command2_Click()
  ' Vorschau-Bild als BMP speichern
  On Local Error Resume Next
  With CommonDialog1
    .CancelError = True
    .DialogTitle = "Vorschau speichern"
    .Filter = "Bitmap-Bild (*.bmp)|*.bmp"
    .FileName = Picture1.Tag
    .ShowSave
    If Err.Number = 0 Then
      SavePicture Picture2.Image, .FileName
    End If
  End With
End Sub

Wichtig!
Das "Kopieren" der Originalgrafik in die zweite PictureBox erfolgt nur korrekt, wenn die AutoRedraw-Eigenschaft der zweiten PictureBox auf True festgelegt ist. Beim Speichern des neuen Bildes darf dann nicht die Picture-Eigenschaft verwendet werden, sondern immer die Image-Eigenschaft.

Nachteil
Der Nachteil am obigen Code ist wohl der, daß Sie die Größe des Originalbildes und des Zielbildes bereits kennen müssen, da das Originalbild sonst nicht vollständig angezeigt wird oder aber in der PictureBox noch ein freier Rand (rechts und unten) bleibt.

Größe des Orginalbildes ermitteln

Mit einem kleinen Trick - ganz ohne Verwendung des Windows-API - lässt sich die Größe des Originalbildes ganz leicht ermitteln. Fügen Sie der Form zusätzlich noch ein Image-Objekt hinzu und setzen Visible auf False. Wie Sie ja sicherlich wissen, passt sich das Image-Objekt im Gegensatz zum Picture-Objekt der Größe des Bildes an - zumindest immer dann, wenn Stretch auf False gesetzt ist. Also verwenden Sie doch einfach diese "schöne" Eigenschaft, um die tatsächliche Bildgröße des Originalbildes zu ermitteln.

' Größe des Orginalbildes ermitteln
Private Sub GetImageSize(ByVal sImageFile As String, _
  nWidth As Long, nHeight As Long)
 
  On Local Error Resume Next
  nWidth = 0: nHeight = 0
  With Image1
    .Picture = LoadPicture(sImageFile)
    If Err.Number = 0 Then
      nWidth = .Width
      nHeight = .Height
    End If
    .Picture = LoadPicture()
  End With
End Sub

Die Prozedur GetImageSize gibt nun in den Parametern nWidth und nHeight die Breite und Höhe des durch sImageFile angegebenen Bildes zurück. Konnte das Bild nicht geladen werden, so wird für nWidth und nHeight der Wert 0 gesetzt.

Neuer Code

' Originalbild per Dialog auswählen
Private Sub Command1_Click()
  Dim nWidth As Long
  Dim nHeight As Long
  Dim sFilename As String
  Dim sExt As String
 
  On Local Error Resume Next
  With CommonDialog1
    .CancelError = True
    .Filter = "alle Bilddateien|*.jpg;*.gif;*.bmp"
    .ShowOpen
    If Err.Number = 0 Then
      ' Bildgröße ermitteln
      GetImageSize .FileName, nWidth, nHeight
      If nWidth > 0 And nHeight > 0 Then
        ' Größe der Picturebox für die Anzeige des
        ' Originalbildes anpassen
        Picture1.Width = nWidth
        Picture1.Height = nHeight
        Picture1.Picture = LoadPicture(.FileName)
 
        ' Thumbnail erstellen
        CreateThumbnail Picture1, Picture2
 
        ' Vorschlag für neuen Dateinamen
        sFilename = Left$(.FileName, _
          InStrRev(.FileName, ".") - 1)
        sExt = Mid$(.FileName, _
          InStrRev(.FileName, ".") + 1)
 
        Picture1.Tag = sFilename + "-small.bmp"
      Else
        ' Fehler beim Laden des Bildes
        MsgBox "Fehler beim Laden des Bildes."
      End If
    Else
      ' Abbrechen wurde gewählt
    End If
  End With
End Sub

Steigerung: Grafik vergrößern/verkleinern

Eine weitere Steigerung wäre, wenn sich für das Vorschaubild nicht nur eine fixe Größe, sondern eine prozentuale Verkleinerung einstellen liesse, z.B. 50% kleiner.

Kein Problem: Beim Verwenden der PaintPicture-Methode lässt sich u.a. die Größe des Zielbildes angeben, so daß sich eine Zoomfunktion leicht realisieren lässt. Ändern Sie einfach die CreateThumbnail-Prozedur entsprechend ab, so daß sich optional der Zoomfaktor als Parameter übergeben lässt.

Grafik zoomen (verkleinern/vergrößern)

' Vorschau-Grafik (Thumbnail) erstellen
Private Sub CreateThumbnail(Pic1 As PictureBox, _
  Pic2 As PictureBox, _
  Optional ByVal Zoom As Integer = 0)
 
  Dim NewWidth As Long
  Dim NewHeight As Long
 
  With Pic2
    .AutoRedraw = True
    .Cls
 
    ' wenn Zoomfaktor angegeben
    If Zoom <> 0 Then
      With Pic1
        If Zoom < 0 Then
          ' verkleinern
          NewWidth = .Width - (.Width / 100 * Abs(Zoom))
          NewHeight = .Height - (.Height / 100 * Abs(Zoom))
        Else
          ' vergrößern
          NewWidth = .Width + (.Width / 100 * Zoom)
          NewHeight = .Height + (.Height / 100 * Zoom)
        End If
      End With
 
      ' Größe der Picturebox setzen
      .Width = NewWidth
      .Height = NewHeight
    End If
 
    .PaintPicture Pic1.Picture, 0, 0, .Width, .Height, _
      0, 0, Pic1.Width, Pic1.Height
  End With
End Sub

Soll also das geladene Bild z.B. um 50% vekleinert dargestellt werden, so setzen Sie folgenden Prozeduraufruf ein:

Private Sub Command1_Click()
  ...
  ' 50% verkleiner
  CreateThumbnail Picture1, Picture2, -50
  ...
End Sub

Um das Vorschaubild vergrößert darzustellen, muss als Parameter ein positiver Wert eingesetzt werden:

Private Sub Command1_Click()
  ...
  ' 65% vergrößern
  CreateThumbnail Picture1, Picture2, 65
  ...
End Sub

Abschluss-Projekt

Autom. Thumbnails aller Bilder eines Verzeichnisses erstellen
Zum Abschluss dieses Workshops soll ein kleines Programm entwickelt werden, welches von allen Bildern (Bitmap, JPEG und GIF) eines Verzeichnisses automatisch die entsprechenden Vorschaubilder erstellt und in ein neues Verzeichnis speichert.

Das Programm selbst besteht hierbei nur aus einem Dialogfenster, in welchem Sie den Ordner der Orginalbilder und den Ordner für die Vorschaubilder festlegen. Zusätzlich lässt sich noch angeben, ob die Vorschaubilder eine feste Größe haben sollen, oder ob eine prozentuale Verkleinerung der Orginalbilder erfolgen soll. Per OK-Button wird der Vorgang dann gestartet und das Programm wieder beendet.

Das Formular

Für das Formular werden folgende Steuerelemente benötigt:

• 5 x Label
• 5 x Textbox
• 4 x CommandButton
• 1 x Frame
• 2 x OptionButton
• 2 x PictureBox
• 1 x ImageBox

Plazieren Sie die einzelnen Elemente auf das Formular (siehe Abbildung) und legen Sie die Eigenschaften folgendermassen fest:

Text1:	Locked = True
Cmd1/Cmd2:	Width = 300, Caption = ...
cmdCancel:	Cancel = True
Text2/Text4:	MaxLength = 4
Text5:	MaxLength = 3
Picture1/Picture2:	Visible = False
Image1:	Visible = False

Und hier der Source:
Im Form_Load-Ereignis werden die Einstellungen des letzten Programmaufrufs gelesen.

Option Explicit
Dim IniFile As String
 
' Einstellungen ermitteln
Private Sub Form_Load()
  ' Ini-Datei, in welcher die zuletzt festgelegten
  ' Ordnerangaben gespeichert werden
  IniFile = App.Path & _
    IIf(Right$(App.Path, 1) <> "\", "\", "") & _
    App.EXEName & ".ini"
 
  ' Ordner-Angaben des letzten Aufrufs ermitteln
  Dim F As Integer
  Dim OrdnerQuelle As String
  Dim OrdnerZiel As String
  Dim optIndex As Integer
  Dim sWidth As String
  Dim sHeight As String
  Dim sZoom As String
 
  If Dir(IniFile) <> "" Then
    F = FreeFile
    Open IniFile For Input As #F
    Line Input #F, OrdnerQuelle
    Line Input #F, OrdnerZiel
    Line Input #F, sWidth
    Line Input #F, sHeight
    Line Input #F, sZoom
    Input #F, optIndex
    Close #F
  Else
    ' Voreinstellungen
    optIndex = 1
    sZoom = "50"
  End If
 
  Option1(optIndex) = True
  Text1.Text = OrdnerQuelle
  Text2.Text = OrdnerZiel
  Text3.Text = sWidth
  Text4.Text = sHeight
  Text5.Text = sZoom
End Sub

Ordnerauswahl
Über die beiden CommandButtons Cmd1 und Cmd2 wird der Standard-Dialog zur Ordner-Auswahl angezeigt. Die benötigten Prozeduren und Funktionen, befinden sich in einem eigenen Modul, welches Sie dem Projekt hinzufügen. Hierbei handelt es sich um die Datei bFolder.bas (6 KB). Einzelheiten und weitere Details finden Sie in einem unserer früheren Workshops Ordnerauswahl-Dialog in VB

' Quell-Ordner auswählen
Private Sub Cmd1_Click()
  Dim Ordner As String
 
  Ordner = BrowseForFolder("Wählen Sie den " & _
    "Ordner aus, in welchem sich die Originalbilder " & _
    "befinde.")
 
  If Ordner <> "" Then Text1.Text = Ordner
End Sub
 
' Ziel-Ordner auswählen
Private Sub Cmd2_Click()
  Dim Ordner As String
 
  Ordner = BrowseForFolder("Wählen Sie den " & _
    "Ordner aus, in welchem sich die Originalbilder " & _
    "befinde.")
 
  If Ordner <> "" Then Text2.Text = Ordner
End Sub

Bilder ermitteln und Vorschaubilder speichern

Alle Bilder des Quell-Verzeichnisses ermitteln
Um alle Bilder eines Verzeichnisses zu ermitteln, wird die Dir-Funktion verwendet. Anhand der Dateierweiterung (Extension) entscheiden Sie dann, ob es sich um ein zulässiges Bildformat handelt oder nicht. Im Beispielsprogramm sollen alle Bilddateien vom Typ Bitmap (.bmp), JPEG (.jpg und .jpeg), undGIF (.gif) ermittelt werden.

Bevor Sie jedoch damit beginnen, sollten Sie zunächst prüfen, ob es sich bei den angegebenen Verzeichnissen um zulässige und gültige Verzeichnisnamen handelt. Existiert das Zielverzeichnis noch nicht, so soll eine Abfrage erscheinen, mit der Möglichkeit, daß dieses automatisch vom Programm erstellt wird.

Erst dann werden die Originalbilder ermittelt und entsprechend verkleinert als Vorschaubilder in das neue Verzeichnis gespeichert.

' Vorschaubilder (Thumbnails) erstellen
Private Sub cmdOK_Click()
  Dim OrdnerQuelle As String
  Dim OrdnerZiel As String
 
  ' zunächst prüfen, ob es sich um gültige
  ' Ordnerangaben handelt
  OrdnerQuelle = Trim$(Text1.Text)
  OrdnerZiel = Trim$(Text2.Text)
 
  ' Ggf. abschließenden Backslash entfernen
  If Right$(OrdnerQuelle, 1) = "\" Then _
    OrdnerQuelle = Left$(OrdnerQuelle, Len(OrdnerQuelle) - 1)
  If Right$(OrdnerZiel, 1) = "\" Then _
    OrdnerZiel = Left$(OrdnerZiel, Len(OrdnerZiel) - 1)
 
  ' Quell-Ordner prüfen
  If Not FolderExists(OrdnerQuelle) Then
    MsgBox "Der Ordner '" & OrdnerQuelle & "' " & _
      "existiert nicht. " & vbCrLf & "Bitte " & _
      "prüfen Sie Ihren Angaben.", 16, "ACHTUNG!"
    Text1.SetFocus
    Exit Sub
  End If
 
  ' Ziel-Ordner prüfen
  If Not FolderExists(OrdnerZiel) Then
    If MsgBox("Der Ordner '" & OrdnerZiel & "' " & _
      "existiert nicht." & vbCrLf & "Soll der Ordner " & _
      "jetzt erstellt werden?", 36, "HINWEIS") = vbNo Then
 
      ' Ordner nicht erstellen
      Text2.SetFocus
      Exit Sub
    Else
      ' Ordner erstellen
      On Local Error Resume Next
      MkDir OrdnerZiel
      If Err.Number <> 0 Then
        MsgBox "Der Ziel-Ordner kann nicht erstellt " & _
          "werden!", 16, "FEHLER"
        Text2.SetFocus
        Exit Sub
      End If
    End If
  End If
 
  ' Aktuelle Einstellungen speichern
  Dim F As Integer
  F = FreeFile
  Open IniFile For Output As #F
  Print #F, OrdnerQuelle
  Print #F, OrdnerZiel
  Print #F, Text3.Text
  Print #F, Text4.Text
  Print #F, Text5.Text
  Print #F, IIf(Option1(0) = True, 0, 1)
  Close #F
 
  ' Dateien ermitteln und Thumbnails speichern
  Dim DirName As String
  Dim sFilename As String
  Dim sExt As String
  Dim nWidth As Long
  Dim nHeight As Long
 
  ' Wenn fixe Größe eingestellt, dann Picture2
  ' in der Größe entsprechend anpassen
  If Option1(0) Then
    With Picture2
      .Width = Val(Text3.Text) * Screen.TwipsPerPixelX
      .Height = Val(Text4.Text) * Screen.TwipsPerPixelY
    End With
  End If
 
  Screen.MousePointer = 11
  DirName = Dir(OrdnerQuelle & "\*.*", vbNormal)
  While DirName <> ""
    If DirName <> "." And DirName <> ".." Then
      ' Prüfen, ob es sich um eine Datei mit der
      ' Extension .BMP, .JPG, .JPEG oder .GIF handelt
      If InStr(DirName, ".") > 0 Then
        sFilename = Left$(DirName, _
          InStrRev(DirName, ".") - 1)
        sExt = Mid$(DirName, InStrRev(DirName, "."))
 
        Select Case UCase(sExt)
          Case ".BMP", ".JPG", ".JPEG", ".GIF"
            ' Größe des Originalbildes ermitteln
            ' dient gleichzeitig auch der Prüfung, ob
            ' das Bild geladen werden konnte
            GetImageSize OrdnerQuelle & "\" & DirName, _
              nWidth, nHeight
 
            If nWidth > 0 And nHeight > 0 Then
              ' Bild konnte geladen werden!
              With Picture1
                .Width = nWidth
                .Height = nHeight
                .Picture = LoadPicture(OrdnerQuelle & _
                  "\" & DirName)
              End With
 
              If Option1(0) Then
                ' Fixe Größe
                CreateThumbnail Picture1, Picture2
              Else
                ' Zoom (verkleinern)
                CreateThumbnail Picture1, Picture2, _
                  -Val(Text5.Text)
              End If
 
              ' Bild speichern (als Bitmap)
              SavePicture Picture2.Image, OrdnerZiel & _
                "\" & sFilename & "-small.bmp"
            End If
        End Select
      End If
    End If
    DirName = Dir
  Wend
  Screen.MousePointer = 0
 
  MsgBox "Die Vorschaubilder wurden erstellt.", 64
 
  ' Anwendung beenden
  Unload Me
  End
End Sub
 
' Programm beenden
Private Sub cmdCancel_Click()
  Unload Me
  End
End Sub

Vorschaubilder im JPEG-Format speichern
Eingang wurde erwähnt, daß man die Vorschaubilder sogar im JPEG-Format speichern könnte. Da VB leider keinen entsprechenden Befehl zur Verfügung stellt, bedient man sich hier am besten der frei verfügbaren Intel® JPEG Library. Es würde allerdings den Rahmen dieses Workshops sprengen, alle Funktionen der JPEG Library hier detailiert zu erläutern. Aus diesem Grund verzichten wir darauf - haben jedoch das downloadbare Abschlussprojekt mit dieser Funktionalität ausgestattet!

Schlussbemerkungen
Das Beispielsprogramm lässt sich noch um ein paar Features erweitern. So könnte man die Einstellungen per Parameter beim Programmstart festlegen, und zusätzlich ein Statusfenster während des Erstellens der Vorschaubilder anzeigen, sozusagen als Fortschrittsanzeige...

Aber Sie möchten ja schließlich auch noch etwas tun - oder nicht ? -

Viel Spaß beim Ausprobieren!

 

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.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel