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
Kommentare zum Snippet