Mit nachfolgender Funktion lässt sich ein Vorschaubild aus einer Bilddatei erstellen, wobei man neben der Bilddatei selbst noch die Wunschgröße angeben kann. Da die Funktionen auf das GDI+ API von Windows zurückgreift, werden neben dem BMP, GIF und JPFG-Format auch das weitverbreitete PNG-Format unterstützt. Damit das Vorschaubild nicht "verzerrt" angezeigt wird, berücksichtigt die Funktion automatisch auch das korrekte Seitenverhältnis, d.h. die tatsächliche Höhe bzw. Breite des Vorschaubildes kann durchaus von der "Wunschgröße" abweichen. Packen Sie nachfolgenden Code in ein Modul. Option Explicit ' benötigte API-Deklarationen Private Type GdiplusStartupInput GdiplusVersion As Long DebugEventCallback As Long SuppressBackgroundThread As Long SuppressExternalCodecs As Long End Type Private Declare Function GdiplusStartup Lib "GDIPlus" ( _ Token As Long, _ InputBuf As GdiplusStartupInput, _ Optional ByVal OutputBuf As Long = 0) As Long Private Declare Function GdiplusShutdown Lib "GDIPlus" ( _ ByVal Token As Long) As Long Private Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" ( _ ByVal Filename As Long, _ hBitmap As Long) As Long Private Declare Function GdipGetImageDimension Lib "GDIPlus" ( _ ByVal hImage As Long, _ Width As Single, _ Height As Single) As Long Private Declare Function GdipGetImageThumbnail Lib "GDIPlus" ( _ ByVal hImage As Long, _ ByVal thumbWidth As Long, _ ByVal thumbHeight As Long, _ thumbImage As Long, _ ByVal callback As Long, _ ByVal callbackData As Long) As Long Private Declare Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" ( _ ByVal hBitmap As Long, _ hbmReturn As Long, _ ByVal Background As Long) As Long Private Declare Function GdipDisposeImage Lib "GDIPlus" ( _ ByVal hImage As Long) As Long Private Declare Function OleCreatePictureIndirect Lib "oleaut32.dll" ( _ lpPictDesc As PictDesc, _ riid As Any, _ ByVal fOwn As Long, _ lplpvObj As IPicture) As Long Private Type PictDesc cbSizeofStruct As Long picType As Long hImage As Long xExt As Long yExt As Long End Type ' Erstellt ein Vorschaubild aus der angegeben Bilddatei in der gewünschten Größe ' unter Berücksichtigung des korrekten Seitenverhältnisses Public Function CreateThumbnail(ByVal File As String, _ ByVal MaxWidth As Long, ByVal MaxHeight As Long) As StdPicture Dim SI As GdiplusStartupInput Dim hBitmap As Long Dim Token As Long Dim Width As Single Dim Height As Single Dim nPercent As Long Dim hThumb As Long Dim hDestBitmap As Long Set CreateThumbnail = Nothing ' GDI+ initialisieren SI.GdiplusVersion = 1 If GdiplusStartup(Token, SI) = 0 Then ' Bilddatei erstellen If GdipCreateBitmapFromFile(StrPtr(File), hBitmap) = 0 Then ' Originalgröße des Bilder ermitteln If GdipGetImageDimension(hBitmap, Width, Height) = 0 Then ' Vorschaugröße im korrekten Seitenverhältnis ermitteln nPercent = (MaxWidth / Width) * 100 If CLng(Height * nPercent / 100) > MaxHeight Then nPercent = (MaxHeight / Height) * 100 MaxWidth = Width / 100 * nPercent Else MaxHeight = Height / 100 * nPercent End If ' Thumbnail erstellen If GdipGetImageThumbnail(hBitmap, MaxWidth, MaxHeight, hThumb, 0, 0) = 0 Then ' jetzt ein GDI Bitmap vom Vorschaubild erstellen If GdipCreateHBITMAPFromBitmap(hThumb, hDestBitmap, 0) = 0 Then ' jetzt aus dem GDI Bitmap ein StdPicture-Objekt erstellen Set CreateThumbnail = HandleToPicture(hDestBitmap) End If ' Freigeben GdipDisposeImage hThumb End If End If ' Freigeben GdipDisposeImage hBitmap End If ' GDI+ beenden GdiplusShutdown Token End If End Function ' Hilfsfunktion: Erstellt aus einem GDI Bitmap (Handle) ein StdPicture-Objekt Private Function HandleToPicture(ByVal hBmp As Long) As StdPicture Dim IID_IPicture(3) As Long Dim PD As PictDesc Dim NewPic As IPicture IID_IPicture(0) = &H7BF80980 IID_IPicture(1) = &H101ABF32 IID_IPicture(2) = &HAA00BB8B IID_IPicture(3) = &HAB0C3000 With PD .cbSizeofStruct = Len(PD) .hImage = hBmp .picType = vbPicTypeBitmap End With OleCreatePictureIndirect PD, IID_IPicture(0), 1, NewPic ' StdPicture (Bitmap) zurückgeben Set HandleToPicture = NewPic End Function Aufrufbeispiel: Dim sFile As String sFile = "D:\temp\MyPicture.png" Set Image1.Picture = CreateThumbnail(sFile, 128, 128) Dieser Tipp wurde bereits 9.066 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks 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. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 sevGraph (VB/VBA) Grafische Auswertungen Präsentieren Sie Ihre Daten mit wenig Aufwand in grafischer Form. sevGraph unterstützt hierbei Balken-, Linien- und Stapel-Diagramme (Stacked Bars), sowie 2D- und 3D-Tortendiagramme und arbeitet vollständig datenbankunabhängig! |
||||||||||||||||
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. |