Feedback

VB - Erstellen eines Miniaturbildes

Veröffentlicht von am 12/23/2006
(5 Bewertungen)
Durchläuft ein Verzeichnis und erstellt ein Minitatur-Abbilder aus einem vorhandenen Bild. Dies kann das in ein Listview etc. geladen werden.

Imports System.DirectoryServices
Imports System.IO

'Aufruf und Übergabe der Parameter
'
'Ordner C:\Temp wird nach Dateien mit der Endung .png durchsucht
'

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        Image2MiniImage("C:\Temp", "png")

End Sub


'Suchroutine
Private Sub Image2MiniImage(ByVal SearchDirName As String, ByVal ExtensionName As String)

        Dim foundFileName As String = String.Empty

        For Each foundFileName In System.IO.Directory.GetFiles(SearchDirName)

            If foundFileName.ToLower.ToString.EndsWith(ExtensionName) Then

                Dim fi As New FileInfo(foundFileName)

                Dim foundMiniImage As String = fi.Directory.ToString & "\Thumb_" & fi.Name
                foundMiniImage = foundMiniImage.Replace(fi.Extension, ".bmp")

                createMiniThumb(foundFileName, foundMiniImage, 24)

            End If
        Next
End Sub


Function FakePreviewCallback() As Boolean
        Return False
End Function

''' <summary>
''' Erstellt aus einem Bild ein Mini Abbild (Thumbnail)
''' </summary>
''' <param name="strOriginalImage"></param>
''' Hier wird er Speicherort und der Name des Originalbildes angegeben
''' "C:\Temp\original.png"
''' 
''' <param name="strnewThumbnailImage"></param>
''' Hier bitte den Speicherort, den Namen und die Erweiterung des neuen
''' thumbs angeben ("C:\Temp\mini.bmp")
''' 
''' <param name="nSize"></param>
''' Hier bitte die Groesse des thumbs angeben 
''' Fuer 16x16 bitte 16 angeben
''' 
''' <returns></returns>
''' <remarks></remarks>
''' 
Function createMiniThumb(ByVal strOriginalImage As String, ByVal strnewThumbnailImage As String, ByVal nSize As Integer) As Boolean

Try
            Dim objImage As System.Drawing.Image
            Dim objFileStream As New FileStream(strOriginalImage, FileMode.Open, FileAccess.Read)
            Dim fakeCall As System.Drawing.Image.GetThumbnailImageAbort

            'Original einlesen
            objImage = System.Drawing.Image.FromStream(objFileStream)

            fakeCall = New System.Drawing.Image.GetThumbnailImageAbort(AddressOf FakePreviewCallback)

            'Groesse festlegen
            objImage = objImage.GetThumbnailImage(nSize, nSize, fakeCall, IntPtr.Zero)
            'Speichern
            objImage.Save(strnewThumbnailImage, Imaging.ImageFormat.Jpeg)
            objFileStream.Close()

            'Alles wieder freigeben
            objFileStream = Nothing
            objImage = Nothing
            Return True
        Catch ex As Exception
            Return False
        End Try

    End Function

Abgelegt unter Thumbnail, Picture.

Kommentare zum Snippet

 

Logge dich ein, um hier zu kommentieren!