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:     [ Jetzt bewerten ]	Views:  33.434
ohne Homepage	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 25 Bewertung insgesamt: gut Durchschnittliche Bewertung: 4.0 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

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