Rubrik: Grafik und Font · Bilder & Icons | VB-Versionen: VB6 | 09.12.11 |
Thumbnail (Vorschaubild) mit Hilfe von GDI+ erstellen Eine Funktion, die unter Einbeziehung der GdiPlus Funktionen aus dem Windows API ein Vorschaubild (Thumbnail) von einer angegebenen Bilddatei erstellt. | ||
Autor: Dieter Otter | Bewertung: | Views: 9.026 |
www.tools4vb.de | System: WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
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)