Rubrik: Grafik und Font · Bilder & Icons | VB-Versionen: VB6 | 30.05.05 |
Bild-Dateien in VB.PictureBox laden durch GDIPlus Dieser Tipp zeigt, wie sich Bild-Dateien per GDIPLUS.DLL direkt in die VB.PictureBox laden lassen. | ||
Autor: Manfred Bohn | Bewertung: | Views: 33.443 |
ohne Homepage | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
Im Tipp Ersatz für die VB6-LoadPicture-Funktion werden Bild-Dateien durch GDIPlus geladen und über das Bild-Handle unter Verwendung der Funktion 'OLECREATEPICTUREINDIRECT' in ein VB-Picture-Objekt umgewandelt.
Dabei können Informationen verloren gehen - z.B. die Transparenz-Information bei entsprechenden GIF-Bildern.
Einen direkteren Weg zum Laden von Bildern durch 'GDIPlus' bietet das Zeichnen in eine VB.PictureBox unter Verwendung des Gerätekontexts dieses Objekts. Bei dieser Vorgehensweise gehen weniger Bild-Informationen verloren - nur diejenigen, die von der VB.PictureBox nicht unterstützt werden können.
' ============================================================== ' Start Quellcode modLoadPicBox ' ============================================================== Option Explicit ' Bilddatei per 'GDIPlus.DLL' in 'VB.PictureBox' laden ' =============================================================== ' Benötigte GDIPlus-Deklarationen zum Laden/Zeichnen eines Bildes ' =============================================================== Private Type GDIPlusStartupInput Version As Long etctetera(1 To 12) As Byte End Type ' Verbindung herstellen Private Declare Function GdiplusStartup Lib "gdiplus" ( _ ByRef GDIP_Connection As Long, _ ByRef udtInput As GDIPlusStartupInput, _ Optional ByRef udtOutput As Any) As Long ' Verbindung zum DeviceKontext herstellen Private Declare Function GdipCreateFromHDC Lib "gdiplus" ( _ ByVal hDC As Long, _ ByRef Graphics As Long) As Long ' Bild aus Datei laden (in Bitmap) Private Declare Function GdipLoadImageFromFile Lib "gdiplus" ( _ ByVal FileName As Long, _ ByRef image As Long) As Long ' Abmessungen des Bildes ermitteln Private Declare Function GdipGetImageDimension Lib "gdiplus" ( _ ByVal image As Long, _ ByRef Width As Single, _ ByRef Height As Single) As Long ' Bild zeichnen Private Declare Function GdipDrawImageRect Lib "gdiplus" ( _ ByVal Graphics As Long, _ ByVal image As Long, _ ByVal X As Single, _ ByVal Y As Single, _ ByVal Width As Single, _ ByVal Height As Single) As Long ' Bild-Ressource freigeben Private Declare Function GdipDisposeImage Lib "gdiplus" ( _ ByVal image As Long) As Long ' Graphik-Ressource freigeben Private Declare Function GdipDeleteGraphics Lib "gdiplus" ( _ ByVal Graphics As Long) As Long ' GDIPLus freigeben Private Declare Function GdiplusShutdown Lib "gdiplus" ( _ ByVal token As Long) As Long
Public Function LoadPicBox(ByVal DateiName As String, _ ByRef PicBox As VB.PictureBox, _ Optional ByVal AdjustPicBoxSize As Boolean = True, _ Optional ByRef Meldung As String) As Boolean ' Öffnet die Bilddatei 'DateiName' und trägt sie ' unter Verwendung des Gerätekontexts der Picturebox ' in die Zeichenfläche der PictureBox ein ' Falls AdjustPicBoxSize = true ' die Picturebox wird ggf. vergrößert, ' um das gesamte Bild zeichnen zu können Dim retcode As Long ' Funktions-Rückgaben Dim Bitmap As Long Dim Graphics As Long Dim picWidth As Single ' Bildabmessungen Dim picHeight As Single Dim GDIP_Connection As Long ' Verbindung zu GDIPlus Dim GDIP_Startup As GDIPlusStartupInput Dim w As Long, h As Long ' Bildgröße in Twips On Error GoTo exitfunction Err.Clear If Trim(DateiName) = "" Or PicBox Is Nothing Then Meldung = "Eingabeparameter fehlen" Exit Function End If If Dir(DateiName, vbNormal Or vbReadOnly) = "" Then Meldung = "Datei existiert nicht" Exit Function End If Meldung = "" GDIP_Startup.Version = 1 retcode = GdiplusStartup(GDIP_Connection, GDIP_Startup, ByVal 0&) If retcode <> 0 Then Meldung = "GDIPlus nicht verfügbar" Exit Function End If ' Trägt das Bild aus der Datei in die Bitmap ein retcode = GdipLoadImageFromFile(StrPtr(DateiName), Bitmap) If retcode <> 0 Then Meldung = "Bitmap kann nicht geöffnet werden" GoTo exitfunction End If ' Abfrage der Abmessungen der Bitmap retcode = GdipGetImageDimension(Bitmap, picWidth, picHeight) If retcode <> 0 Then Meldung = "Bitmap-Abmessungen nicht verfügbar" GoTo exitfunction End If ' PictureBox einrichten und ggf. ' auf die benötigten Bildabmessungen einstellen With PicBox .AutoRedraw = True .BorderStyle = 0 .Picture = LoadPicture() 'PictureBox löschen If AdjustPicBoxSize Then ' Skala: Pixel --> Twips umrechnen w = .ScaleX(picWidth, vbPixels, vbTwips) h = .ScaleY(picHeight, vbPixels, vbTwips) ' PictureBox-Arbeitsfläche ggf. vergrößern If .Width < w Then .Width = w If .Height < h Then .Height = h End If End With ' Erzeugen eines GDIPlus Grafikobjekts ' für die Verwendung mit Hdc retcode = GdipCreateFromHDC(PicBox.hDC, Graphics) If retcode <> 0 Then Meldung = "Graphikobjekt nicht verfügbar" GoTo exitfunction End If ' Bitmap in die PictureBox zeichnen retcode = GdipDrawImageRect(Graphics, Bitmap, 0, 0, picWidth, picHeight) If retcode <> 0 Then Meldung = "Bild kann nicht gezeichnet werden" GoTo exitfunction End If ' Rückgabe: alles OK Meldung = "" LoadPicBox = True exitfunction: ' Fehler ? If Err.Number <> 0 Then Meldung = Err.Description End If ' Ressourcen und GDIPLus freigeben If Bitmap <> 0 Then ' Bitmap löschen GdipDisposeImage Bitmap End If If Graphics <> 0 Then ' GDIPLus-Grafikobjekt löschen GdipDeleteGraphics Graphics End If If GDIP_Connection <> 0 Then ' GDIPlus-DLL freigeben GdiplusShutdown GDIP_Connection End If End Function ' ============================================================== ' Ende Quellcode 'modLoadPicBox' ' ==============================================================
Aufruf-Beispiel (in einem Formular):
' Bild_Datei: Pfad und Dateiname eines Bildes (BMP, JPG, GIF, PNG, TIF) ' Picture1: Name einer VB.PictureBox Dim Meldung As String If Not LoadPicBox(Bild_Datei, Picture1, , Meldung) Then MsgBox Meldung, vbExclamation End If