vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
sevDataGrid - G?nnen Sie Ihrem SQL-Kommando diesen kr?nenden Abschlu?!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2015
 
zurück
Rubrik: Grafik/DiretxX   |   VB-Versionen: VB5, VB601.07.01
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 OtterBewertung:     [ Jetzt bewerten ]Views:  12.901 

Summer-Special bei Tools & Components!
Gute Laune Sommer bei Tools & Components
Top Summer-Special - Sparen Sie teilweise über 100,- EUR
Alle sev-Entwicklerkomponenten und Komplettpakete jetzt bis zu 25% reduziert!
zum Beispiel:
  • Developer CD nur 455,- EUR statt 569,- EUR
  • sevDTA 2.0 nur 224,30 EUR statt 299,- EUR
  •  
  • vb@rchiv   Vol.6 nur 18,70 EUR statt 24,95 EUR
  • sevCoolbar 3.0 nur 58,70 EUR statt 69,- EUR
  • - Werbung -Und viele weitere Angebote           Aktionspreise nur für kurze Zeit gültig

    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

    Dialogfenster im Detail

    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!

    Dieser Workshop wurde bereits 12.901 mal aufgerufen.

    Über diesen Workshop im Forum diskutieren
    Haben Sie Fragen oder Anregungen zu diesem Workshop, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

    Neue Diskussion eröffnen

    nach obenzurück


    Anzeige

    Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Workshops finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
    (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.
     
       

    Druckansicht Druckansicht Copyright ©2000-2015 vb@rchiv Dieter Otter
    Alle Rechte vorbehalten.
    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